dist_man_MANS = nlopt.3
libapi_la_SOURCES = general.c options.c optimize.c deprecated.c \
-nlopt-internal.h nlopt.h f77api.c f77funcs.h
+nlopt-internal.h nlopt.h f77api.c f77funcs.h f77funcs_.h
BUILT_SOURCES = nlopt.f nlopt.hpp
EXTRA_DIST = nlopt-in.hpp
#include <stdlib.h>
-#include "nlopt.h"
-#include "nlopt-util.h"
+#include "nlopt-internal.h"
/*-----------------------------------------------------------------------*/
/* wrappers around f77 procedures */
void *f_data;
} f77_func_data;
-static double f77_func_wrap(int n, const double *x, double *grad, void *data)
+static double f77_func_wrap_old(int n, const double *x, double *grad, void *data)
{
f77_func_data *d = (f77_func_data *) data;
double val;
return val;
}
+static double f77_func_wrap(unsigned n, const double *x, double *grad, void *data)
+{
+ f77_func_data *d = (f77_func_data *) data;
+ int ni = (int) n;
+ double val;
+ int need_gradient = grad != 0;
+ d->f(&val, &ni, x, grad, &need_gradient, d->f_data);
+ return val;
+}
+
+/*-----------------------------------------------------------------------*/
+
+#define F77_GET(name,NAME,T) void F77_(nlo_get_##name,NLO_GET_##NAME)(T *val, nlopt_opt *opt) { *val = (T) nlopt_get_##name(*opt); }
+#define F77_SET(name,NAME,T) void F77_(nlo_set_##name,NLO_SET_##NAME)(int *ret, nlopt_opt *opt, T *val) { *ret = (int) nlopt_set_##name(*opt, *val); }
+#define F77_GETSET(name,NAME,T) F77_GET(name,NAME,T) F77_SET(name,NAME,T)
+
+#define F77_GETA(name,NAME,T) void F77_(nlo_get_##name,NLO_GET_##NAME)(int *ret, T *val, nlopt_opt *opt) { *ret = (int) nlopt_get_##name(*opt, val); }
+#define F77_SETA(name,NAME,T) void F77_(nlo_set_##name,NLO_SET_##NAME)(int *ret, nlopt_opt *opt, T *val) { *ret = (int) nlopt_set_##name(*opt, val); }
+#define F77_GETSETA(name,NAME,T) F77_GETA(name,NAME,T) F77_SETA(name,NAME,T) F77_SET(name##1,NAME##1,T)
+
/*-----------------------------------------------------------------------*/
/* rather than trying to detect the Fortran name-mangling scheme with
autoconf, we just include wrappers with all common name-mangling
schemes ... this avoids problems and also allows us to work with
- multiple Fortran compilers on the same machine .
-
- Note that our Fortran function names do not contain underscores;
- otherwise, we would need to deal with the additional headache that
- g77 appends two underscores in that case. */
-
-#ifndef WINDOWS_F77_MANGLING
+ multiple Fortran compilers on the same machine. Since the Fortran
+ wrapper functions are so small, the library bloat of including them
+ multiple times is negligible and seems well worth the benefit. */
/* name + underscore is by far the most common (gfortran, g77, Intel, ...) */
# define F77(a, A) a ## _
# include "f77funcs.h"
+/* also include g77 convention of name + double underscore for identifiers
+ containing underscores */
+# define F77_(a, A) a ## __
+# include "f77funcs_.h"
+# undef F77_
+
/* AIX and HPUX use just the lower-case name */
# undef F77
# define F77(a, A) a
# include "f77funcs.h"
-/* old Cray UNICOS used just the upper-case name */
-# undef F77
-# define F77(a, A) A
-# include "f77funcs.h"
-
-#else /* WINDOWS_F77_MANGLING */
-
-/* Various mangling conventions common (?) under Windows. */
-
-/* name + underscore for gfortran, g77, ...? */
-# define F77(a, A) a ## _
-# include "f77funcs.h"
+/* Old Cray Unicos, as well as several Windows Fortran compilers
+ (Digital/Compaq/HP Visual Fortran and Intel Fortran) use all-uppercase
+ name */
/* Digital/Compaq/HP Visual Fortran, Intel Fortran. stdcall attribute
is apparently required to adjust for calling conventions (callee
http://msdn.microsoft.com/library/en-us/vccore98/html/_core_mixed.2d.language_programming.3a_.overview.asp
*/
# undef F77
-# if defined(__GNUC__)
-# define F77(a, A) __attribute__((stdcall)) A
-# elif defined(_MSC_VER) || defined(_ICC) || defined(_STDCALL_SUPPORTED)
-# define F77(a, A) __stdcall A
-# else
-# define F77(a, A) A /* oh well */
-# endif
+# define F77(a, A) NLOPT_STDCALL A
# include "f77funcs.h"
-
-#endif /* WINDOWS_F77_MANGLING */
}
*info = nlopt_minimize_constrained((nlopt_algorithm) *algorithm,
- *n, f77_func_wrap, &d,
- *m, f77_func_wrap,
+ *n, f77_func_wrap_old, &d,
+ *m, f77_func_wrap_old,
dc, sizeof(f77_func_data),
lb, ub, x, minf,
*minf_max, *ftol_rel, *ftol_abs,
{
nlopt_set_stochastic_population(*pop);
}
+
+#define F77_(name,NAME) F77(name,NAME)
+# include "f77funcs_.h"
+#undef F77_
--- /dev/null
+/* Copyright (c) 2007-2010 Massachusetts Institute of Technology
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining
+ * a copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be
+ * included in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+ * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+ * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+ * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+/* Fortran API wrappers, using the F77 macro defined in f77api.c.
+ This header file is #included one or more times from f77api.c
+ in order to define verions of the Fortran API for various compilers.
+
+ All of the functions in this file have underscores in their names,
+ which means that they are treated differently for name-mangling
+ (thank you, g77 and f2c) than names without underscores.
+
+ The return value of a function is converted to the first argument
+ of a subroutine. */
+
+void F77_(nlo_create,NLO_CREATE)(nlopt_opt *opt, int *alg, int *n)
+{
+ if (*n < 0) *opt = NULL;
+ else {
+ *opt = nlopt_create((nlopt_algorithm) *alg, (unsigned) *n);
+ (*opt)->free_f_data = 1;
+ }
+}
+
+void F77_(nlo_destroy,NLO_DESTROY)(nlopt_opt *opt)
+{
+ nlopt_destroy(*opt);
+}
+
+void F77_(nlo_optimize,NLO_OPTIMIZE)(int *ret,
+ nlopt_opt *opt, double *x, double *optf)
+{
+ *ret = (int) nlopt_optimize(*opt, x, optf);
+}
+
+void F77_(nlo_set_min_objective,NLO_SET_MIN_OBJECTIVE)(
+ int *ret, nlopt_opt *opt, nlopt_f77_func f, void *f_data)
+{
+ f77_func_data *d = (f77_func_data*) malloc(sizeof(f77_func_data));
+ if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+ d->f = f;
+ d->f_data = f_data;
+ *ret = (int) nlopt_set_min_objective(*opt, f77_func_wrap, d);
+ /* FIXME: memory leak in nlopt_destroy */
+}
+
+void F77_(nlo_set_max_objective,NLO_SET_MAX_OBJECTIVE)(
+ int *ret, nlopt_opt *opt, nlopt_f77_func f, void *f_data)
+{
+ f77_func_data *d = (f77_func_data*) malloc(sizeof(f77_func_data));
+ if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+ d->f = f;
+ d->f_data = f_data;
+ *ret = (int) nlopt_set_max_objective(*opt, f77_func_wrap, d);
+}
+
+F77_GET(algorithm, ALGORITHM, int)
+F77_GET(dimension, DIMENSION, int)
+
+F77_GETSETA(lower_bounds, LOWER_BOUNDS, double)
+F77_GETSETA(upper_bounds, UPPER_BOUNDS, double)
+
+void F77_(nlo_remove_inequality_constraints,NLO_REMOVE_INEQUALITY_CONSTRAINTS)(
+ int *ret, nlopt_opt *opt) {
+ *ret = (int) nlopt_remove_inequality_constraints(*opt);
+}
+
+void F77_(nlo_add_inequality_constraint,NLO_ADD_INEQUALITY_CONSTRAINT)(
+ int *ret, nlopt_opt *opt, nlopt_f77_func fc, void *fc_data, double *tol)
+{
+ f77_func_data *d = (f77_func_data*) malloc(sizeof(f77_func_data));
+ if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+ d->f = fc;
+ d->f_data = fc_data;
+ *ret = (int) nlopt_add_inequality_constraint(*opt, f77_func_wrap,d, *tol);
+}
+
+void F77_(nlo_remove_equality_constraints,NLO_REMOVE_EQUALITY_CONSTRAINTS)(
+ int *ret, nlopt_opt *opt) {
+ *ret = (int) nlopt_remove_equality_constraints(*opt);
+}
+
+void F77_(nlo_add_equality_constraint,NLO_ADD_EQUALITY_CONSTRAINT)(
+ int *ret, nlopt_opt *opt, nlopt_f77_func fc, void *fc_data, double *tol)
+{
+ f77_func_data *d = (f77_func_data*) malloc(sizeof(f77_func_data));
+ if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+ d->f = fc;
+ d->f_data = fc_data;
+ *ret = (int) nlopt_add_equality_constraint(*opt, f77_func_wrap,d, *tol);
+}
+
+F77_GETSET(stopval, STOPVAL, double)
+F77_GETSET(ftol_rel, FTOL_REL, double)
+F77_GETSET(ftol_abs, FTOL_ABS, double)
+F77_GETSET(xtol_rel, XTOL_REL, double)
+F77_GETSETA(xtol_abs, XTOL_ABS, double)
+F77_GETSET(maxeval, MAXEVAL, int)
+F77_GETSET(maxtime, MAXTIME, double)
+
+F77_GETSET(force_stop, FORCE_STOP, int)
+void F77_(nlo_force_stop,NLO_FORCE_STOP)(int *ret, nlopt_opt *opt) {
+ *ret = (int) nlopt_force_stop(*opt);
+}
+
+F77_SET(local_optimizer, LOCAL_OPTIMIZER, nlopt_opt)
+F77_GETSET(population, POPULATION, unsigned)
+
+F77_SETA(default_initial_step, DEFAULT_INITIAL_STEP, double)
+F77_SETA(initial_step, INITIAL_STEP, double)
+F77_SET(initial_step1, INITIAL_STEP1, double)
+void F77_(nlo_get_initial_step, NLO_GET_INITIAL_STEP)(
+ int *ret, nlopt_opt *opt, const double *x, double *dx) {
+ *ret = (int) nlopt_get_initial_step(*opt, x, dx);
+}
unsigned p_alloc; /* number of inequality constraints allocated */
nlopt_constraint *h; /* equality constraints, length p_alloc */
+ int free_f_data; /* flag (for f77 api) to free f_data in nlopt_destroy */
+
/* stopping criteria */
double stopval; /* stop when f reaches stopval or better */
double ftol_rel, ftol_abs; /* relative/absolute f tolerances */
void nlopt_destroy(nlopt_opt opt)
{
if (opt) {
+ if (opt->free_f_data) {
+ unsigned i;
+ free(opt->f_data);
+ for (i = 0; i < opt->m; ++i)
+ free(opt->fc[i].f_data);
+ for (i = 0; i < opt->p; ++i)
+ free(opt->h[i].f_data);
+ }
free(opt->lb); free(opt->ub);
free(opt->xtol_abs);
free(opt->fc);
opt->n = n;
opt->f = NULL; opt->f_data = NULL;
opt->maximize = 0;
+ opt->free_f_data = 0;
opt->lb = opt->ub = NULL;
opt->m = opt->m_alloc = 0;
nopt->local_opt = NULL;
nopt->dx = NULL;
opt->force_stop_child = NULL;
+ opt->free_f_data = 0;
if (opt->n > 0) {
nopt->lb = (double *) malloc(sizeof(double) * (opt->n));
{
if (opt) {
opt->f = f; opt->f_data = f_data;
+ if (f_data) opt->free_f_data = 0;
opt->maximize = 0;
if (nlopt_isinf(opt->stopval) && opt->stopval > 0)
opt->stopval = -HUGE_VAL; /* switch default from max to min */
{
if (opt) {
opt->f = f; opt->f_data = f_data;
+ if (f_data) opt->free_f_data = 0;
opt->maximize = 1;
if (nlopt_isinf(opt->stopval) && opt->stopval < 0)
opt->stopval = +HUGE_VAL; /* switch default from min to max */
&& opt->algorithm != NLOPT_GN_ORIG_DIRECT
&& opt->algorithm != NLOPT_GN_ORIG_DIRECT_L)
return NLOPT_INVALID_ARGS;
-
+ if (fc_data) opt->free_f_data = 0;
return add_constraint(&opt->m, &opt->m_alloc, &opt->fc,
fc, fc_data, tol);
}
/* equality constraints (h(x) = 0) only via some algorithms */
if (!AUGLAG_ALG(opt->algorithm) && opt->algorithm != NLOPT_GN_ISRES)
return NLOPT_INVALID_ARGS;
-
+ if (h_data) opt->free_f_data = 0;
return add_constraint(&opt->p, &opt->p_alloc, &opt->h,
h, h_data, tol);
}
fi
AC_SUBST(NLOPT_SUFFIX)
-AC_ARG_WITH(windows-f77-mangling, [AC_HELP_STRING([--with-windows-f77-mangling],[use common Win32 Fortran interface styles])], with_windows_f77_mangling=$withval, with_windows_f77_mangling=no)
-if test "$with_windows_f77_mangling" = "yes"; then
- AC_DEFINE(WINDOWS_F77_MANGLING,1,[Use common Windows Fortran mangling styles for the Fortran interfaces.])
-fi
-
dnl Checks for typedefs, structures, and compiler characteristics.
AC_HEADER_STDC
AC_HEADER_TIME
~ianmdlvl / nlopt.git / commitdiff