direct/DIRserial.c

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