Mercurial > octave

changeset 255:98246fedc941

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1993-12-08 22:55:41 by jwe]
author jwe
date Wed, 08 Dec 1993 22:55:52 +0000
parents c9894e8d5f04
children e592734b002b
files liboctave/NPSOL.cc liboctave/NPSOL.h src/npsol.cc
diffstat 3 files changed, 83 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/liboctave/NPSOL.cc	Wed Dec 08 07:30:53 1993 +0000
+++ b/liboctave/NPSOL.cc	Wed Dec 08 22:55:52 1993 +0000
@@ -38,13 +38,22 @@
   int F77_FCN (npoptn) (char *, long);
 
   int F77_FCN (npsol) (int *, int *, int *, int *, int *, int *,
-		       double *, double *, double *, int (*)(),
-		       int (*)(), int *, int *, int *, double *,
+		       double *, double *, double *,
+		       int (*)(int*, int*, int*, int*, int*, double*,
+			       double*, double*, int*),
+		       int (*)(int*, int*, double*, double*, double*, int*),
+		       int *, int *, int *, double *,
 		       double *, double *, double *, double *,
 		       double *, double *, int *, int *, double *,
 		       int *); 
 }
 
+// XXX FIXME XXX -- would be nice to not have to have this global
+// variable.
+// Nonzero means an error occurred in the calculation of the objective
+// function, and the user wants us to quit.
+int npsol_objective_error = 0;
+
 static objective_fcn user_phi;
 static gradient_fcn user_grad;
 static nonlinear_fcn user_g;
@@ -57,12 +66,21 @@
   int nn = *n;
   Vector tmp_x (nn);
 
+  npsol_objective_error = 0;
+
   for (int i = 0; i < nn; i++)
     tmp_x.elem (i) = xx[i];
 
   if (*mode == 0 || *mode == 2)
     {
       double value = (*user_phi) (tmp_x);
+
+      if (npsol_objective_error)
+	{
+	  *mode = -1;
+	  return 0;
+	}
+
 #if defined (sun) && defined (__GNUC__)
       assign_double (objf, value);
 #else
@@ -76,8 +94,13 @@
 
       tmp_grad = (*user_grad) (tmp_x);
 
-      for (i = 0; i < nn; i++)
-	objgrd[i] = tmp_grad.elem (i);
+      if (tmp_grad.length () == 0)
+	*mode = -1;
+      else
+	{
+	  for (i = 0; i < nn; i++)
+	    objgrd[i] = tmp_grad.elem (i);
+	}
     }
 
   return 0;
@@ -96,8 +119,16 @@
 
   tmp_c = (*user_g) (tmp_x);
 
-  for (i = 0; i < nncnln; i++)
-    cons[i] = tmp_c.elem (i);
+  if (tmp_c.length () == 0)
+    {
+      *mode = -1;
+      return 0;
+    }
+  else
+    {
+      for (i = 0; i < nncnln; i++)
+	cons[i] = tmp_c.elem (i);
+    }
 
   if (user_jac != NULL)
     {
@@ -105,10 +136,15 @@
 
       tmp_jac = (*user_jac) (tmp_x);
 
-      int ld = *nrowj;
-      for (int j = 0; j < nn; j++)
-	for (i = 0; i < nncnln; i++)
-	  cjac[i+j*ld] = tmp_jac (i, j);
+      if (tmp_jac.rows () == 0 || tmp_jac.columns () == 0)
+	*mode = -1;
+      else
+	{
+	  int ld = *nrowj;
+	  for (int j = 0; j < nn; j++)
+	    for (i = 0; i < nncnln; i++)
+	      cjac[i+j*ld] = tmp_jac (i, j);
+	}
     }
 
   return 0;
--- a/liboctave/NPSOL.h	Wed Dec 08 07:30:53 1993 +0000
+++ b/liboctave/NPSOL.h	Wed Dec 08 22:55:52 1993 +0000
@@ -92,6 +92,12 @@
 
 };
 
+// XXX FIXME XXX -- would be nice to not have to have this global
+// variable.
+// Nonzero means an error occurred in the calculation of the objective
+// function, and the user wants us to quit.
+extern int npsol_objective_error;
+
 inline NPSOL::NPSOL (const NPSOL& a) : NLP (a.x, a.phi, a.bnds, a.lc, a.nlc)
   { set_default_options (); }
 
--- a/src/npsol.cc	Wed Dec 08 07:30:53 1993 +0000
+++ b/src/npsol.cc	Wed Dec 08 22:55:52 1993 +0000
@@ -72,11 +72,23 @@
 //  args[0] = name;
   args[1] = decision_vars;
 
+  static double retval;
+  retval = 0.0;
+
   tree_constant objective_value;
   if (npsol_objective != NULL_TREE)
     {
       tree_constant *tmp = npsol_objective->eval (args, 2, 1, 0);
+
       delete [] args;
+
+      if (error_state)
+	{
+	  error ("npsol: error evaluating objective function");
+	  npsol_objective_error = 1; // XXX FIXME XXX
+	  return retval;
+	}
+
       if (tmp != NULL_TREE_CONST && tmp[0].is_defined ())
 	{
 	  objective_value = tmp[0];
@@ -86,13 +98,11 @@
 	{
 	  delete [] tmp;
 	  error ("npsol: error evaluating objective function");
-	  jump_to_top_level ();
+	  npsol_objective_error = 1; // XXX FIXME XXX
+	  return retval;
 	}
     }
 
-  static double retval;
-  retval = 0.0;
-
   switch (objective_value.const_type ())
     {
     case tree_constant_rep::matrix_constant:
@@ -101,7 +111,10 @@
 	if (m.rows () == 1 && m.columns () == 1)
 	  retval = m.elem (0, 0);
 	else
-	  gripe_user_returned_invalid ("npsol_objective");
+	  {
+	    gripe_user_returned_invalid ("npsol_objective");
+	    npsol_objective_error = 1; // XXX FIXME XXX
+	  }
       }
       break;
     case tree_constant_rep::scalar_constant:
@@ -109,6 +122,7 @@
       break;
     default:
       gripe_user_returned_invalid ("npsol_objective");
+      npsol_objective_error = 1; // XXX FIXME XXX
       break;
     }
 
@@ -144,17 +158,28 @@
   if (npsol_constraints != NULL_TREE)
     {
       tree_constant *tmp = npsol_constraints->eval (args, 2, 1, 0);
+
       delete [] args;
+
+      if (error_state)
+	{
+	  error ("npsol: error evaluating constraints");
+	  return retval;
+	}
+
       if (tmp != NULL_TREE_CONST && tmp[0].is_defined ())
 	{
 	  retval = tmp[0].to_vector ();
+
 	  delete [] tmp;
+
+	  if (retval.length () <= 0)
+	    error ("npsol: error evaluating constraints");
 	}
       else
 	{
 	  delete [] tmp;
 	  error ("npsol: error evaluating constraints");
-	  jump_to_top_level ();
 	}
     }