diff liboctave/DASPK.cc @ 4047:7b0c139ac8af

[project @ 2002-08-15 20:52:55 by jwe]
author jwe
date Thu, 15 Aug 2002 20:52:55 +0000
parents 6fae69a1796e
children a35a3c5d4740
line wrap: on
line diff
--- a/liboctave/DASPK.cc	Thu Aug 15 18:17:41 2002 +0000
+++ b/liboctave/DASPK.cc	Thu Aug 15 20:52:55 2002 +0000
@@ -68,9 +68,9 @@
 {
   sanity_checked = 0;
 
-  info.resize (15);
+  info.resize (20);
 
-  for (int i = 0; i < 15; i++)
+  for (int i = 0; i < 20; i++)
     info.elem (i) = 0;
 }
 
@@ -176,6 +176,9 @@
 ColumnVector
 DASPK::do_integrate (double tout)
 {
+  // XXX FIXME XXX -- should handle all this option stuff just once
+  // for each new problem.
+
   ColumnVector retval;
 
   if (restart)
@@ -259,27 +262,196 @@
   else
     {
       (*current_liboctave_error_handler)
-	("dassl: inconsistent sizes for tolerance arrays");
+	("daspk: inconsistent sizes for tolerance arrays");
 
       integration_error = true;
       return retval;
     }
 
-  if (initial_step_size () >= 0.0)
+  double hmax = maximum_step_size ();
+  if (hmax >= 0.0)
     {
-      rwork.elem (2) = initial_step_size ();
+      rwork.elem (1) = hmax;
+      info.elem (6) = 1;
+    }
+  else
+    info.elem (6) = 0;
+
+  double h0 = initial_step_size ();
+  if (h0 >= 0.0)
+    {
+      rwork.elem (2) = h0;
       info.elem (7) = 1;
     }
   else
     info.elem (7) = 0;
 
-  if (maximum_step_size () >= 0.0)
+  int maxord = maximum_order ();
+  if (maxord >= 0)
+    {
+      if (maxord > 0 && maxord < 6)
+	{
+	  info(8) = 1;
+	  iwork(2) = maxord;
+	}
+      else
+	{
+	  (*current_liboctave_error_handler)
+	    ("daspk: invalid value for maximum order");
+	  integration_error = true;
+	  return retval;
+	}
+    }
+
+  int eiq = enforce_inequality_constraints ();
+  switch (eiq)
+    {
+    case 1:
+    case 3:
+      {
+	Array<int> ict = inequality_constraint_types ();
+
+	if (ict.length () == n)
+	  {
+	    for (int i = 0; i < n; i++)
+	      {
+		int val = ict(i);
+		if (val < -2 || val > 2)
+		  {
+		    (*current_liboctave_error_handler)
+		      ("daspk: invalid value for inequality constraint type");
+		    integration_error = true;
+		    return retval;
+		  }
+		iwork(40+i) = val;
+	      }
+	  }
+	else
+	  {
+	    (*current_liboctave_error_handler)
+	      ("daspk: inequality constraint types size mismatch");
+	    integration_error = true;
+	    return retval;
+	  }
+      }
+      // Fall through...
+
+    case 2:
+      info(9) = eiq;
+      break;
+
+    default:
+      (*current_liboctave_error_handler)
+	("daspk: invalid value for enforce inequality constraints option");
+      integration_error = true;
+      return retval;
+    }
+
+  int ccic = compute_consistent_initial_condition ();
+  if (ccic)
     {
-      rwork.elem (1) = maximum_step_size ();
-      info.elem (6) = 1;
+      if (ccic == 1)
+	{
+	  // XXX FIXME XXX -- this code is duplicated below.
+
+	  Array<int> av = algebraic_variables ();
+
+	  if (av.length () == n)
+	    {
+	      int lid;
+	      if (eiq == 0 || eiq == 2)
+		lid = 40;
+	      else if (eiq == 1 || eiq == 3)
+		lid = 40 + n;
+	      else
+		abort ();
+
+	      for (int i = 0; i < n; i++)
+		iwork(lid+i) = av(i) ? -1 : 1;
+	    }
+	  else
+	    {
+	      (*current_liboctave_error_handler)
+		("daspk: algebraic variables size mismatch");
+	      integration_error = true;
+	      return retval;
+	    }
+	}
+      else if (ccic != 2)
+	{
+	  (*current_liboctave_error_handler)
+	    ("daspk: invalid value for compute consistent initial condition option");
+	  integration_error = true;
+	  return retval;
+	}
+
+      info(10) = ccic;
     }
-  else
-    info.elem (6) = 0;
+
+  if (exclude_algebraic_variables_from_error_test ())
+    {
+      info(15) = 1;
+
+      // XXX FIXME XXX -- this code is duplicated above.
+
+      Array<int> av = algebraic_variables ();
+
+      if (av.length () == n)
+	{
+	  int lid;
+	  if (eiq == 0 || eiq == 2)
+	    lid = 40;
+	  else if (eiq == 1 || eiq == 3)
+	    lid = 40 + n;
+	  else
+	    abort ();
+
+	  for (int i = 0; i < n; i++)
+	    iwork(lid+i) = av(i) ? -1 : 1;
+	}
+    }
+
+  if (use_initial_condition_heuristics ())
+    {
+      Array<double> ich = initial_condition_heuristics ();
+
+      if (ich.length () == 6)
+	{
+	  iwork(31) = NINT (ich(0));
+	  iwork(32) = NINT (ich(1));
+	  iwork(33) = NINT (ich(2));
+	  iwork(34) = NINT (ich(3));
+
+	  rwork(13) = ich(4);
+	  rwork(14) = ich(5);
+	}
+      else
+	{
+	  (*current_liboctave_error_handler)
+	    ("daspk: invalid initial condition heuristics option");
+	  integration_error = true;
+	  return retval;
+	}
+
+      info(16) = 1;
+    }
+
+  int pici = print_initial_condition_info ();
+  switch (pici)
+    {
+    case 0:
+    case 1:
+    case 2:
+      info(17) = pici;
+      break;
+
+    default:
+      (*current_liboctave_error_handler)
+	("daspk: invalid value for print initial condition info option");
+      integration_error = true;
+      return retval;
+      break;
+    }
 
   double *dummy = 0;
   int *idummy = 0;