direct/DIRparallel.c

   1 /* DIRparallel.f -- translated by f2c (version 20050501).
   2
   3    f2c output hand-cleaned by SGJ (August 2007).
   4 */
   5
   6 #include "direct-internal.h"
   7
   8 /* Table of constant values */
   9
  10 static integer c__0 = 0;
  11 static integer c_n1 = -1;
  12
  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)
  33 {
  34     /* System generated locals */
  35     integer i__1;
  36
  37     /* Local variables */
  38     integer i__, k;
  39     integer tid;
  40     integer flag__;
  41     doublereal fval;
  42     integer tids[360], kret;
  43     integer mytid;
  44     doublereal fscale;
  45     integer nprocs;
  46
  47 /* +-----------------------------------------------------------------------+ */
  48 /* | Parameters                                                            | */
  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     | */
  65 /* | optimized.                                                            | */
  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 */
  82     --u;
  83     --l;
  84     --x;
  85
  86     /* Function Body */
  87     getmytidif_(&mytid);
  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]) {
  95         i__1 = nprocs - 1;
  96         for (i__ = 1; i__ <= i__1; ++i__) {
  97             gettidif_(&i__, &tids[i__]);
  98 /* L46: */
  99         }
 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,
 106                 fcn_data);
 107 /* +-----------------------------------------------------------------------+ */
 108 /* | Send exit message to rest of pe's.                                    | */
 109 /* +-----------------------------------------------------------------------+ */
 110         flag__ = 0;
 111         i__1 = nprocs;
 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]);
 115 /* L200: */
 116         }
 117     } else {
 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]
 125                 );
 126 /* +-----------------------------------------------------------------------+ */
 127 /* | Repeat until master signals to stop.                                  | */
 128 /* +-----------------------------------------------------------------------+ */
 129         while(flag__ > 0) {
 130 /* +-----------------------------------------------------------------------+ */
 131 /* | Evaluate f(x).                                                        | */
 132 /* +-----------------------------------------------------------------------+ */
 133              direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &fval, &kret, &
 134                       fcn_data);
 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], &
 140                     x[1]);
 141         }
 142     }
 143     return 0;
 144 } /* pardirect_ */
 145
 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)
 157 {
 158     /* System generated locals */
 159     integer length_dim1, length_offset, c_dim1, c_offset, f_dim1, f_offset,
 160             i__1;
 161     doublereal d__1;
 162
 163     /* Local variables */
 164     integer i__, j, k, helppoint, tid, pos;
 165     integer flag__, tids[360], kret, npts;
 166     doublereal fhelp;
 167     integer oldpos, nprocs, datarec;
 168
 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 */
 190     --u;
 191     --l;
 192     --x;
 193     --arrayi;
 194     --point;
 195     f_dim1 = *maxfunc;
 196     f_offset = 1 + f_dim1;
 197     f -= f_offset;
 198     length_dim1 = *maxfunc;
 199     length_offset = 1 + length_dim1;
 200     length -= length_offset;
 201     c_dim1 = *maxfunc;
 202     c_offset = 1 + c_dim1;
 203     c__ -= c_offset;
 204
 205     /* Function Body */
 206     getnprocsif_(&nprocs);
 207     i__1 = nprocs - 1;
 208     for (i__ = 0; i__ <= i__1; ++i__) {
 209         gettidif_(&i__, &tids[i__]);
 210 /* L46: */
 211     }
 212 /* +-----------------------------------------------------------------------+ */
 213 /* | Set the pointer to the first function to be evaluated,                | */
 214 /* | store this position also in helppoint.                                | */
 215 /* +-----------------------------------------------------------------------+ */
 216     pos = *new__;
 217     helppoint = pos;
 218 /* +-----------------------------------------------------------------------+ */
 219 /* | Iterate over all points, where the function should be                 | */
 220 /* | evaluated.                                                            | */
 221 /* +-----------------------------------------------------------------------+ */
 222     flag__ = 1;
 223     npts = *maxi + *maxi;
 224     k = 1;
 225     while(k <= npts && k < nprocs) {
 226 /* +-----------------------------------------------------------------------+ */
 227 /* | tid is the id of the prozessor the next points is send to.            | */
 228 /* +-----------------------------------------------------------------------+ */
 229         tid = k + 1;
 230 /* +-----------------------------------------------------------------------+ */
 231 /* | Copy the position into the helparray x.                               | */
 232 /* +-----------------------------------------------------------------------+ */
 233         i__1 = *n;
 234         for (i__ = 1; i__ <= i__1; ++i__) {
 235             x[i__] = c__[pos + i__ * c_dim1];
 236 /* L60: */
 237         }
 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]);
 243         ++k;
 244         pos = point[pos];
 245 /* +-----------------------------------------------------------------------+ */
 246 /* | Get the next point.                                                   | */
 247 /* +-----------------------------------------------------------------------+ */
 248     }
 249 /* +-----------------------------------------------------------------------+ */
 250 /* |  Get data until it is all received.                                   | */
 251 /* +-----------------------------------------------------------------------+ */
 252     datarec = 0;
 253     while(datarec < npts) {
 254         if ((doublereal) datarec / (doublereal) nprocs - datarec / nprocs <
 255                 1e-5 && k <= npts) {
 256             i__1 = *n;
 257             for (i__ = 1; i__ <= i__1; ++i__) {
 258                 x[i__] = c__[pos + i__ * c_dim1];
 259 /* L165: */
 260             }
 261             direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &fhelp, &kret,
 262                       fcn_data);
 263             oldpos = pos;
 264             f[oldpos + f_dim1] = fhelp;
 265             ++datarec;
 266 /* +-----------------------------------------------------------------------+ */
 267 /* | Remember if an infeasible point has been found.                       | */
 268 /* +-----------------------------------------------------------------------+ */
 269             *iinfesiblef = MAX(*iinfesiblef,kret);
 270             if (kret == 0) {
 271 /* +-----------------------------------------------------------------------+ */
 272 /* | if the function evaluation was O.K., set the flag in                  | */
 273 /* | f(pos,2).                                                             | */
 274 /* +-----------------------------------------------------------------------+ */
 275                 f[oldpos + (f_dim1 << 1)] = 0.;
 276                 *ifeasiblef = 0;
 277 /* +-----------------------------------------------------------------------+ */
 278 /* | JG 01/22/01 Added variable to keep track of the maximum value found.  | */
 279 /* +-----------------------------------------------------------------------+ */
 280 /* Computing MAX */
 281                 d__1 = f[pos + f_dim1];
 282                 *fmax = MAX(d__1,*fmax);
 283             }
 284 /* +-----------------------------------------------------------------------+ */
 285 /* | Remember if an infeasible point has been found.                       | */
 286 /* +-----------------------------------------------------------------------+ */
 287             *iinfesiblef = MAX(*iinfesiblef,kret);
 288             if (kret == 1) {
 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;
 296             }
 297 /* +-----------------------------------------------------------------------+ */
 298 /* | If the function could not be evaluated due to a failure in            | */
 299 /* | the setup, mark this.                                                 | */
 300 /* +-----------------------------------------------------------------------+ */
 301             if (kret == -1) {
 302                 f[oldpos + (f_dim1 << 1)] = -1.;
 303             }
 304             ++k;
 305             pos = point[pos];
 306         }
 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;
 312         ++datarec;
 313 /* +-----------------------------------------------------------------------+ */
 314 /* | Remember if an infeasible point has been found.                       | */
 315 /* +-----------------------------------------------------------------------+ */
 316         *iinfesiblef = MAX(*iinfesiblef,kret);
 317         if (kret == 0) {
 318 /* +-----------------------------------------------------------------------+ */
 319 /* | if the function evaluation was O.K., set the flag in                  | */
 320 /* | f(pos,2).                                                             | */
 321 /* +-----------------------------------------------------------------------+ */
 322             f[oldpos + (f_dim1 << 1)] = 0.;
 323             *ifeasiblef = 0;
 324 /* +-----------------------------------------------------------------------+ */
 325 /* | JG 01/22/01 Added variable to keep track of the maximum value found.  | */
 326 /* +-----------------------------------------------------------------------+ */
 327 /* Computing MAX */
 328             d__1 = f[oldpos + f_dim1];
 329             *fmax = MAX(d__1,*fmax);
 330         }
 331         if (kret == 1) {
 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;
 339         }
 340 /* +-----------------------------------------------------------------------+ */
 341 /* | If the function could not be evaluated due to a failure in            | */
 342 /* | the setup, mark this.                                                 | */
 343 /* +-----------------------------------------------------------------------+ */
 344         if (kret == -1) {
 345             f[oldpos + (f_dim1 << 1)] = -1.;
 346         }
 347 /* +-----------------------------------------------------------------------+ */
 348 /* |         Send data until it is all sent.                               | */
 349 /* +-----------------------------------------------------------------------+ */
 350         if (k <= npts) {
 351 /* +-----------------------------------------------------------------------+ */
 352 /* | Copy the position into the helparray x.                               | */
 353 /* +-----------------------------------------------------------------------+ */
 354             i__1 = *n;
 355             for (i__ = 1; i__ <= i__1; ++i__) {
 356                 x[i__] = c__[pos + i__ * c_dim1];
 357 /* L160: */
 358             }
 359             mastersendif_(&tid, &tid, n, &flag__, &pos, &x[1], &u[1], &l[1], &
 360                     x[1]);
 361             ++k;
 362             pos = point[pos];
 363         }
 364     }
 365     pos = helppoint;
 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];
 376             *minpos = pos;
 377         }
 378         pos = point[pos];
 379 /* L50: */
 380     }
 381 } /* dirsamplef_ */