1 /* DIRparallel.f -- translated by f2c (version 20050501).
3 f2c output hand-cleaned by SGJ (August 2007).
6 #include "direct-internal.h"
8 /* Table of constant values */
10 static integer c__0 = 0;
11 static integer c_n1 = -1;
13 /* +-----------------------------------------------------------------------+ */
14 /* | Program : Direct.f (subfile DIRseriell.f) | */
15 /* | Last modified : 02-22-01 | */
16 /* | Written by : Joerg Gablonsky | */
17 /* | Subroutines, which differ depending on the serial or parallel version.| */
18 /* +-----------------------------------------------------------------------+ */
19 /* +-----------------------------------------------------------------------+ */
20 /* | Parallel Direct. This routine replaces the normal main routine DIRect.| */
21 /* | In it, we find out if this pe is the master or slave. If it is the | */
22 /* | master, it calls the serial DIRect main routine. The only routine that| */
23 /* | has to change for parallel Direct is DIRSamplef, where the actual | */
24 /* | sampling of the function is done. If we are on the slave, wait for | */
25 /* | either the coordinates of a point to sample the function or the | */
26 /* | termination signal. | */
27 /* +-----------------------------------------------------------------------+ */
28 /* Subroutine */ int direct_pardirect_(fp fcn, doublereal *x, integer *n,
29 doublereal *eps, integer *maxf, integer *maxt, doublereal *minf,
30 doublereal *l, doublereal *u, integer *algmethod, integer *ierror,
31 FILE *logfile, doublereal *fglobal, doublereal *fglper, doublereal
32 *volper, doublereal *sigmaper, void *fcn_data)
34 /* System generated locals */
42 integer tids[360], kret;
47 /* +-----------------------------------------------------------------------+ */
49 /* +-----------------------------------------------------------------------+ */
50 /* +-----------------------------------------------------------------------+ */
51 /* | The maximum of function evaluations allowed. | */
52 /* | The maximum dept of the algorithm. | */
53 /* | The maximum number of divisions allowed. | */
54 /* | The maximal dimension of the problem. | */
55 /* +-----------------------------------------------------------------------+ */
56 /* +-----------------------------------------------------------------------+ */
57 /* | Global Variables. | */
58 /* +-----------------------------------------------------------------------+ */
59 /* +-----------------------------------------------------------------------+ */
60 /* | External Variables. | */
61 /* +-----------------------------------------------------------------------+ */
62 /* +-----------------------------------------------------------------------+ */
63 /* | User Variables. | */
64 /* | These can be used to pass user defined data to the function to be | */
66 /* +-----------------------------------------------------------------------+ */
67 /* +-----------------------------------------------------------------------+ */
68 /* | Parallel programming variables | */
69 /* +-----------------------------------------------------------------------+ */
70 /* maxprocs should be >= the number of processes used for DIRECT */
71 /* +-----------------------------------------------------------------------+ */
72 /* | End of parallel programming variables | */
73 /* +-----------------------------------------------------------------------+ */
74 /* +-----------------------------------------------------------------------+ */
75 /* | Internal variables | */
76 /* +-----------------------------------------------------------------------+ */
77 /* +-----------------------------------------------------------------------+ */
78 /* | JG 02/28/01 Begin of parallel additions | */
79 /* | DETERMINE MASTER PROCESSOR. GET TIDS OF ALL PROCESSORS. | */
80 /* +-----------------------------------------------------------------------+ */
81 /* Parameter adjustments */
88 getnprocsif_(&nprocs);
89 gettidif_(&c__0, tids);
90 /* +-----------------------------------------------------------------------+ */
91 /* | If I am the master get the other tids and start running DIRECT. | */
92 /* | Otherwise, branch off to do function evaluations. | */
93 /* +-----------------------------------------------------------------------+ */
94 if (mytid == tids[0]) {
96 for (i__ = 1; i__ <= i__1; ++i__) {
97 gettidif_(&i__, &tids[i__]);
100 /* +-----------------------------------------------------------------------+ */
101 /* | Call Direct main routine. This routine calls DIRSamplef for the | */
102 /* | function evaluations, which are then done in parallel. | */
103 /* +-----------------------------------------------------------------------+ */
104 direct_direct_(fcn, &x[1], n, eps, maxf, maxt, minf, &l[1], &u[1],
105 algmethod, ierror, logfile, fglobal, fglper, volper, sigmaper,
107 /* +-----------------------------------------------------------------------+ */
108 /* | Send exit message to rest of pe's. | */
109 /* +-----------------------------------------------------------------------+ */
112 for (tid = 2; tid <= i__1; ++tid) {
113 mastersendif_(&tids[tid - 1], &tids[tid - 1], n, &flag__, &flag__,
114 &x[1], &u[1], &l[1], &x[1]);
118 /* +-----------------------------------------------------------------------+ */
119 /* | This is what the slaves do!! | */
120 /* +-----------------------------------------------------------------------+ */
121 /* +-----------------------------------------------------------------------+ */
122 /* | Receive the first point from the master processor. | */
123 /* +-----------------------------------------------------------------------+ */
124 slaverecvif_(tids, &c_n1, n, &flag__, &k, &fscale, &u[1], &l[1], &x[1]
126 /* +-----------------------------------------------------------------------+ */
127 /* | Repeat until master signals to stop. | */
128 /* +-----------------------------------------------------------------------+ */
130 /* +-----------------------------------------------------------------------+ */
131 /* | Evaluate f(x). | */
132 /* +-----------------------------------------------------------------------+ */
133 direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &fval, &kret, &
135 /* +-----------------------------------------------------------------------+ */
136 /* | Send result and wait for next point / message with signal to stop. | */
137 /* +-----------------------------------------------------------------------+ */
138 slavesendif_(tids, &mytid, &k, &mytid, &fval, &kret);
139 slaverecvif_(tids, &c_n1, n, &flag__, &k, &fscale, &u[1], &l[1], &
146 /* +-----------------------------------------------------------------------+ */
147 /* | Subroutine for sampling. This sampling is done in parallel, the master| */
148 /* | prozessor is also evaluating the function sometimes. | */
149 /* +-----------------------------------------------------------------------+ */
150 /* Subroutine */ void direct_dirsamplef_(doublereal *c__, integer *arrayi, doublereal
151 *delta, integer *sample, integer *new__, integer *length,
152 FILE *logfile, doublereal *f, integer *free, integer *maxi,
153 integer *point, fp fcn, doublereal *x, doublereal *l, doublereal *
154 minf, integer *minpos, doublereal *u, integer *n, integer *maxfunc,
155 integer *maxdeep, integer *oops, doublereal *fmax, integer *
156 ifeasiblef, integer *iinfesiblef, void *fcn_data)
158 /* System generated locals */
159 integer length_dim1, length_offset, c_dim1, c_offset, f_dim1, f_offset,
163 /* Local variables */
164 integer i__, j, k, helppoint, tid, pos;
165 integer flag__, tids[360], kret, npts;
167 integer oldpos, nprocs, datarec;
169 /* +-----------------------------------------------------------------------+ */
170 /* | JG 07/16/01 fcn must be declared external. | */
171 /* +-----------------------------------------------------------------------+ */
172 /* +-----------------------------------------------------------------------+ */
173 /* | JG 07/16/01 Removed fcn. | */
174 /* +-----------------------------------------------------------------------+ */
175 /* +-----------------------------------------------------------------------+ */
176 /* | JG 01/22/01 Added variable to keep track of the maximum value found. | */
177 /* | Added variable to keep track if feasible point was found. | */
178 /* +-----------------------------------------------------------------------+ */
179 /* +-----------------------------------------------------------------------+ */
180 /* | Variables to pass user defined data to the function to be optimized. | */
181 /* +-----------------------------------------------------------------------+ */
182 /* +-----------------------------------------------------------------------+ */
183 /* | Parallel programming variables. | */
184 /* +-----------------------------------------------------------------------+ */
185 /* JG 09/05/00 Increase this if more processors are used. */
186 /* +-----------------------------------------------------------------------+ */
187 /* | Find out the id's of all processors. | */
188 /* +-----------------------------------------------------------------------+ */
189 /* Parameter adjustments */
196 f_offset = 1 + f_dim1;
198 length_dim1 = *maxfunc;
199 length_offset = 1 + length_dim1;
200 length -= length_offset;
202 c_offset = 1 + c_dim1;
206 getnprocsif_(&nprocs);
208 for (i__ = 0; i__ <= i__1; ++i__) {
209 gettidif_(&i__, &tids[i__]);
212 /* +-----------------------------------------------------------------------+ */
213 /* | Set the pointer to the first function to be evaluated, | */
214 /* | store this position also in helppoint. | */
215 /* +-----------------------------------------------------------------------+ */
218 /* +-----------------------------------------------------------------------+ */
219 /* | Iterate over all points, where the function should be | */
221 /* +-----------------------------------------------------------------------+ */
223 npts = *maxi + *maxi;
225 while(k <= npts && k < nprocs) {
226 /* +-----------------------------------------------------------------------+ */
227 /* | tid is the id of the prozessor the next points is send to. | */
228 /* +-----------------------------------------------------------------------+ */
230 /* +-----------------------------------------------------------------------+ */
231 /* | Copy the position into the helparray x. | */
232 /* +-----------------------------------------------------------------------+ */
234 for (i__ = 1; i__ <= i__1; ++i__) {
235 x[i__] = c__[pos + i__ * c_dim1];
238 /* +-----------------------------------------------------------------------+ */
239 /* | Send the point. | */
240 /* +-----------------------------------------------------------------------+ */
241 mastersendif_(&tids[tid - 1], &tids[tid - 1], n, &flag__, &pos, &x[1],
242 &u[1], &l[1], &x[1]);
245 /* +-----------------------------------------------------------------------+ */
246 /* | Get the next point. | */
247 /* +-----------------------------------------------------------------------+ */
249 /* +-----------------------------------------------------------------------+ */
250 /* | Get data until it is all received. | */
251 /* +-----------------------------------------------------------------------+ */
253 while(datarec < npts) {
254 if ((doublereal) datarec / (doublereal) nprocs - datarec / nprocs <
257 for (i__ = 1; i__ <= i__1; ++i__) {
258 x[i__] = c__[pos + i__ * c_dim1];
261 direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &fhelp, &kret,
264 f[oldpos + f_dim1] = fhelp;
266 /* +-----------------------------------------------------------------------+ */
267 /* | Remember if an infeasible point has been found. | */
268 /* +-----------------------------------------------------------------------+ */
269 *iinfesiblef = MAX(*iinfesiblef,kret);
271 /* +-----------------------------------------------------------------------+ */
272 /* | if the function evaluation was O.K., set the flag in | */
274 /* +-----------------------------------------------------------------------+ */
275 f[oldpos + (f_dim1 << 1)] = 0.;
277 /* +-----------------------------------------------------------------------+ */
278 /* | JG 01/22/01 Added variable to keep track of the maximum value found. | */
279 /* +-----------------------------------------------------------------------+ */
281 d__1 = f[pos + f_dim1];
282 *fmax = MAX(d__1,*fmax);
284 /* +-----------------------------------------------------------------------+ */
285 /* | Remember if an infeasible point has been found. | */
286 /* +-----------------------------------------------------------------------+ */
287 *iinfesiblef = MAX(*iinfesiblef,kret);
289 /* +-----------------------------------------------------------------------+ */
290 /* | If the function could not be evaluated at the given point, | */
291 /* | set flag to mark this (f(pos,2) and store the maximum | */
292 /* | box-sidelength in f(pos,1). | */
293 /* +-----------------------------------------------------------------------+ */
294 f[oldpos + (f_dim1 << 1)] = 2.;
295 f[oldpos + f_dim1] = *fmax;
297 /* +-----------------------------------------------------------------------+ */
298 /* | If the function could not be evaluated due to a failure in | */
299 /* | the setup, mark this. | */
300 /* +-----------------------------------------------------------------------+ */
302 f[oldpos + (f_dim1 << 1)] = -1.;
307 /* +-----------------------------------------------------------------------+ */
308 /* | Recover where to store the value. | */
309 /* +-----------------------------------------------------------------------+ */
310 masterrecvif_(&c_n1, &c_n1, &oldpos, &tid, &fhelp, &kret);
311 f[oldpos + f_dim1] = fhelp;
313 /* +-----------------------------------------------------------------------+ */
314 /* | Remember if an infeasible point has been found. | */
315 /* +-----------------------------------------------------------------------+ */
316 *iinfesiblef = MAX(*iinfesiblef,kret);
318 /* +-----------------------------------------------------------------------+ */
319 /* | if the function evaluation was O.K., set the flag in | */
321 /* +-----------------------------------------------------------------------+ */
322 f[oldpos + (f_dim1 << 1)] = 0.;
324 /* +-----------------------------------------------------------------------+ */
325 /* | JG 01/22/01 Added variable to keep track of the maximum value found. | */
326 /* +-----------------------------------------------------------------------+ */
328 d__1 = f[oldpos + f_dim1];
329 *fmax = MAX(d__1,*fmax);
332 /* +-----------------------------------------------------------------------+ */
333 /* | If the function could not be evaluated at the given point, | */
334 /* | set flag to mark this (f(pos,2) and store the maximum | */
335 /* | box-sidelength in f(pos,1). | */
336 /* +-----------------------------------------------------------------------+ */
337 f[oldpos + (f_dim1 << 1)] = 2.;
338 f[oldpos + f_dim1] = *fmax;
340 /* +-----------------------------------------------------------------------+ */
341 /* | If the function could not be evaluated due to a failure in | */
342 /* | the setup, mark this. | */
343 /* +-----------------------------------------------------------------------+ */
345 f[oldpos + (f_dim1 << 1)] = -1.;
347 /* +-----------------------------------------------------------------------+ */
348 /* | Send data until it is all sent. | */
349 /* +-----------------------------------------------------------------------+ */
351 /* +-----------------------------------------------------------------------+ */
352 /* | Copy the position into the helparray x. | */
353 /* +-----------------------------------------------------------------------+ */
355 for (i__ = 1; i__ <= i__1; ++i__) {
356 x[i__] = c__[pos + i__ * c_dim1];
359 mastersendif_(&tid, &tid, n, &flag__, &pos, &x[1], &u[1], &l[1], &
366 /* +-----------------------------------------------------------------------+ */
367 /* | Iterate over all evaluated points and see, if the minimal | */
368 /* | value of the function has changed. If this has happend, | */
369 /* | store the minimal value and its position in the array. | */
370 /* | Attention: Only valied values are checked!! | */
371 /* +-----------------------------------------------------------------------+ */
372 i__1 = *maxi + *maxi;
373 for (j = 1; j <= i__1; ++j) {
374 if (f[pos + f_dim1] < *minf && f[pos + (f_dim1 << 1)] == 0.) {
375 *minf = f[pos + f_dim1];