added Fortran mconstraint API

darcs-hash:20100715215105-c8de0-d8e48d946df4aad8a0e7cf7e9664a3519a4f2b13.gz

diff --git a/NEWS b/NEWS
index a3ba70835ddb1e759e4077675e5e7d222748f9b1..30cbcef28d7422f9c8151effb076efaeb15631b0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,8 @@ NLopt 2.2 (15 July 2010)
 * Added GUILE_INSTALL_DIR variable to allow the user to change the
   Guile installation directory.
 
+* Added Fortran interface for vector-valued constraints.
+
 * Throw correct exceptions in Python for the add_*constraint functions;
   thanks to Dmitrey Kroshko for the bug report.
 

diff --git a/api/f77api.c b/api/f77api.c
index fbc8e76339af44b94a422fe726d3cf2bce9d8932..0f50f6cf71942736d1cc0cca290f5edeea3d4443 100644 (file)
--- a/api/f77api.c
+++ b/api/f77api.c
@@ -32,8 +32,14 @@ typedef void (*nlopt_f77_func)(double *val, const int *n, const double *x,
                               double *gradient, const int *need_gradient,
                               void *func_data);
 
+typedef void (*nlopt_f77_mfunc)(const int *m,
+                               double *val, const int *n, const double *x,
+                               double *gradient, const int *need_gradient,
+                               void *func_data);
+
 typedef struct {
      nlopt_f77_func f;
+     nlopt_f77_mfunc mf;
      void *f_data;
 } f77_func_data;
 
@@ -63,6 +69,15 @@ static double f77_func_wrap(unsigned n, const double *x, double *grad, void *dat
      return val;
 }
 
+static void f77_mfunc_wrap(unsigned m, double *result, unsigned n, const double *x, double *grad, void *data)
+{
+     f77_func_data *d = (f77_func_data *) data;
+     int mi = (int) m;
+     int ni = (int) n;
+     int need_gradient = grad != 0;
+     d->mf(&mi, result, &ni, x, grad, &need_gradient, d->f_data);
+}
+
 /*-----------------------------------------------------------------------*/
 
 #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); }

diff --git a/api/f77funcs_.h b/api/f77funcs_.h
index 48b2ab163557287daf15e695824c049e09171791..8641535cafd372e46c81a950bb040f66521605c3 100644 (file)
--- a/api/f77funcs_.h
+++ b/api/f77funcs_.h
@@ -97,6 +97,21 @@ void F77_(nlo_add_inequality_constraint,NLO_ADD_INEQUALITY_CONSTRAINT)(
      *ret = (int) nlopt_add_inequality_constraint(*opt, f77_func_wrap,d, *tol);
 }
 
+void F77_(nlo_add_inequality_mconstraint,NLO_ADD_INEQUALITY_MCONSTRAINT)(
+     int *ret, nlopt_opt *opt, int *m,
+     nlopt_f77_mfunc mfc, void *mfc_data, double *tol)
+{
+     f77_func_data *d;
+     if (*m < 0) { *ret = (int) NLOPT_INVALID_ARGS; return; }
+     if (*m == 0) { *ret = (int) NLOPT_SUCCESS; return; }
+     d = (f77_func_data*) malloc(sizeof(f77_func_data));
+     if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+     d->mf = mfc;
+     d->f_data = mfc_data;
+     *ret = (int) nlopt_add_inequality_mconstraint(*opt, (unsigned) *m, 
+                                                  f77_mfunc_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);
@@ -112,6 +127,21 @@ void F77_(nlo_add_equality_constraint,NLO_ADD_EQUALITY_CONSTRAINT)(
      *ret = (int) nlopt_add_equality_constraint(*opt, f77_func_wrap,d, *tol);
 }
 
+void F77_(nlo_add_equality_mconstraint,NLO_ADD_EQUALITY_MCONSTRAINT)(
+     int *ret, nlopt_opt *opt, int *m,
+     nlopt_f77_mfunc mfc, void *mfc_data, double *tol)
+{
+     f77_func_data *d;
+     if (*m < 0) { *ret = (int) NLOPT_INVALID_ARGS; return; }
+     if (*m == 0) { *ret = (int) NLOPT_SUCCESS; return; }
+     d = (f77_func_data*) malloc(sizeof(f77_func_data));
+     if (!d) { *ret = (int) NLOPT_OUT_OF_MEMORY; return; }
+     d->mf = mfc;
+     d->f_data = mfc_data;
+     *ret = (int) nlopt_add_equality_mconstraint(*opt, (unsigned) *m, 
+                                                f77_mfunc_wrap, d, tol);
+}
+
 F77_GETSET(stopval, STOPVAL, double)
 F77_GETSET(ftol_rel, FTOL_REL, double)
 F77_GETSET(ftol_abs, FTOL_ABS, double)