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         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, 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         direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &f[(pos << 1) + 1],
  84                          &kret, fcn_data);
  85 /* +-----------------------------------------------------------------------+ */
  86 /* | Remember IF an infeasible point has been found.                       | */
  87 /* +-----------------------------------------------------------------------+ */
  88         *iinfesiblef = MAX(*iinfesiblef,kret);
  89         if (kret == 0) {
  90 /* +-----------------------------------------------------------------------+ */
  91 /* | IF the function evaluation was O.K., set the flag in                  | */
  92 /* | f(2,pos). Also mark that a feasible point has been found.             | */
  93 /* +-----------------------------------------------------------------------+ */
  94             f[(pos << 1) + 2] = 0.;
  95             *ifeasiblef = 0;
  96 /* +-----------------------------------------------------------------------+ */
  97 /* | JG 01/22/01 Added variable to keep track of the maximum value found.  | */
  98 /* +-----------------------------------------------------------------------+ */
  99 /* Computing MAX */
 100             d__1 = f[(pos << 1) + 1];
 101             *fmax = MAX(d__1,*fmax);
 102         }
 103         if (kret >= 1) {
 104 /* +-----------------------------------------------------------------------+ */
 105 /* |  IF the function could not be evaluated at the given point,            | */
 106 /* | set flag to mark this (f(2,pos) and store the maximum                 | */
 107 /* | box-sidelength in f(1,pos).                                           | */
 108 /* +-----------------------------------------------------------------------+ */
 109             f[(pos << 1) + 2] = 2.;
 110             f[(pos << 1) + 1] = *fmax;
 111         }
 112 /* +-----------------------------------------------------------------------+ */
 113 /* |  IF the function could not be evaluated due to a failure in            | */
 114 /* | the setup, mark this.                                                 | */
 115 /* +-----------------------------------------------------------------------+ */
 116         if (kret == -1) {
 117             f[(pos << 1) + 2] = -1.;
 118         }
 119 /* +-----------------------------------------------------------------------+ */
 120 /* | Set the position to the next point, at which the function             | */
 121 /* | should e evaluated.                                                   | */
 122 /* +-----------------------------------------------------------------------+ */
 123         pos = point[pos];
 124 /* L40: */
 125     }
 126     pos = helppoint;
 127 /* +-----------------------------------------------------------------------+ */
 128 /* | Iterate over all evaluated points and see, IF the minimal             | */
 129 /* | value of the function has changed.  IF this has happEND,               | */
 130 /* | store the minimal value and its position in the array.                | */
 131 /* | Attention: Only valied values are checked!!                           | */
 132 /* +-----------------------------------------------------------------------+ */
 133     i__1 = *maxi + *maxi;
 134     for (j = 1; j <= i__1; ++j) {
 135         if (f[(pos << 1) + 1] < *minf && f[(pos << 1) + 2] == 0.) {
 136             *minf = f[(pos << 1) + 1];
 137             *minpos = pos;
 138         }
 139         pos = point[pos];
 140 /* L50: */
 141     }
 142 } /* dirsamplef_ */