added Fortran mconstraint API

darcs-hash:20100715215105-c8de0-d8e48d946df4aad8a0e7cf7e9664a3519a4f2b13.gz

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.
 

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); }

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)