From 0f1868e3ad50df9cbeb95cc9654dd808c7cc5266 Mon Sep 17 00:00:00 2001 From: stevenj Date: Fri, 29 Aug 2008 16:28:43 -0400 Subject: [PATCH] added Fortran interface darcs-hash:20080829202843-c8de0-7ecb4ea295e318fea8b8840b15787302c672e744.gz --- api/Makefile.am | 15 ++++++- api/f77api.c | 98 ++++++++++++++++++++++++++++++++++++++++++++ api/f77funcs.h | 105 ++++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 5 +++ 4 files changed, 221 insertions(+), 2 deletions(-) create mode 100644 api/f77api.c create mode 100644 api/f77funcs.h diff --git a/api/Makefile.am b/api/Makefile.am index f22a0b5..8fa22fd 100644 --- a/api/Makefile.am +++ b/api/Makefile.am @@ -1,7 +1,18 @@ AM_CPPFLAGS = -I$(top_srcdir)/cdirect -I$(top_srcdir)/direct -I$(top_srcdir)/stogo -I$(top_srcdir)/subplex -I$(top_srcdir)/praxis -I$(top_srcdir)/lbfgs -I$(top_srcdir)/luksan -I$(top_srcdir)/crs -I$(top_srcdir)/mlsl -I$(top_srcdir)/mma -I$(top_srcdir)/cobyla -I$(top_srcdir)/util -include_HEADERS = nlopt.h +include_HEADERS = nlopt.h nlopt.f noinst_LTLIBRARIES = libapi.la dist_man_MANS = nlopt_minimize.3 nlopt_minimize_constrained.3 -libapi_la_SOURCES = nlopt.c nlopt.h +libapi_la_SOURCES = nlopt.c nlopt.h f77api.c f77funcs.h + +BUILT_SOURCES = nlopt.f + +if MAINTAINER_MODE +# convert constants to F77 parameter statements + +nlopt.f: nlopt.h + rm -f $@ + (i=0; egrep 'NLOPT_[LG][DN]' $(srcdir)/nlopt.h | tr -d ' =0,' | while read n; do echo " integer $$n"; echo " parameter ($$n=$$i)"; i=`expr $$i + 1`; done; tail -n +`grep -n enum $(srcdir)/nlopt.h |cut -d: -f1 |tail -n 1` $(srcdir)/nlopt.h | grep NLOPT | cut -d, -f1 | tr -d ' ' | perl -pe 's/([A-Za-z0-9_]+)=([-+0-9]+)/ integer \1\n parameter (\1=\2)/') > $@ + +endif diff --git a/api/f77api.c b/api/f77api.c new file mode 100644 index 0000000..1adf45c --- /dev/null +++ b/api/f77api.c @@ -0,0 +1,98 @@ +/* Copyright (c) 2007-2008 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. + */ + +#include + +#include "nlopt.h" +#include "config.h" + +/*-----------------------------------------------------------------------*/ +/* wrappers around f77 procedures */ + +typedef void (*nlopt_f77_func)(double *val, const int *n, const double *x, + double *gradient, const int *need_gradient, + void *func_data); + +typedef struct { + nlopt_f77_func f; + void *f_data; +} f77_func_data; + +static double f77_func_wrap(int n, const double *x, double *grad, void *data) +{ + f77_func_data *d = (f77_func_data *) data; + double val; + int need_gradient = grad != 0; + d->f(&val, &n, x, grad, &need_gradient, d->f_data); + return val; +} + +/*-----------------------------------------------------------------------*/ +/* 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 + +/* name + underscore is by far the most common (gfortran, g77, Intel, ...) */ +# define F77(a, A) a ## _ +# include "f77funcs.h" + +/* 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" + +/* Digital/Compaq/HP Visual Fortran, Intel Fortran. stdcall attribute + is apparently required to adjust for calling conventions (callee + pops stack in stdcall). See also: + 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 +# include "f77funcs.h" + +#endif /* WINDOWS_F77_MANGLING */ diff --git a/api/f77funcs.h b/api/f77funcs.h new file mode 100644 index 0000000..87ae76e --- /dev/null +++ b/api/f77funcs.h @@ -0,0 +1,105 @@ +/* Copyright (c) 2007-2008 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. + + In homage to Fortran 77, we stick with 6-character subroutine names. + The return value of the function is converted into the first argument + of the subroutine. */ + +/* nlopt_minimize_constrained */ +void F77(nloptc,NLOPTC)(int *info, + const int *algorithm, + const int *n, nlopt_f77_func f, void *f_data, + const int *m, nlopt_f77_func fc, + char *fc_data, char *fc_second_datum, + const double *lb, const double *ub, + double *x, double *minf, + const double *minf_max, + const double *ftol_rel, const double *ftol_abs, + const double *xtol_rel, const double *xtol_abs, + const int *have_xtol_abs, + const int *maxeval, const double *maxtime) +{ + f77_func_data d, *dc; + int i; + + d.f = f; d.f_data = f_data; + if (*m < 0) { *info = NLOPT_INVALID_ARGS; return; } + dc = (f77_func_data *) malloc(sizeof(f77_func_data) * *m); + if (*m > 0 && !dc) { *info = NLOPT_OUT_OF_MEMORY; return; } + for (i = 0; i < *m; ++i) { + dc[i].f = fc; + dc[i].f_data = fc_data + i * (fc_second_datum - fc_data); + } + + *info = nlopt_minimize_constrained((nlopt_algorithm) *algorithm, + *n, f77_func_wrap, &d, + *m, f77_func_wrap, + dc, sizeof(f77_func_data), + lb, ub, x, minf, + *minf_max, *ftol_rel, *ftol_abs, + *xtol_rel, + *have_xtol_abs ? xtol_abs : 0, + *maxeval, *maxtime); + + if (dc) free(dc); +} + +/* nlopt_minimize */ +void F77(nloptm,NLOPTM)(int *info, + const int *algorithm, + const int *n, nlopt_f77_func f, void *f_data, + const double *lb, const double *ub, + double *x, double *minf, + const double *minf_max, + const double *ftol_rel, const double *ftol_abs, + const double *xtol_rel, const double *xtol_abs, + const int *have_xtol_abs, + const int *maxeval, const double *maxtime) +{ + int m = 0; + F77(nloptc,NLOPTC)(info, algorithm, n, f, f_data, &m, 0, 0, 0, + lb, ub, x, minf, minf_max, ftol_rel, ftol_abs, + xtol_rel, xtol_abs, have_xtol_abs, maxeval, maxtime); +} + +void F77(nlosr,NLOSR)(const int *seed) { nlopt_srand((unsigned long) *seed); } +void F77(nlosrt,NLOSRT)(void) { nlopt_srand_time(); } +void F77(nloptv,NLOPTV)(int *major, int *minor, int *bugfix) { + nlopt_version(major, minor, bugfix); +} +void F77(nlogls,NLOGLS)(int *ideriv, int *inonderiv, int *maxeval) +{ + nlopt_algorithm deriv, nonderiv; + nlopt_get_local_search_algorithm(&deriv, &nonderiv, maxeval); + *ideriv = deriv; + *inonderiv = nonderiv; +} +void F77(nlosls,NLOSLS)(int *ideriv, int *inonderiv, int *maxeval) +{ + nlopt_algorithm deriv = (nlopt_algorithm) *ideriv; + nlopt_algorithm nonderiv = (nlopt_algorithm) *inonderiv; + nlopt_set_local_search_algorithm(deriv, nonderiv, *maxeval); +} diff --git a/configure.ac b/configure.ac index 11dc862..ea89584 100644 --- a/configure.ac +++ b/configure.ac @@ -30,6 +30,11 @@ if test "x$with_cxx" = xyes; then 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 -- GitLab