src/algs/direct/DIRserial.c

   1 /* DIRserial-transp.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 /* +-----------------------------------------------------------------------+ */
   9 /* | Program       : Direct.f (subfile DIRserial.f)                        | */
  10 /* | Last modified : 04-12-2001                                            | */
  11 /* | Written by    : Joerg Gablonsky                                       | */
  12 /* | SUBROUTINEs, which differ depENDing on the serial or parallel version.| */
  13 /* +-----------------------------------------------------------------------+ */
  14 /* +-----------------------------------------------------------------------+ */
  15 /* | SUBROUTINE for sampling.                                              | */
  16 /* +-----------------------------------------------------------------------+ */
  17 /* Subroutine */ void direct_dirsamplef_(doublereal *c__, integer *arrayi, doublereal
  18         *delta, integer *sample, integer *new__, integer *length,
  19         FILE *logfile, doublereal *f, integer *free, integer *maxi,
  20         integer *point, fp fcn, doublereal *x, doublereal *l, doublereal *
  21         minf, integer *minpos, doublereal *u, integer *n, integer *maxfunc,
  22         const integer *maxdeep, integer *oops, doublereal *fmax, integer *
  23         ifeasiblef, integer *iinfesiblef, void *fcn_data, int *force_stop)
  24 {
  25     /* System generated locals */
  26     integer length_dim1, length_offset, c_dim1, c_offset, i__1, i__2;
  27     doublereal d__1;
  28
  29     /* Local variables */
  30     integer i__, j, helppoint, pos, kret;
  31
  32 /* +-----------------------------------------------------------------------+ */
  33 /* | JG 07/16/01 fcn must be declared external.                            | */
  34 /* +-----------------------------------------------------------------------+ */
  35 /* +-----------------------------------------------------------------------+ */
  36 /* | JG 07/16/01 Removed fcn.                                              | */
  37 /* +-----------------------------------------------------------------------+ */
  38 /* +-----------------------------------------------------------------------+ */
  39 /* | JG 01/22/01 Added variable to keep track of the maximum value found.  | */
  40 /* |             Added variable to keep track IF feasible point was found. | */
  41 /* +-----------------------------------------------------------------------+ */
  42 /* +-----------------------------------------------------------------------+ */
  43 /* | Variables to pass user defined data to the function to be optimized.  | */
  44 /* +-----------------------------------------------------------------------+ */
  45 /* +-----------------------------------------------------------------------+ */
  46 /* | Set the pointer to the first function to be evaluated,                | */
  47 /* | store this position also in helppoint.                                | */
  48 /* +-----------------------------------------------------------------------+ */
  49     /* Parameter adjustments */
  50     --u;
  51     --l;
  52     --x;
  53     --arrayi;
  54     --point;
  55     f -= 3;
  56     length_dim1 = *n;
  57     length_offset = 1 + length_dim1;
  58     length -= length_offset;
  59     c_dim1 = *n;
  60     c_offset = 1 + c_dim1;
  61     c__ -= c_offset;
  62
  63     /* Function Body */
  64     pos = *new__;
  65     helppoint = pos;
  66 /* +-----------------------------------------------------------------------+ */
  67 /* | Iterate over all points, where the function should be                 | */
  68 /* | evaluated.                                                            | */
  69 /* +-----------------------------------------------------------------------+ */
  70     i__1 = *maxi + *maxi;
  71     for (j = 1; j <= i__1; ++j) {
  72 /* +-----------------------------------------------------------------------+ */
  73 /* | Copy the position into the helparrayy x.                              | */
  74 /* +-----------------------------------------------------------------------+ */
  75         i__2 = *n;
  76         for (i__ = 1; i__ <= i__2; ++i__) {
  77             x[i__] = c__[i__ + pos * c_dim1];
  78 /* L60: */
  79         }
  80 /* +-----------------------------------------------------------------------+ */
  81 /* | Call the function.                                                    | */
  82 /* +-----------------------------------------------------------------------+ */
  83         if (force_stop && *force_stop)  /* skip eval after forced stop */
  84              f[(pos << 1) + 1] = *fmax;
  85         else
  86              direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &f[(pos << 1) + 1],
  87                               &kret, fcn_data);
  88         if (force_stop && *force_stop)
  89              kret = -1; /* mark as invalid point */
  90 /* +-----------------------------------------------------------------------+ */
  91 /* | Remember IF an infeasible point has been found.                       | */
  92 /* +-----------------------------------------------------------------------+ */
  93         *iinfesiblef = MAX(*iinfesiblef,kret);
  94         if (kret == 0) {
  95 /* +-----------------------------------------------------------------------+ */
  96 /* | IF the function evaluation was O.K., set the flag in                  | */
  97 /* | f(2,pos). Also mark that a feasible point has been found.             | */
  98 /* +-----------------------------------------------------------------------+ */
  99             f[(pos << 1) + 2] = 0.;
 100             *ifeasiblef = 0;
 101 /* +-----------------------------------------------------------------------+ */
 102 /* | JG 01/22/01 Added variable to keep track of the maximum value found.  | */
 103 /* +-----------------------------------------------------------------------+ */
 104 /* Computing MAX */
 105             d__1 = f[(pos << 1) + 1];
 106             *fmax = MAX(d__1,*fmax);
 107         }
 108         if (kret >= 1) {
 109 /* +-----------------------------------------------------------------------+ */
 110 /* |  IF the function could not be evaluated at the given point,            | */
 111 /* | set flag to mark this (f(2,pos) and store the maximum                 | */
 112 /* | box-sidelength in f(1,pos).                                           | */
 113 /* +-----------------------------------------------------------------------+ */
 114             f[(pos << 1) + 2] = 2.;
 115             f[(pos << 1) + 1] = *fmax;
 116         }
 117 /* +-----------------------------------------------------------------------+ */
 118 /* |  IF the function could not be evaluated due to a failure in            | */
 119 /* | the setup, mark this.                                                 | */
 120 /* +-----------------------------------------------------------------------+ */
 121         if (kret == -1) {
 122             f[(pos << 1) + 2] = -1.;
 123         }
 124 /* +-----------------------------------------------------------------------+ */
 125 /* | Set the position to the next point, at which the function             | */
 126 /* | should e evaluated.                                                   | */
 127 /* +-----------------------------------------------------------------------+ */
 128         pos = point[pos];
 129 /* L40: */
 130     }
 131     pos = helppoint;
 132 /* +-----------------------------------------------------------------------+ */
 133 /* | Iterate over all evaluated points and see, IF the minimal             | */
 134 /* | value of the function has changed.  IF this has happEND,               | */
 135 /* | store the minimal value and its position in the array.                | */
 136 /* | Attention: Only valid values are checked!!                           | */
 137 /* +-----------------------------------------------------------------------+ */
 138     i__1 = *maxi + *maxi;
 139     for (j = 1; j <= i__1; ++j) {
 140         if (f[(pos << 1) + 1] < *minf && f[(pos << 1) + 2] == 0.) {
 141             *minf = f[(pos << 1) + 1];
 142             *minpos = pos;
 143         }
 144         pos = point[pos];
 145 /* L50: */
 146     }
 147 } /* dirsamplef_ */