1C+-----------------------------------------------------------------------+
2C| Program       : mainparallel.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 in parallel.          |
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), T1, T2
41C+----------------------------------------------------------------------+
42C| Parallel programming specific variables.                             |
43C+----------------------------------------------------------------------+
44      integer maxprocs, nprocs
45C     maxprocs should be >= the number of processes used for DIRECT
46      parameter(maxprocs = 360)
47      integer mytid, tids(maxprocs)
48
49C+----------------------------------------------------------------------+
50C| Initialize parallel computing.                                       |
51C+----------------------------------------------------------------------+
52      CALL comminitIF()
53C+----------------------------------------------------------------------+
54C| Need nprocs to call commexitIF at the end.                           |
55C+----------------------------------------------------------------------+
56      call getnprocsIF(nprocs)
57C+----------------------------------------------------------------------+
58C| DETERMINE MASTER PROCESSOR. GET TIDS OF ALL PROCESSORS.              |
59C+----------------------------------------------------------------------+
60      call getmytidIF(mytid)
61      call gettidIF(0, tids(1))
62C+----------------------------------------------------------------------+
63C| If I am the master, open output and resultfile.                      |
64C+----------------------------------------------------------------------+
65      if (mytid.eq.tids(1)) then
66
67C+----------------------------------------------------------------------+
68C|  Define and open the logfile and the resultfile, where we store the  |
69C|  results of the run. We save the problem number, the number of       |
70C|  function evaluations needed, the time used by DIRECT, the percent   |
71C|  error and a flag signaling if we used DIRECT or DIRECT-l in the     |
72C|  resultfile.                                                         |
73C+----------------------------------------------------------------------+
74        logfile    = 2
75        resultfile = 29
76        open(logfile, file='direct.out')
77        open(resultfile, file='result.out')
78        CALL mainheader(logfile)
79      else
80        logfile = 0
81      end if
82
83C+----------------------------------------------------------------------+
84C| Read in the problem specific data and the parameters for DIRECT.     |
85C+----------------------------------------------------------------------+
86      CALL inputdata(n, u, l, logfile, DIReps, DIRmaxf,
87     +       DIRmaxT, problem, Maxdim, DIRalg, fglobal,
88     +       fglper, volper, sigmaper,
89     +       iidata, iisize, ddata, idsize, cdata, icsize)
90C+----------------------------------------------------------------------+
91C| Initialize and start the timing.                                     |
92C+----------------------------------------------------------------------+
93C        tarray(1) = 0.D0
94C        tarray(2) = 0.D0
95C        diff=dtime(tarray)
96C SP/2 Timing
97        CALL CPU_TIME(T1)
98C+----------------------------------------------------------------------+
99C| If the budget is lower zero, multiply the absolute value of the      |
100C| budget by the dimension of the problem.                              |
101C+----------------------------------------------------------------------+
102        if (DIRmaxf .lt. 0) then
103           DIRmaxf = -DIRmaxf*n
104        endif
105
106C+----------------------------------------------------------------------+
107C|  For some problems, we need to store some specific data in the user  |
108C|  variables.                                                          |
109C+----------------------------------------------------------------------+
110        if ((problem .ge. 5) .and. (problem .LE. 7)) then
111           iidata(1) = 5
112           if (problem .EQ. 6) THEN
113              iidata(1) = 7
114           else if (problem .EQ. 7) THEN
115            iidata(1) = 10
116           END IF
117         else if ((problem .ge. 8) .and. (problem .LE. 9)) then
118           n = 3
119           iidata(1) = 4
120           if (problem .EQ. 9) THEN
121              iidata(1) = 4
122              n = 6
123           END IF
124         end if
125C+----------------------------------------------------------------------+
126C| Call the optimization method.                                        |
127C+----------------------------------------------------------------------+
128        CALL ParDIRect(myfunc, DIRx, n, DIReps, DIRmaxf, DIRmaxT,
129     +              DIRf, l, u, DIRalg, Ierror, logfile,
130     +              fglobal, fglper, volper, sigmaper,
131     +              iidata, iisize, ddata, idsize, cdata, icsize)
132C+----------------------------------------------------------------------+
133C| If I am the master, give out the results of the optimization.        |
134C+----------------------------------------------------------------------+
135      if (mytid.eq.tids(1)) then
136C+----------------------------------------------------------------------+
137C| Give out the results of the optimization.                            |
138C+----------------------------------------------------------------------+
139        Write(*,100)
140        Write(*,110) IError
141        Write(*,120) (DIRx(i),i=1,n)
142        Write(*,130) DIRf
143        Write(*,140) DIRmaxf
144        Write(logfile,100)
145        Write(logfile,110) IError
146        Write(logfile,120) (DIRx(i),i=1,n)
147        Write(logfile,130) DIRf
148        Write(logfile,140) DIRmaxf
149C        diff=dtime(tarray)
150C SP/2 Timing
151        CALL CPU_TIME(T2)
152        diff = T2-T1
153        write(*,150) diff
154        write(logfile,150) diff
155C+----------------------------------------------------------------------+
156C| Calculate the percent error.                                         |
157C+----------------------------------------------------------------------+
158        per2 = DIRf - fglobal
159        if (fglobal .eq. 0.D0) then
160           per2 = per2*100.D0
161        else
162           per2 = per2/ abs(fglobal)*100.D0
163        end if
164C+----------------------------------------------------------------------+
165C| Save the results in the extra resultfile for use with Matlab etc.    |
166C+----------------------------------------------------------------------+
167        write(resultfile,200) problem, DIRmaxf, diff, per2, DIRalg
168C+----------------------------------------------------------------------+
169C| Close the logfile and rsultfile.                                     |
170C+----------------------------------------------------------------------+
171        close(logfile)
172        close(resultfile)
173      end if
174C+----------------------------------------------------------------------+
175C| Send signal to end program.                                          |
176C+----------------------------------------------------------------------+
177      CALL commexitIF(nprocs)
178
179100   FORMAT('-------------- Final result ------------------')
180110   FORMAT('DIRECT termination flag : ',I3)
181120   FORMAT('DIRECT minimal point    : ',20f12.7)
182130   FORMAT('DIRECT minimal value    : ',f12.7)
183140   FORMAT('DIRECT number of f-eval : ',I5)
184150   FORMAT('Time needed             : ',e10.4,' seconds.')
185200   FORMAT(I3, ' ', I6, ' ', f12.4, ' ', e10.5, ' ',I6)
186      end
187
188
189C+----------------------------------------------------------------------+
190C| Subroutine to read the values of the internal variables and the data |
191C| for the interpolator.                                                |
192C+----------------------------------------------------------------------+
193      subroutine inputdata(n, u, l, logfile, DIReps, DIRmaxf,
194     +       DIRmaxT, problem, Maxdim, DIRalg, fglobal,
195     + fglper, volper, sigmaper,
196     + iidata, iisize, ddata, idsize, cdata, icsize)
197      implicit none
198      Integer file, Maxdim, intproblem
199      parameter(file = 31)
200      Integer logfile,DOIFFCO
201C+----------------------------------------------------------------------+
202C| DIRECT specific variables.                                           |
203C+----------------------------------------------------------------------+
204      Double Precision DIReps
205      Integer DIRmaxf, DIRmaxT
206      Double Precision fglobal, fglper, volper, sigmaper
207      Integer DIRalg
208C+----------------------------------------------------------------------+
209C| Variables to pass user defined data to the function to be optimized. |
210C+----------------------------------------------------------------------+
211      INTEGER iisize, idsize, icsize
212      INTEGER iidata(iisize)
213      Double Precision ddata(idsize)
214      Character*40 cdata(icsize)
215
216C+----------------------------------------------------------------------+
217C| General variables for the problem.                                   |
218C+----------------------------------------------------------------------+
219      integer n, i
220      integer problem
221      Double Precision l(maxdim), u(maxdim)
222C+----------------------------------------------------------------------+
223C| Variables to store the different file names.                         |
224C+----------------------------------------------------------------------+
225      character DIRectinit*20
226      character problemdata*20
227
228C+----------------------------------------------------------------------+
229C| Read file names of the different files used in this run.             |
230C+----------------------------------------------------------------------+
231      open(unit = file, file='ini/main.ini')
232      read(file, 154) DIRectinit
233      read(file, 153) intproblem
234      read(file, 153) DOIFFCO
235      close(unit = file)
236      problem = intproblem
237C+----------------------------------------------------------------------+
238C| Store the problem number in the last entry of iidata.                |
239C+----------------------------------------------------------------------+
240      iidata(iisize) = problem
241      write(*,2000)
242      write(*,2010) DIRectinit
243      if (logfile .gt. 0) then
244        write(logfile,2000)
245        write(logfile,2010) DIRectinit
246      end if
247      open(unit = file, file='ini/problems.ini')
248      read(file,153)
249      do 40,i = 1,problem+1
250         read(file, 154) problemdata
25140    continue
252      close(unit = file)
253      write(*,2020) problemdata
254      write(*,2030) problem
255      if (logfile .gt. 0) then
256        write(logfile,2020) problemdata
257        write(logfile,2030) problem
258      end if
259C+----------------------------------------------------------------------+
260C| Read DIRECT variables from DIRinit.ini                               |
261C+----------------------------------------------------------------------+
262      open(unit = file, file =  'ini/'//DIRectinit)
263      read(file, 151) DIReps
264      read(file, 150) DIRmaxf
265      read(file, 150) DIRmaxT
266      read(file, 150) DIRalg
267C+----------------------------------------------------------------------+
268C| Read in the percent error when DIRECT should stop. If the optimal    |
269C| function value is not known (that is, when a real optimization is    |
270C| done), set this value to 0 and fglobal to -1.D100. This ensures that |
271C| the percentage condition cannot be satiesfied.                       |
272C+----------------------------------------------------------------------+
273      read(file, 151) fglper
274C+----------------------------------------------------------------------+
275C| Read in the percentage of the volume that the hyperrectangle which   |
276C| assumes fmin at its center needs to have to stop. Set this value to  |
277C| 0.D0 if you don't want to use this stopping criteria.                |
278C+----------------------------------------------------------------------+
279      read(file, 151) volper
280C+----------------------------------------------------------------------+
281C| Read in the bound on the measure that the hyperrectangle which       |
282C| assumes fmin at its center needs to have to stop. Set this value to  |
283C| 0.D0 if you don't want to use this stopping criteria.                |
284C+----------------------------------------------------------------------+
285      read(file, 151) sigmaper
286      close(unit = file)
287C+----------------------------------------------------------------------+
288C| Read problem specifics from problem data file.                       |
289C+----------------------------------------------------------------------+
290      open(unit = file, file = 'problem/'//problemdata)
291C+----------------------------------------------------------------------+
292C| Read in the problem name. This name is used in the initial output    |
293C| from DIRECT.                                                         |
294C+----------------------------------------------------------------------+
295      read(file,152) cdata(1)
296      read(file, 150) n
297C+----------------------------------------------------------------------+
298C| Read in the (know) optimal function value. Note that this value is   |
299C| generally not know, but for the test problems it is. If this value is|
300C| unknown, set fglobal to -1.D100 and fglper (see above) to 0.         |
301C+----------------------------------------------------------------------+
302      read(file, 151) fglobal
303      do 1000, i = 1,n
304         read(file, 151) l(i)
3051000  continue
306      do 1005, i = 1,n
307         read(file, 151) u(i)
3081005  continue
309      close(unit = file)
310
311150   FORMAT(I10)
312151   FORMAT(F20.10)
313152   FORMAT(A40)
314153   FORMAT(I20)
315154   FORMAT(A20)
316
3172000  FORMAT('Name of ini-directory    : ini/')
3182010  FORMAT('Name of DIRect.ini file  : ',A20)
3192020  FORMAT('Name of problemdata file : ',A20)
3202030  FORMAT('Testproblem used         : ',I4)
321      end
322
323C+----------------------------------------------------------------------+
324C| Give out a header for the main program.                              |
325C+----------------------------------------------------------------------+
326      SUBROUTINE mainheader(logfile)
327      IMPLICIT None
328      Integer logfile
329
330      write(*,100)
331      write(*,110)
332      write(*,120)
333      write(*,130)
334      write(*,140)
335      write(*,150)
336      write(*,160)
337      write(*,170)
338      write(*,180)
339      write(*,190)
340      write(*,200)
341      if (logfile .gt. 0) then
342        write(logfile,100)
343        write(logfile,110)
344        write(logfile,120)
345        write(logfile,130)
346        write(logfile,140)
347        write(logfile,150)
348        write(logfile,160)
349        write(logfile,170)
350        write(logfile,180)
351        write(logfile,190)
352        write(logfile,200)
353      end if
354100   FORMAT('+----------------------------------------+')
355110   FORMAT('|       Example Program for DIRECT       |')
356120   FORMAT('|  This program uses DIRECT to optimize  |')
357130   FORMAT('|  testfunctions. Which testfunction is  |')
358140   FORMAT('| optimized and what parameters are used |')
359150   FORMAT('| is controlled by the files in ini/.    |')
360160   FORMAT('|                                        |')
361170   FORMAT('|     Owen Esslinger, Joerg Gablonsky,   |')
362180   FORMAT('|             Alton Patrick              |')
363190   FORMAT('|              04/15/2001                |')
364200   FORMAT('+----------------------------------------+')
365      end
366