1 /* DIRserial-transp.f -- translated by f2c (version 20050501).
3 f2c output hand-cleaned by SGJ (August 2007).
6 #include "direct-internal.h"
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)
25 /* System generated locals */
26 integer length_dim1, length_offset, c_dim1, c_offset, i__1, i__2;
30 integer i__, j, helppoint, pos, kret;
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 */
57 length_offset = 1 + length_dim1;
58 length -= length_offset;
60 c_offset = 1 + c_dim1;
66 /* +-----------------------------------------------------------------------+ */
67 /* | Iterate over all points, where the function should be | */
69 /* +-----------------------------------------------------------------------+ */
71 for (j = 1; j <= i__1; ++j) {
72 /* +-----------------------------------------------------------------------+ */
73 /* | Copy the position into the helparrayy x. | */
74 /* +-----------------------------------------------------------------------+ */
76 for (i__ = 1; i__ <= i__2; ++i__) {
77 x[i__] = c__[i__ + pos * c_dim1];
80 /* +-----------------------------------------------------------------------+ */
81 /* | Call the function. | */
82 /* +-----------------------------------------------------------------------+ */
83 if (force_stop && *force_stop) /* skip eval after forced stop */
84 f[(pos << 1) + 1] = *fmax;
86 direct_dirinfcn_(fcn, &x[1], &l[1], &u[1], n, &f[(pos << 1) + 1],
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);
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.;
101 /* +-----------------------------------------------------------------------+ */
102 /* | JG 01/22/01 Added variable to keep track of the maximum value found. | */
103 /* +-----------------------------------------------------------------------+ */
105 d__1 = f[(pos << 1) + 1];
106 *fmax = MAX(d__1,*fmax);
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;
117 /* +-----------------------------------------------------------------------+ */
118 /* | IF the function could not be evaluated due to a failure in | */
119 /* | the setup, mark this. | */
120 /* +-----------------------------------------------------------------------+ */
122 f[(pos << 1) + 2] = -1.;
124 /* +-----------------------------------------------------------------------+ */
125 /* | Set the position to the next point, at which the function | */
126 /* | should e evaluated. | */
127 /* +-----------------------------------------------------------------------+ */
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];