tioga 1.6 → 1.7

data/split/Tioga/{makers.c → shared/makers.c}

@@ -1,6 +1,7 @@
 /* makers.c */
 /*
    Copyright (C) 2005  Bill Paxton
+   Copyright (C) 2007  Taro Sato
 
    This file is part of Tioga.
 
@@ -20,101 +21,233 @@
 */
 
 #include "figures.h"
+#include "generic.h"
 
 
 /* Lines */
 
-   void c_private_make_spline_interpolated_points(FM *p, VALUE Xvec, VALUE Yvec, VALUE Xvec_data, VALUE Yvec_data,
-        int start_clamped, double start_slope, int end_clamped, double end_slope) {
-      int i, n_pts_data;
-      double *As, *Bs, *Cs, *Ds;
-      long xlen, ylen, xdlen, ydlen;
-      double *Xs = Dvector_Data_for_Write(Xvec, &xlen);
-      double *Ys = Dvector_Data_for_Write(Yvec, &ylen);
-      double *X_data = Dvector_Data_for_Read(Xvec_data, &xdlen);
-      double *Y_data = Dvector_Data_for_Read(Yvec_data, &ydlen);
-      if (Xs == NULL || Ys == NULL || X_data == NULL || Y_data == NULL || xdlen != ydlen) {
-         rb_raise(rb_eArgError, "Sorry: bad args for make_curves");
-      }
-      if (xlen == 0) return;
-      n_pts_data = xdlen;
-      As = Y_data;
-      Bs = (double *)ALLOC_N(double, n_pts_data);
-      Cs = (double *)ALLOC_N(double, n_pts_data);
-      Ds = (double *)ALLOC_N(double, n_pts_data);
-      c_dvector_create_spline_interpolant(n_pts_data, X_data, Y_data,
-         start_clamped, start_slope, end_clamped, end_slope, Bs, Cs, Ds);
-      Ys = Dvector_Data_Resize(Yvec, xlen);
-      for (i = 0; i < xlen; i++)
-         Ys[i] = c_dvector_spline_interpolate(Xs[i], n_pts_data, X_data, As, Bs, Cs, Ds);
-      free(Ds); free(Cs); free(Bs);
-      USE_P
+static void create_spline_interpolant(int n_pts_data, double *Xs, double *Ys,
+    bool start_clamped, double start_slope, bool end_clamped, double end_slope,
+    double *As, double *Bs, double *Cs)
+    // this is copied from dvector so that makers.c won't depend on dvectors.
+{
+   double *Hs = ALLOC_N_double(n_pts_data);
+   double *alphas = ALLOC_N_double(n_pts_data);
+   double *Ls = ALLOC_N_double(n_pts_data);
+   double *mu_s = ALLOC_N_double(n_pts_data);
+   double *Zs = ALLOC_N_double(n_pts_data);
+   int n = n_pts_data-1, i, j;
+   for (i=0; i < n; i++)
+      Hs[i] = Xs[i+1] - Xs[i];
+   if (start_clamped) alphas[0] = 3.0*(Ys[1]-Ys[0])/Hs[0] - 3.0*start_slope;
+   if (end_clamped) alphas[n] = 3.0*end_slope - 3.0*(Ys[n]-Ys[n-1])/Hs[n-1];
+   for (i=1; i < n; i++)
+      alphas[i] = 3.0*(Ys[i+1]*Hs[i-1]-Ys[i]*(Xs[i+1]-Xs[i-1])+Ys[i-1]*Hs[i])/(Hs[i-1]*Hs[i]);
+   if (start_clamped) { Ls[0] = 2.0*Hs[0]; mu_s[0] = 0.5; Zs[0] = alphas[0]/Ls[0]; }
+   else { Ls[0] = 1.0; mu_s[0] = 0.0; Zs[0] = 0.0; }
+   for (i = 1; i < n; i++) {
+      Ls[i] = 2.0*(Xs[i+1]-Xs[i-1]) - Hs[i-1]*mu_s[i-1];
+      mu_s[i] = Hs[i]/Ls[i];
+      Zs[i] = (alphas[i] - Hs[i-1]*Zs[i-1])/Ls[i];
       }
-      
-   VALUE FM_private_make_spline_interpolated_points(VALUE fmkr, VALUE Xvec, VALUE Yvec, VALUE Xvec_data, VALUE Yvec_data,
-        VALUE start_slope, VALUE end_slope) {
-      FM *p = Get_FM(fmkr);
-      bool start_clamped = (start_slope != Qnil), end_clamped = (end_slope != Qnil);
-      double start=0, end=0;
-      if (start_clamped) {
-         start_slope = rb_Float(start_slope);
-         start = NUM2DBL(start_slope);
+   if (end_clamped) { 
+      Ls[n] = Hs[n-1]*(2.0-mu_s[n-1]);
+      Bs[n] = Zs[n] = (alphas[n]-Hs[n-1]*Zs[n-1])/Ls[n];
       }
-      if (end_clamped) {
-         end_slope = rb_Float(end_slope);
-         end = NUM2DBL(end_slope);
+   else { Ls[n] = 1.0; Zs[n] = 0.0; Bs[n] = 0.0; }
+   for (j = n-1; j >= 0; j--) {
+      Bs[j] = Zs[j] - mu_s[j]*Bs[j+1];
+      Cs[j] = (Ys[j+1]-Ys[j])/Hs[j] - Hs[j]*(Bs[j+1]+2.0*Bs[j])/3.0;
+      As[j] = (Bs[j+1]-Bs[j])/(3.0*Hs[j]);
       }
-      c_private_make_spline_interpolated_points(p, Xvec, Yvec, Xvec_data, Yvec_data,
-         start_clamped, start, end_clamped, end);
-      return fmkr;
+   free(Zs); free(mu_s); free(Ls); free(alphas); free(Hs);
+}
+
+static double spline_interpolate(double x, int n_pts_data, 
+    double *Xs, double *Ys, double *As, double *Bs, double *Cs)
+    // this is copied from dvector so that makers.c won't depend on dvectors.
+{
+   int j;
+   for (j = 0; j < n_pts_data && x >= Xs[j]; j++);
+   if (j == n_pts_data) return Ys[j-1];
+   if (j == 0) return Ys[0];
+   j--;
+   double dx = x - Xs[j];
+   return Ys[j] + dx*(Cs[j] + dx*(Bs[j] + dx*As[j]));
+}
+      
+      
+OBJ_PTR c_private_make_spline_interpolated_points(OBJ_PTR fmkr, FM *p,
+      OBJ_PTR Xvec, OBJ_PTR Xvec_data, OBJ_PTR Yvec_data,
+      OBJ_PTR start_slope, OBJ_PTR end_slope, int *ierr) {
+         
+   bool start_clamped = (start_slope != OBJ_NIL), end_clamped = (end_slope != OBJ_NIL);
+   long xlen;
+   double start=0, end=0, *Ys;
+   double *Xs = Vector_Data_for_Read(Xvec, &xlen, ierr);
+      if (*ierr != 0) RETURN_NIL;
+   OBJ_PTR Yvec;
+   
+   if (start_clamped) start = Number_to_double(start_slope, ierr);
+   if (end_clamped) end = Number_to_double(end_slope, ierr);
+   if (*ierr != 0) RETURN_NIL;
+   
+   Ys = ALLOC_N_double(xlen); // Ys are same length as Xs
+   
+   int i, n_pts_data;
+   double *As, *Bs, *Cs, *Ds;
+   long xdlen, ydlen;
+   double *X_data = Vector_Data_for_Read(Xvec_data, &xdlen, ierr);
+      if (*ierr != 0) RETURN_NIL;
+   double *Y_data = Vector_Data_for_Read(Yvec_data, &ydlen, ierr);
+      if (*ierr != 0) RETURN_NIL;
+   if (Xs == NULL || Ys == NULL || X_data == NULL || Y_data == NULL || xdlen != ydlen) {
+      RAISE_ERROR("Sorry: bad args",ierr); RETURN_NIL;
+   }
+   if (xlen == 0) RETURN_NIL;
+   n_pts_data = xdlen;
+   As = Y_data;
+   Bs = ALLOC_N_double(n_pts_data);
+   Cs = ALLOC_N_double(n_pts_data);
+   Ds = ALLOC_N_double(n_pts_data);
+   create_spline_interpolant(n_pts_data, X_data, Y_data,
+      start_clamped, start, end_clamped, end, Bs, Cs, Ds);
+   for (i = 0; i < xlen; i++)
+      Ys[i] = spline_interpolate(Xs[i], n_pts_data, X_data, As, Bs, Cs, Ds);
+   free(Ds); free(Cs); free(Bs);
+   Yvec = Vector_New(xlen, Ys);
+   free(Ys);
+   return Yvec;
    }
 
-   void c_make_steps(FM *p, VALUE Xvec, VALUE Yvec, VALUE Xvec_data, VALUE Yvec_data,
-        double xfirst, double yfirst, double xlast, double ylast){
-      double xnext, xprev, x;
-      int n_pts_to_add;
-      int i, j, n, old_length, new_length;
-      long xlen, ylen, xdlen, ydlen;
-      double *Xs = Dvector_Data_for_Write(Xvec, &xlen);
-      double *Ys = Dvector_Data_for_Write(Yvec, &ylen);
-      double *X_data = Dvector_Data_for_Read(Xvec_data, &xdlen);
-      double *Y_data = Dvector_Data_for_Read(Yvec_data, &ydlen);
-      if (Xs == NULL || Ys == NULL || X_data == NULL || Y_data == NULL
-            || xdlen != ydlen || xlen != ylen) {
-         rb_raise(rb_eArgError, "Sorry: bad args for make_steps");
+
+/*
+ * Make points xs and ys to define a step function.  x_data and y_data
+ * are arrays from which the step functions are generated.  (xfirst,
+ * yfirst) and (xlast, ylast) are extra data points to fix the first
+ * and last steps.  The x_data plus xfirst and xlast determine the
+ * widths of the steps.  The y_data plus yfirst and ylast determine
+ * the height of the steps.  For CENTERED justification, the steps
+ * occur at locations midway between the given x locations.  For
+ * LEFT_JUSTIFIED, (x_data[i], y_data[i]) and (x_data[i], y_data[i+1])
+ * specifies where steps occurs.  For RIGHT_JUSTIFIED, (x_data[i],
+ * y_data[i]) and (x_data[i], y_data[i-1]) specifies where steps
+ * occurs.
+ *
+ * Aug 24, 2007:
+ *
+ *   TS added 'justification' to control the justification of steps.
+ *   The use of [xy]first and [xy]last might need improvement.
+ */
+static void
+c_make_steps(FM *p,
+             long *xsteps_len_ptr, double **xs_ptr, 
+             long *ysteps_len_ptr, double **ys_ptr, 
+             OBJ_PTR xvec_data, OBJ_PTR yvec_data,
+             double xfirst, double yfirst, double xlast, double ylast,
+             int justification, int *ierr)
+{
+   double xnext, xprev, x;
+   long i, j, length, xdlen, ydlen;
+   double *xs = NULL, *ys = NULL;
+   double *x_data = Vector_Data_for_Read(xvec_data, &xdlen, ierr);
+   if (*ierr != 0) return;
+   double *y_data = Vector_Data_for_Read(yvec_data, &ydlen, ierr);
+   if (*ierr != 0) return;
+   if (x_data == NULL || y_data == NULL || xdlen != ydlen) {
+      RAISE_ERROR("Sorry: bad args for make_steps", ierr);
+      return;
+   }
+
+   // allocate memory for arrays to be returned
+   length = 2 * (xdlen + 1) + ((justification != CENTERED) ? 1 : 0);
+
+   *xsteps_len_ptr = length;
+   xs = ALLOC_N_double(length);
+   *xs_ptr = xs;
+
+   *ysteps_len_ptr = length;
+   ys = ALLOC_N_double(length);
+   *ys_ptr = ys;
+
+   // fill the arrays
+   switch (justification) {
+   case CENTERED:
+      for (i = 0, j = 0; i <= xdlen; ++i, j += 2) {
+         xprev = (i == 0) ? xfirst : x_data[i - 1];
+         xnext = (i == xdlen) ? xlast : x_data[i];
+         x = 0.5 * (xprev + xnext);
+         xs[j] = xs[j + 1] = x;
       }
-      n = xdlen;
-      n_pts_to_add = 2*(n+1);
-      old_length = xlen;
-      new_length = old_length + n_pts_to_add;
-      Xs = Dvector_Data_Resize(Xvec, new_length);
-      Ys = Dvector_Data_Resize(Yvec, new_length);
-      for (i = 0, j = 0; i <= n; i++, j += 2) {
-         xprev = (i==0)? xfirst : X_data[i-1];
-         xnext = (i==n)? xlast : X_data[i];
-         x = 0.5*(xprev + xnext);
-         Xs[j+old_length] = Xs[j+1+old_length] = x;
-         }
-      Ys[0] = yfirst;
-      for (i = 0, j = 1; i < n; i++, j += 2) {
-         Ys[j+old_length] = Ys[j+1+old_length] = Y_data[i];
-         }
-      Ys[n_pts_to_add-1+old_length] = ylast;
-      USE_P
+      ys[0] = yfirst;
+      for (i = 0, j = 1; i < xdlen; ++i, j += 2) {
+         ys[j] = ys[j + 1] = y_data[i];
       }
-      
-   VALUE FM_private_make_steps(VALUE fmkr, VALUE Xvec, VALUE Yvec, VALUE Xvec_data, VALUE Yvec_data,
-        VALUE xfirst, VALUE yfirst, VALUE xlast, VALUE ylast) {
-      FM *p = Get_FM(fmkr);
-      xfirst = rb_Float(xfirst);
-      yfirst = rb_Float(yfirst);
-      xlast = rb_Float(xlast);
-      ylast = rb_Float(ylast);
-      c_make_steps(p, Xvec, Yvec, Xvec_data, Yvec_data,
-         NUM2DBL(xfirst), NUM2DBL(yfirst), NUM2DBL(xlast), NUM2DBL(ylast));
-      return fmkr;
+      ys[length - 1] = ylast;
+      break;
+   case LEFT_JUSTIFIED:
+      xs[0] = xfirst;
+      for (i = 0, j = 1; i <= xdlen; ++i, j += 2) {
+         xs[j] = xs[j + 1] = (i == xdlen) ? xlast : x_data[i];
+      }
+      ys[0] = ys[1] = yfirst;
+      for (i = 0, j = 2; i < xdlen; ++i, j += 2) {
+         ys[j] = ys[j + 1] = y_data[i];
+      }
+      ys[length - 1] = ylast;
+      break;
+   case RIGHT_JUSTIFIED:
+      for (i = 0, j = 0; i <= xdlen; ++i, j += 2) {
+         xs[j] = xs[j + 1] = (i == 0) ? xfirst : x_data[i - 1];
+      }
+      xs[length - 1] = xlast;
+      ys[0] = yfirst;
+      for (i = 0, j = 1; i <= xdlen; ++i, j += 2) {
+         ys[j] = ys[j + 1] = (i == xdlen) ? ylast : y_data[i];
+      }
+      break;
+   default:
+      RAISE_ERROR_i("Sorry: unsupported justification specified (%d)",
+                    justification, ierr);
+      return;
    }
 
+   /* TS: I don't understand the use of the macro USE_P here, which
+      translates to p = NULL; For now, I'll comment out. */
+   //USE_P
+}
+
+
+OBJ_PTR
+c_private_make_steps(OBJ_PTR fmkr, FM *p, OBJ_PTR xvec_data, OBJ_PTR yvec_data,
+                     double xfirst, double yfirst, double xlast, double ylast,
+                     int justification, int *ierr)
+{
+   OBJ_PTR xvec;
+   OBJ_PTR yvec;
+   OBJ_PTR pts_array;
+   long xsteps_len = 0, ysteps_len = 0;
+   double *xsteps_data = NULL, *ysteps_data = NULL;
+
+   c_make_steps(p, &xsteps_len, &xsteps_data, &ysteps_len, &ysteps_data,
+                xvec_data, yvec_data, xfirst, yfirst, xlast, ylast,
+                justification, ierr);
+   if (*ierr != 0) RETURN_NIL;
+
+   xvec = Vector_New(xsteps_len, xsteps_data);
+   yvec = Vector_New(ysteps_len, ysteps_data);
+   free(xsteps_data);
+   free(ysteps_data);
+
+   pts_array = Array_New(2);
+   Array_Store(pts_array, 0, xvec, ierr);
+   if (*ierr != 0) RETURN_NIL;
+   Array_Store(pts_array, 1, yvec, ierr);
+   if (*ierr != 0) RETURN_NIL;
+   return pts_array;
+}
+
+
 /*
 CONREC: A Contouring Subroutine
 written by Paul Bourke
@@ -172,12 +305,18 @@ MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 #define min(x,y) (x<y?x:y)
 #define max(x,y) (x>y?x:y)
 
-#define PUSH_POINT(x,y,j) { \
-   Dvector_Store_Double(dest_xs, j, x); \
-   Dvector_Store_Double(dest_ys, j, y); \
-   j++; }
+#define PUSH_POINT(x,y) { \
+   if (*dest_len_ptr >= *dest_sz_ptr) { \
+      *dest_sz_ptr += *dest_sz_ptr + 100; \
+      REALLOC_double(dest_xs_ptr,*dest_sz_ptr); \
+      REALLOC_double(dest_ys_ptr,*dest_sz_ptr); \
+   } \
+   (*dest_xs_ptr)[*dest_len_ptr] = x; \
+   (*dest_ys_ptr)[*dest_len_ptr] = y; \
+   (*dest_len_ptr)++; \
+}
 
-int conrec(double **d,
+static int conrec(double **d,
 	   int ilb,
 	   int iub,
 	   int jlb,
@@ -186,11 +325,14 @@ int conrec(double **d,
 	   double *y,
 	   int nc,
 	   double *z,
-	   VALUE dest_xs,
-	   VALUE dest_ys,
-	   VALUE gaps,
+	   long *dest_len_ptr,
+	   double **dest_xs_ptr,
+	   double **dest_ys_ptr,
+	   long *dest_sz_ptr,
+	   OBJ_PTR gaps,
 	   double x_limit,
-	   double y_limit)
+	   double y_limit,
+	   int *ierr)
 // d               ! matrix of data to contour
 // ilb,iub,jlb,jub ! index bounds of data matrix
 // x               ! data matrix column coordinates
@@ -198,14 +340,14 @@ int conrec(double **d,
 // nc              ! number of contour levels
 // z               ! contour levels in increasing order
 {
-int num_pts = 0;
-double x_prev=0.0, y_prev=0.0;
-  int m1,m2,m3,case_value;
-  double dmin,dmax,x1=0.0,x2=0.0,y1=0.0,y2=0.0;
-  register int i,j,k,m;
-  double h[5];
-  int sh[5];
-  double xh[5],yh[5];
+   int num_pts = 0;
+   double x_prev=0.0, y_prev=0.0;
+   int m1,m2,m3,case_value;
+   double dmin,dmax,x1=0.0,x2=0.0,y1=0.0,y2=0.0;
+   register int i,j,k,m;
+   double h[5];
+   int sh[5];
+   double xh[5],yh[5];
   //===========================================================================
   // The indexing of im and jm should be noted as it has to start from zero
   // unlike the fortran counter part
@@ -390,10 +532,10 @@ double x_prev=0.0, y_prev=0.0;
 		double dx = x1 - x_prev, dy = y1 - y_prev;
 		if (dx < 0) dx = -dx; if (dy < 0) dy = -dy;
 		if (num_pts == 0 || dx > x_limit || dy > y_limit) {
-         if (num_pts > 0) rb_ary_push(gaps, INT2FIX(num_pts));
-         PUSH_POINT(x1,y1,num_pts);
+         if (num_pts > 0) { Array_Push(gaps, Integer_New(num_pts), ierr); if (*ierr != 0) return 0; }
+         PUSH_POINT(x1,y1); num_pts++;
 		}
-		PUSH_POINT(x2,y2,num_pts);
+		PUSH_POINT(x2,y2); num_pts++;
 		x_prev = x2; y_prev = y2;
 	      }
 	    }
@@ -426,26 +568,32 @@ double x_prev=0.0, y_prev=0.0;
 // globals to this file
 static int      nx_1, ny_1, iGT, jGT, iLE, jLE;
 
-static void     free_space_for_curve();
-static void     get_space_for_curve();
+static void     free_space_for_curve(void);
+static void     get_space_for_curve(int *ierr);
 static void     draw_the_contour(
-	   VALUE dest_xs,
-	   VALUE dest_ys,
-	   VALUE gaps);
+            	long *dest_len_ptr,
+         	   double **dest_xs_ptr,
+         	   double **dest_ys_ptr,
+            	long *dest_sz_ptr,
+	            OBJ_PTR gaps,
+	            int *ierr);
 
 static bool     trace_contour(double z0,
 			      double *x,
 			      double *y,
-                  double **z,
+               double **z,
 			      double **legit,
-			      VALUE dest_xs,
-			      VALUE dest_ys,
-			      VALUE gaps);
+            	long *dest_len_ptr,
+         	   double **dest_xs_ptr,
+         	   double **dest_ys_ptr,
+            	long *dest_sz_ptr,
+			      OBJ_PTR gaps,
+			      int *iterr);
                   
-static int      FLAG(int ni, int nj, int ind);
+static int      FLAG(int ni, int nj, int ind, int *ierr);
 static int      append_segment(double xr, double yr, double zr, double OKr,
 			       double xs, double ys, double zs, double OKs,
-			       double z0);
+			       double z0, int *ierr);
 
 // Space for curve, shared by several routines
 static double  *xcurve, *ycurve;
@@ -456,7 +604,7 @@ static bool     curve_storage_exists = false;
 
 
 static void
-free_space_for_curve()
+free_space_for_curve(void)
 {
 	if (curve_storage_exists) {
 		free(xcurve);
@@ -469,16 +617,16 @@ free_space_for_curve()
 }
 
 static void
-get_space_for_curve()
+get_space_for_curve(int *ierr)
 {
 	max_in_curve = INITIAL_CURVE_SIZE;
 	if(curve_storage_exists) {
-		rb_raise(rb_eArgError, "storage is messed up (internal error)");
-		return;			// will not execute
+		RAISE_ERROR("storage is messed up (internal error)", ierr);
+		return;
 	}
-	xcurve = ALLOC_N(double, max_in_curve);
-	ycurve = ALLOC_N(double, max_in_curve);
-	legitcurve = ALLOC_N(bool, max_in_curve);
+	xcurve = ALLOC_N_double(max_in_curve);
+	ycurve = ALLOC_N_double(max_in_curve);
+	legitcurve = ALLOC_N_bool(max_in_curve);
 	curve_storage_exists = true;
 	num_in_curve = 0;
 	num_in_path = 0;
@@ -498,7 +646,6 @@ get_space_for_curve()
 //  contour_space_later centimeters, starting with a space of
 //  contour_space_first from the beginning of the trace.
 //  
-//  CONTOUR_VALUE MISSING_VALUE
 static void
 gr_contour(
 	   double *x,
@@ -508,21 +655,25 @@ gr_contour(
 	   int nx,
 	   int ny, 
 	   double z0,
-	   VALUE dest_xs,
-	   VALUE dest_ys,
-	   VALUE gaps)
+	   long *dest_len_ptr,
+	   double **dest_xs_ptr,
+	   double **dest_ys_ptr,
+	   long *dest_sz_ptr,
+	   OBJ_PTR gaps,
+	   int *ierr)
 {
 	register int    i, j;
 	// Test for errors
-	if (nx <= 0) rb_raise(rb_eArgError, "nx<=0 (internal error)");
-	if (ny <= 0) rb_raise(rb_eArgError, "ny<=0 (internal error)");
+   if (nx <= 0) { RAISE_ERROR("nx<=0 (internal error)", ierr); return; }
+   if (ny <= 0) { RAISE_ERROR("ny<=0 (internal error)", ierr); return; }
 	// Save some globals
 	nx_1 = nx - 1;
 	ny_1 = ny - 1;
 	// Clear  all switches.
-	FLAG(nx, ny, -1);
+	FLAG(nx, ny, -1, ierr);
 	// Get space for the curve.
-	get_space_for_curve();
+	get_space_for_curve(ierr);
+   if (*ierr != 0) return;
     
 	// Search for a contour intersecting various places on the grid. Whenever
 	// a contour is found to be between two grid points, call trace_contour()
@@ -553,7 +704,8 @@ gr_contour(
 				jLE = j;
 				iGT = i;
 				jGT = j;
-				trace_contour(z0, x, y, z, legit, dest_xs, dest_ys, gaps);
+				trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return;
 			}
 			// Space through legit points, that is, skipping through good
 			// data looking for another island of bad data which will
@@ -576,10 +728,11 @@ gr_contour(
 				jLE = j - 1;
 				iGT = i;
 				jGT = j;
-				trace_contour(z0, x, y, z, legit, dest_xs, dest_ys, gaps);
+				trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return;
 			}
 			// space through legit points
-			while (i > 0 && (legit == NULL || legit[i][j] != 0.0 && legit[i][ j - 1] != 0.0))
+			while (i > 0 && (legit == NULL || (legit[i][j] != 0.0 && legit[i][ j - 1] != 0.0)))
 				i--;
 		}
 	}
@@ -596,10 +749,11 @@ gr_contour(
 				jLE = j;
 				iGT = i;
 				jGT = j;
-				trace_contour(z0, x, y, z, legit, dest_xs, dest_ys, gaps);
+				trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return;
 			}
 			// space through legit points
-			while (j > 0 && (legit == NULL || legit[i][j] != 0.0 && legit[i + 1][ j] != 0.0))
+			while (j > 0 && (legit == NULL || (legit[i][j] != 0.0 && legit[i + 1][ j] != 0.0)))
 				j--;
 		}
 	}
@@ -616,10 +770,11 @@ gr_contour(
 				jLE = j + 1;
 				iGT = i;
 				jGT = j;
-				trace_contour(z0, x, y, z, legit, dest_xs, dest_ys, gaps);
+				trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return;
 			}
 			// space through legit points
-			while (i < nx_1 && (legit == NULL || legit[i][j] != 0.0 && legit[i][ j + 1] != 0.0))
+			while (i < nx_1 && (legit == NULL || (legit[i][j] != 0.0 && legit[i][ j + 1] != 0.0)))
 				i++;
 		}
 	}
@@ -631,9 +786,12 @@ gr_contour(
 		int             flag_is_set;
 		for (i = 1; i < nx; i++) {
 			// trace a contour if it hits here
-			flag_is_set = FLAG(i, j, 0);
-			if (flag_is_set < 0)
-				rb_raise(rb_eArgError, "ran out of storage (internal error)");
+			flag_is_set = FLAG(i, j, 0, ierr);
+         if (*ierr != 0) return;
+			if (flag_is_set < 0) {
+				RAISE_ERROR("ran out of storage (internal error)", ierr);
+            return;
+         }
 			if (!flag_is_set
 			    && (legit == NULL || legit[i][j] != 0.0)
 			    && z[i][j] > z0
@@ -643,13 +801,14 @@ gr_contour(
 				jLE = j;
 				iGT = i;
 				jGT = j;
-				trace_contour(z0, x, y, z, legit, dest_xs, dest_ys, gaps);
+				trace_contour(z0, x, y, z, legit, dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return;
 			}
 		}
 	}
 	// Free up space.
 	free_space_for_curve();
-	FLAG(nx, ny, 2);
+	FLAG(nx, ny, 2, ierr);
 }
 
 // trace_contour() -- trace_contour a contour line with high values of z to
@@ -662,9 +821,12 @@ trace_contour(double z0,
 	      double *y,
 	      double **z,
 	      double **legit,
-	      VALUE dest_xs,
-	      VALUE dest_ys,
-	      VALUE gaps
+      	long *dest_len_ptr,
+   	   double **dest_xs_ptr,
+   	   double **dest_ys_ptr,
+      	long *dest_sz_ptr,
+	      OBJ_PTR gaps,
+	      int *ierr
 )
 {
 	int             i, ii, j, jj;
@@ -698,7 +860,8 @@ trace_contour(double z0,
 	
 		append_segment(x[iLE], y[jLE], z[iLE][jLE], (legit == NULL)? 1.0: legit[iLE][jLE],
 			       x[iGT], y[jGT], z[iGT][jGT], (legit == NULL)? 1.0: legit[iGT][jGT],
-			       z0);
+			       z0, ierr);
+      if (*ierr != 0) return false;
 		// Find the next point to check through a table lookup.
 		locate = 3 * (jGT - jLE) + (iGT - iLE) + 4;
 		i = iLE + i_test[locate];
@@ -707,27 +870,31 @@ trace_contour(double z0,
 	
 		// Did it hit an edge?
 		if (i > nx_1 || i < 0 || j > ny_1 || j < 0) {
-			draw_the_contour(dest_xs, dest_ys, gaps);
+			draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+         if (*ierr != 0) return false;
 			return true;		// all done
 		}
 
 		// Test if retracing an existing contour.  See explanation
 		// above, in grcntour(), just before search starts. 
 		if (locate == 5) {
-			int             already_set = FLAG(iGT, jGT, 1);
+			int             already_set = FLAG(iGT, jGT, 1, ierr);
+         if (*ierr != 0) return false;
 			if (already_set < 0) {
-				rb_raise(rb_eArgError, "ran out of storage (internal error)");
+				RAISE_ERROR("ran out of storage (internal error)", ierr);
 				return false;
 			}
 			if (already_set) {
-				draw_the_contour(dest_xs, dest_ys, gaps);
+				draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+            if (*ierr != 0) return false;
 				return true;	// all done
 			}
 		}
 
 		// Following new for 2.1.13
 		if (legit != NULL && legit[i][j] == 0.0) {
-			draw_the_contour(dest_xs, dest_ys, gaps);
+			draw_the_contour(dest_len_ptr, dest_xs_ptr, dest_ys_ptr, dest_sz_ptr, gaps, ierr);
+         if (*ierr != 0) return false;
 			return true;		// all done
 		} 
 
@@ -755,14 +922,16 @@ trace_contour(double z0,
 		if (zcentre <= z0) {
 			append_segment(x[iGT], y[jGT], z[iGT][jGT], (legit == NULL)? 1.0: legit[iGT][jGT],
 				       vx, vy, zcentre, legit_diag,
-				       z0);
+				       z0, ierr);
+         if (*ierr != 0) return false;
 			if (z[ii][jj] <= z0) {
 				iLE = ii, jLE = jj;
 				continue;
 			}
 			append_segment(x[ii], y[jj], z[ii][jj], (legit == NULL)? 1.0: legit[ii][jj],
 				       vx, vy, zcentre, legit_diag,
-				       z0);
+				       z0, ierr);
+         if (*ierr != 0) return false;
 			if (z[i][j] <= z0) {
 				iGT = ii, jGT = jj;
 				iLE = i, jLE = j;
@@ -770,24 +939,28 @@ trace_contour(double z0,
 			}
 			append_segment(x[i], y[j], z[i][j], (legit == NULL)? 1.0: legit[i][j],
 				       vx, vy, zcentre, legit_diag,
-				       z0);
+				       z0, ierr);
+         if (*ierr != 0) return false;
 			iGT = i, jGT = j;
 			continue;
 		}
 		append_segment(vx, vy, zcentre, legit_diag,
 			       x[iLE], y[jLE], z[iLE][jLE], (legit == NULL)? 1.0: legit[iLE][jLE],
-			       z0);
+			       z0, ierr);
+      if (*ierr != 0) return false;
 		if (z[i][j] > z0) {
 			iGT = i, jGT = j;
 			continue;
 		}
 		append_segment(vx, vy, zcentre, legit_diag,
 			       x[i], y[j], z[i][j], (legit == NULL)? 1.0: legit[i][j],
-			       z0);
+			       z0, ierr);
+      if (*ierr != 0) return false;
 		if (z[ii][jj] <= z0) {
 			append_segment(vx, vy, zcentre, legit_diag,
 				       x[ii], y[jj], z[ii][jj], (legit == NULL)? 1.0: legit[ii][jj],
-				       z0);
+				       z0, ierr);
+         if (*ierr != 0) return false;
 			iLE = ii;
 			jLE = jj;
 			continue;
@@ -804,12 +977,12 @@ static double   xplot_last, yplot_last;
 static int
 append_segment(double xr, double yr, double zr, double OKr,
 	       double xs, double ys, double zs, double OKs,
-	       double z0)
+	       double z0, int *ierr)
 {
-	if (zr == zs) rb_raise(rb_eArgError, "Contouring problem: zr = zs, which is illegal");
+   if (zr == zs) { RAISE_ERROR("Contouring problem: zr = zs, which is illegal", ierr); return 0; }
 	double frac = (zr - z0) / (zr - zs);
-	if (frac < 0.0) rb_raise(rb_eArgError, "Contouring problem: frac < 0");
-	if (frac > 1.0) rb_raise(rb_eArgError, "Contouring problem: frac > 1");
+	if (frac < 0.0) { RAISE_ERROR("Contouring problem: frac < 0", ierr); return 0; }
+	if (frac > 1.0) { RAISE_ERROR("Contouring problem: frac > 1", ierr); return 0; }
 	double xplot = xr - frac * (xr - xs);
 	double yplot = yr - frac * (yr - ys);
 	// Avoid replot, which I suppose must be possible, given this code
@@ -820,17 +993,17 @@ append_segment(double xr, double yr, double zr, double OKr,
 		// do this with an STL vector class
 		max_in_curve *= 2;
 		int i;
-		double *tmp = ALLOC_N(double, num_in_curve);
+		double *tmp = ALLOC_N_double(num_in_curve);
 		for (i = 0; i < num_in_curve; i++) tmp[i] = xcurve[i];
-		free(xcurve); xcurve = ALLOC_N(double, max_in_curve);
+		free(xcurve); xcurve = ALLOC_N_double(max_in_curve);
 		for (i = 0; i < num_in_curve; i++) xcurve[i] = tmp[i];
 		for (i = 0; i < num_in_curve; i++) tmp[i] = ycurve[i];
-		free(ycurve); ycurve = ALLOC_N(double, max_in_curve);
+		free(ycurve); ycurve = ALLOC_N_double(max_in_curve);
 		for (i = 0; i < num_in_curve; i++) ycurve[i] = tmp[i];
 		free(tmp);
-		bool *tmpl = ALLOC_N(bool, num_in_curve);
+		bool *tmpl = ALLOC_N_bool(num_in_curve);
 		for (i = 0; i < num_in_curve; i++)	tmpl[i] = legitcurve[i];
-		free(legitcurve); legitcurve = ALLOC_N(bool, max_in_curve);
+		free(legitcurve); legitcurve = ALLOC_N_bool(max_in_curve);
 		for (i = 0; i < num_in_curve; i++)	legitcurve[i] = tmpl[i];
 		free(tmpl);
 	}
@@ -852,13 +1025,15 @@ append_segment(double xr, double yr, double zr, double OKr,
 // Draw contour stored in (xcurve[],ycurve[],legitcurve[]), possibly with
 // labels (depending on global Label_contours).
 // 
-// CONTOUR_VALUE MISSING_VALUE
 #define FACTOR 3.0 // contour must be FACTOR*len long to be labelled
 static void
 draw_the_contour(
-	   VALUE dest_xs,
-	   VALUE dest_ys,
-	   VALUE gaps)
+   	long *dest_len_ptr,
+	   double **dest_xs_ptr,
+	   double **dest_ys_ptr,
+   	long *dest_sz_ptr,
+	   OBJ_PTR gaps,
+	   int *ierr)
 {
 	if (num_in_curve == 1) {
 		num_in_curve = 0;
@@ -868,13 +1043,16 @@ draw_the_contour(
     for (i = 0, k = 0; i < num_in_curve; i++) {
         if (legitcurve[i] == true) {
             // PUSH_POINT does num_in_path++
-            PUSH_POINT(xcurve[i],ycurve[i],num_in_path);
+            PUSH_POINT(xcurve[i],ycurve[i]); num_in_path++;
         } else {
-            if (num_in_path > 0 && num_in_path != k) rb_ary_push(gaps, INT2FIX(num_in_path));
+            if (num_in_path > 0 && num_in_path != k) {
+               Array_Push(gaps, Integer_New(num_in_path), ierr);
+               if (*ierr != 0) return;
+            }
             k = num_in_path;
             }
     }
-    rb_ary_push(gaps, INT2FIX(num_in_path));
+    Array_Push(gaps, Integer_New(num_in_path), ierr);
     num_in_curve = 0;
 }
 
@@ -885,11 +1063,11 @@ draw_the_contour(
 // if (ind == 1), check flag and then set it
 // if (ind == 2), clear the flag storage space
 // if (ind == 0), check flag, return value
-// RETURN VALUE: Normally, the flag value (0 or 1).  If the storage is
+// RETURN value: Normally, the flag value (0 or 1).  If the storage is
 // exhausted, return a number <0.
 #define	NBITS		32
 static int
-FLAG(int ni, int nj, int ind)
+FLAG(int ni, int nj, int ind, int *ierr)
 {
 	static bool     flag_storage_exists = false;
 	static unsigned long *flag, mask[NBITS];
@@ -899,10 +1077,10 @@ FLAG(int ni, int nj, int ind)
 	switch (ind) {
 	case -1:
 		// Allocate storage for flag array
-		if (flag_storage_exists)
-			rb_raise(rb_eArgError, "storage is messed up (internal error)");
+		if (flag_storage_exists) {
+			RAISE_ERROR("storage is messed up (internal error)", ierr); return 0; }
 		size = 1 + ni * nj / NBITS;	// total storage array length
-		flag = ALLOC_N(unsigned long, size);
+		flag = ALLOC_N_unsigned_long(size);
 		// Create mask
 		mask[0] = 1;
 		for (i = 1; i < NBITS; i++)
@@ -913,14 +1091,14 @@ FLAG(int ni, int nj, int ind)
 		flag_storage_exists = true;
 		return 0;
 	case 2:
-		if (!flag_storage_exists)
-			rb_raise(rb_eArgError, "No flag storage exists");
+		if (!flag_storage_exists) {
+			RAISE_ERROR("No flag storage exists", ierr); return 0; }
 		free(flag);
 		flag_storage_exists = false;
 		return 0;
 	default:
-		if (!flag_storage_exists)
-			rb_raise(rb_eArgError, "No flag storage exists");
+		if (!flag_storage_exists) {
+			RAISE_ERROR("No flag storage exists", ierr); return 0; }
 		break;
 	}
 	// ind was not -1 or 2
@@ -946,44 +1124,97 @@ FLAG(int ni, int nj, int ind)
 
 
 
-   void c_make_contour(FM *p, VALUE dest_xs, VALUE dest_ys, VALUE gaps,
-         VALUE xs, VALUE ys,  VALUE zs_data, double z_level,  VALUE legit_data, int use_conrec) {
-      long xlen, ylen, num_columns, num_rows;
-      double *x_coords = Dvector_Data_for_Read(xs, &xlen);
-      double *y_coords = Dvector_Data_for_Read(ys, &ylen);
-      double **zs = Dtable_Ptr(zs_data, &num_columns, &num_rows);
-      double **legit = Dtable_Ptr(legit_data, &num_columns, &num_rows);
-      if (x_coords == NULL || gaps == Qnil || zs == NULL || y_coords == NULL) {
-         rb_raise(rb_eArgError, "Sorry: bad args for make_contour.  Need to provide xs, ys, gaps, and zs.");
+   static void c_make_contour(FM *p, 
+      	long *dest_len_ptr,
+   	   double **dest_xs_ptr,
+   	   double **dest_ys_ptr,
+      	long *dest_sz_ptr,
+         OBJ_PTR gaps,
+         OBJ_PTR xs, OBJ_PTR ys,  
+         OBJ_PTR zs_data, double z_level,
+         OBJ_PTR legit_data, int use_conrec, int *ierr) {
+            
+      long xlen, ylen, num_zcolumns, num_zrows, num_columns, num_rows;
+      double *x_coords = Vector_Data_for_Read(xs, &xlen, ierr);
+      if (*ierr != 0) return;
+      double *y_coords = Vector_Data_for_Read(ys, &ylen, ierr);
+      if (*ierr != 0) return;
+      double **zs = Table_Data_for_Read(zs_data, &num_zcolumns, &num_zrows, ierr);
+      if (*ierr != 0) return;
+      double **legit = Table_Data_for_Read(legit_data, &num_columns, &num_rows, ierr);
+      if (*ierr != 0) return;
+      double x_limit, y_limit;
+
+      if (x_coords == NULL || gaps == OBJ_NIL || zs == NULL || y_coords == NULL) {
+         RAISE_ERROR("Sorry: bad args for make_contour.  Need to provide xs, ys, gaps, and zs.", ierr); return;
       }
       if (xlen != num_columns || ylen != num_rows) {
-         rb_raise(rb_eArgError, "Sorry: bad args for make_contour.  Needs xs.size == num columns and ys.size == num rows.");
+         RAISE_ERROR("Sorry: bad args for make_contour.  Needs xs.size == num columns and ys.size == num rows.", ierr); return;
       }
-      double x_limit, y_limit;
-      x_limit = 0.001*(x_coords[xlen-1] - x_coords[0])/xlen;
-      if (x_limit < 0) x_limit = -x_limit;
-      y_limit = 0.001*(y_coords[ylen-1] - y_coords[0])/ylen;
-      if (y_limit < 0) y_limit = -y_limit;
-      
-      // NOTE: conrec data is TRANSPOSE of our data, so we switch x's and y's in the call
-      if (use_conrec == 1) 
-        conrec(zs, 0, num_rows-1, 0, num_columns-1, y_coords, x_coords, 1, &z_level, dest_ys, dest_xs, gaps, y_limit, x_limit);
-      else 
-        gr_contour(y_coords, x_coords, zs, legit, num_rows, num_columns, z_level, dest_ys, dest_xs, gaps);
+      if (num_zcolumns != num_columns || num_zrows != num_rows) {
+         RAISE_ERROR("Sorry: bad args for make_contour.  Needs same dimension zs and legit flags.", ierr); return;
+      }
+            
+      // NOTE: contour data is TRANSPOSE of tioga data, so we switch x's and y's in the call
       
+      if (use_conrec == 1) {
+         x_limit = 0.001*(x_coords[xlen-1] - x_coords[0])/xlen;
+         if (x_limit < 0) x_limit = -x_limit;
+         y_limit = 0.001*(y_coords[ylen-1] - y_coords[0])/ylen;
+         if (y_limit < 0) y_limit = -y_limit;
+         conrec(zs, 0, num_rows-1, 0, num_columns-1, y_coords, x_coords, 1, &z_level, 
+            dest_len_ptr, dest_ys_ptr, dest_xs_ptr, dest_sz_ptr, gaps, y_limit, x_limit, ierr);
+      } else {
+         gr_contour(y_coords, x_coords, zs, legit, num_rows, num_columns, z_level, 
+            dest_len_ptr, dest_ys_ptr, dest_xs_ptr, dest_sz_ptr, gaps, ierr);
+      }
    }
    
-   VALUE FM_private_make_contour(VALUE fmkr,
-         VALUE dest_xs, VALUE dest_ys, VALUE gaps, // these Dvectors get the results
-         VALUE xs, VALUE ys, // data x coordinates and y coordinates
-         VALUE zs, VALUE z_level, // the Dtable of values and the desired contour level
-         VALUE legit, // the Dtable of flags (nonzero means okay)
-         VALUE method // int == 1 means CONREC
+            
+   OBJ_PTR c_private_make_contour(OBJ_PTR fmkr, FM *p,
+         OBJ_PTR gaps, // these vectors get the results
+         OBJ_PTR xs, OBJ_PTR ys, // data x coordinates and y coordinates
+         OBJ_PTR zs, double z_level, // the table of values and the desired contour level
+         OBJ_PTR legit, // the table of flags (nonzero means okay)
+         int method, // int == 1 means CONREC
+         int *ierr
          ) {
-      FM *p = Get_FM(fmkr);
-      z_level = rb_Float(z_level);
-      c_make_contour(p, dest_xs, dest_ys, gaps, xs, ys, zs, NUM2DBL(z_level), legit, NUM2INT(method));
-      return fmkr;
+        /* uses Xvec_data and Yvec_data to create a cubic spline interpolant.
+        once the spline interpolant is created, it is sampled at the n_pts_to_add in Xs.
+        Xvec entry i is set to the value of the spline at Yvec entry i.
+        Both the X_data and the Xs should be stored in ascending order.
+        There is a boundary condition choice to be made for each end concerning the slope.
+        If clamped is true, the corresponding slope argument value sets the slope.
+        If clamped is false (known as a "free" or "natural" spline), 
+        the 2nd derivative is set to 0 and the slope is determined by the fit.
+        In this case, the corresponding slope argument is ignored.
+        */
+      long dest_len, dest_sz;
+      double *dest_xs_data;
+      double *dest_ys_data;
+      OBJ_PTR Xvec;
+      OBJ_PTR Yvec;
+      OBJ_PTR pts_array;
+      
+      dest_len = 0; dest_sz = 3000;
+      dest_xs_data = ALLOC_N_double(dest_sz);
+      dest_ys_data = ALLOC_N_double(dest_sz);
+
+      c_make_contour(p, &dest_len, &dest_xs_data, &dest_ys_data, &dest_sz, 
+         gaps, xs, ys, zs, z_level, legit, method, ierr);
+      if (*ierr != 0) RETURN_NIL;
+         
+      Xvec = Vector_New(dest_len, dest_xs_data);
+      Yvec = Vector_New(dest_len, dest_ys_data);
+      free(dest_xs_data);
+      free(dest_ys_data);
+      
+      pts_array = Array_New(2);
+      Array_Store(pts_array,0,Xvec,ierr);
+      if (*ierr != 0) RETURN_NIL;
+      Array_Store(pts_array,1,Yvec,ierr);
+      if (*ierr != 0) RETURN_NIL;
+      return pts_array;
    }