gphys 1.5.6 → 1.5.7

data/ext/numru/gphys/dim_op.c

@@ -30,6 +30,8 @@ enum bc_type {
 #define ID3o(i,j,k) ((i) + (j)*n0 + (k)*n0*n1o)
 #define ID3z(i,j,k) ((i) + (j)*n0 + (k)*n0*nz)
 #define ID3c(i,j,k) ((i) + (j)*n0 + (k)*n0*nc)
+#define ID3e(i,j,k,ni,nj,nk) (((i)%(ni)) + (j)*(ni) + ((k)%(nk))*(ni)*(nj))
+         // ID3e: covers 1D case (if ni==1 or nk==1, i or k is neglected by %)
 #define ID2(i,j) ((i) + (j)*n0)
 #define ID5(i,j,k,l,m) ((i) + (j)*ni + (k)*ni*nd1 + (l)*ni*nd1*no1 + (m)*ni*nd1*no1*nd2)
 #define NMax(i,j) ( (i) >= (j) ? (i) : (j) )
@@ -853,13 +855,13 @@ bin_mean_sum(int argc, VALUE *argv, VALUE self, int mean)
 static VALUE
 bin_mean(int argc, VALUE *argv, VALUE self)
 {
-    bin_mean_sum(argc, argv, self, 1);
+    return bin_mean_sum(argc, argv, self, 1);
 }
 
 static VALUE
 bin_sum(int argc, VALUE *argv, VALUE self)
 {
-    bin_mean_sum(argc, argv, self, 0);
+    return bin_mean_sum(argc, argv, self, 0);
 }
 
 
@@ -1000,36 +1002,44 @@ is simply when w is z itself, which is exploited in implementation.
 
  */
 static VALUE
-cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
+cell_integ_irreg(obj, f, mask, z, zdim, nzbound, ccell, w)
      VALUE obj;
      VALUE f;     // [NArray] multi-D data to be integrated
-     VALUE z;     // [NArray] multi-D coordinate values of f's grid; integration
-                  // is always made along z (whether or not w is given)
+     VALUE mask;  // [nil, or NArray] if NArray, mask of f
+     VALUE z;     // [NArray] 1D or multi-D coordinate values of f's grid
+                  // (if 1D, its length must be f's along zdim;
+                  // if multi-D z.shape must be equal to f.shape).
+                  // integration is always along z (whether or not w is given)
      VALUE zdim;  // [Integer] dimension of f along which to integrate
      VALUE nzbound; // [nil, or NArray(integer) with rank 1 smaller than f's]
                     // Length of the actual z dim for each column (data must
                     // be packed from the beginning of z dim; 0...nzbound[j,l]).
                     // If nil, the entire column is assumed valid;
-     VALUE ccell; // [NArray] 1D grid to sample the result. It is the z 
-                  // coordinate if w is nil; if w is given, it's a w grid.
+     VALUE ccell; // [NArray] 1D grid to sample the result. 
+                  // (if multi-D, its shape except along zdim must be f's);
+                  // It is the z coordinate if w is nil;
+                  // if w is given, it's a w grid.
      VALUE w;     // [nil or NArray] alternative grid point values to express
                   // the result as a function of w rather than z (special case)
                   // (e.g. z: pressure/g; w: potential temperature)
 {
     struct NARRAY *na;
-    int rank, zd, d;
+    int rank, zd, d, with_mask;
     na_shape_t *shape;
     na_shape_t n0, nz, n2, nzw;
+    na_shape_t n0z, n2z, n0w, n2w, n0c, n2c;
     na_shape_t *oshape, nc;
     VALUE F;       // the result: \int f dz
     double *fv, *zv, *wc, *wv, *Fv;
     int32_t *nzbd;
+    u_int8_t *msk;
     na_shape_t j, k, l, m;     // k: index of z (orig);  m: index of ccell
     double fa, fb, dz, wa, wb, wac, wbc, a, b, fi;
 
     // cast to ensure pointer types
 
     if(!IsNArray(f)) rb_raise(rb_eArgError, "f is not a NArray");
+    if(mask!=Qnil && !IsNArray(mask)) rb_raise(rb_eArgError, "mask is must be nil or a NArray");
     if(!IsNArray(z)) rb_raise(rb_eArgError, "z is not a NArray");
     if(!IsNArray(ccell)) rb_raise(rb_eArgError, "ccell is not a NArray");
     if(w!=Qnil && !IsNArray(w)) rb_raise(rb_eArgError, "w is must be nil or a NArray");
@@ -1043,9 +1053,6 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
     // read & check the shapes
 
     rank = NA_RANK(f);
-    if ( NA_RANK(z) != rank ){
-        rb_raise(rb_eArgError, "f and z must have the same shape");
-    }
     if ( nzbound != Qnil && NA_RANK(nzbound) != rank-1 ){
         rb_raise(rb_eArgError, "rank of nzbound must be 1 smaller than f's");
     }
@@ -1068,17 +1075,61 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 	n2 *= shape[d];
     }
 
-    if (NA_TOTAL(z) != n0*nz*n2){
-	rb_raise(rb_eArgError, "lengths of f and z do not agree");
+    if(mask==Qnil) {
+        with_mask = 0;
+        msk = NULL;
+    } else {
+        with_mask = 1;
+        if (NA_TOTAL(mask) != n0*nz*n2){
+            rb_raise(rb_eArgError, "lengths of f and mask must agree");
+        }
+        GetNArray(mask, na);
+        msk = (u_int8_t *)NA_PTR(na, 0);
     }
+
+    if ( NA_RANK(z) == rank ){
+        if (NA_TOTAL(z) != n0*nz*n2){
+            rb_raise(rb_eArgError, "lengths of f and z must agree (if multiD)");
+        }
+        n0z = n0;
+        n2z = n2;
+    } else if (NA_RANK(z) == 1) {
+        if (NA_TOTAL(z) != nz){
+            rb_raise(rb_eArgError, "lengths of z must be nz (if 1D)");
+        }
+        n0z = 1;
+        n2z = 1;
+    } else {
+        rb_raise(rb_eArgError, "z must have the same rank with f or be 1D");
+    }
+
     if (nzbound != Qnil && NA_TOTAL(nzbound) != n0*n2){
 	rb_raise(rb_eArgError, "shapes of f and nzbound are incompatible");
     }
 
     // prepare the output array; assign pointers
 
-    if ( NA_RANK(ccell) != 1 ){rb_raise(rb_eArgError, "ccell is not 1D");}
-    nc = NA_TOTAL(ccell);
+    if ( NA_RANK(ccell) == 1 ){
+        nc = NA_TOTAL(ccell);
+        n0c = 1;
+        n2c = 1;
+    } else if (NA_RANK(ccell) == rank) {
+        GetNArray(ccell, na);
+        shape = na->shape;
+        for (d=0, n0c=1 ; d<zd ; d++){
+            n0c *= shape[d];
+        }
+        nc = shape[zd];
+        for (d=zd+1, n2c=1 ; d<rank ; d++){
+            n2c *= shape[d];
+        }
+        if (n0c != n0) rb_raise(rb_eArgError,
+                                "shape miss match btwn f and ccell (case 0)");
+        if (n2c != n2) rb_raise(rb_eArgError,
+                                "shape miss match btwn f and ccell (case 2)");
+    } else {
+        rb_raise(rb_eArgError, "ccell is must be 1D or f.rank");
+    }
     oshape = ALLOCA_N(na_shape_t, rank);
     for (d=0; d<rank ; d++){
 	if (d != zd){
@@ -1105,15 +1156,32 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 
     GetNArray(ccell, na);
     wc = (double *)NA_PTR(na, 0);
-    if (wc[0] > wc[nc-1]){
+    if (wc[ID3e(0,0,0,n0c,nc,n2c)] > wc[ID3e(0,nc-1,0,n0c,nc,n2c)]){
 	rb_raise(rb_eArgError, "ccell must be alined in the increasing order");
     }
 
     if(w != Qnil){ 
 	GetNArray(w, na);
 	wv = (double *)NA_PTR(na, 0);
+        if ( NA_RANK(w) == rank ){
+            if (NA_TOTAL(w) != n0*nz*n2){
+                rb_raise(rb_eArgError, "lengths of f and w must agree (if multiD)");
+            }
+            n0w = n0;
+            n2w = n2;
+        } else if (NA_RANK(w) == 1) {
+            if (NA_TOTAL(w) != nz){
+                rb_raise(rb_eArgError, "lengths of z must be nz (if 1D)");
+            }
+            n0w = 1;
+            n2w = 1;
+        } else {
+            rb_raise(rb_eArgError, "z must have the same rank with f or be 1D");
+        }
     } else {
 	wv = zv;
+        n0w = n0z;
+        n2w = n2z;
     }
 
     // main loop
@@ -1130,24 +1198,27 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 	    m=0;   // m: index of the new cooridnate
 	    for (k=0; k<nzw-1; k++){
 		// set the trapezoid
-		if (wv[ID3z(j,k,l)] < wv[ID3z(j,k+1,l)]) {
-		    wa = wv[ID3z(j,k,l)];    // "left" (lower) end along w
-		    wb = wv[ID3z(j,k+1,l)];  // "right" (upper) end along w
+		if (wv[ID3e(j,k,l,n0w,nz,n2w)] < wv[ID3e(j,k+1,l,n0w,nz,n2w)]) {
+		    wa = wv[ID3e(j,k,l,n0w,nz,n2w)];   // left/lower end along w
+		    wb = wv[ID3e(j,k+1,l,n0w,nz,n2w)]; //right/upper end along w
 		    fa = fv[ID3z(j,k,l)];    // at the left end
 		    fb = fv[ID3z(j,k+1,l)];  // at the right end
 		} else {
-		    wa = wv[ID3z(j,k+1,l)];  // "left" (lower) end along w
-		    wb = wv[ID3z(j,k,l)];    // "right" (upper) end along w
+		    wa = wv[ID3e(j,k+1,l,n0w,nz,n2w)]; // left/lower end along w
+		    wb = wv[ID3e(j,k,l,n0w,nz,n2w)];   //right/upper end along w
 		    fa = fv[ID3z(j,k+1,l)];  // at the left end
 		    fb = fv[ID3z(j,k,l)];    // at the right end
 		}
-		dz = fabs(zv[ID3z(j,k+1,l)]-zv[ID3z(j,k,l)]);
+                if ( with_mask && (!msk[ID3z(j,k,l)] || !msk[ID3z(j,k+1,l)]) ) {
+                    fa = fb = 0.0;
+                }
+		dz = fabs(zv[ID3e(j,k+1,l,n0z,nz,n2z)]-zv[ID3e(j,k,l,n0z,nz,n2z)]);
 
 		// find the right next grid point to wa (left end)
-		if (wa < wc[m]){
-		    while( m>0 && wa < wc[m-1] ){ m--; }
+		if (wa < wc[ID3e(j,m,l,n0c,nc,n2c)]){
+		    while( m>0 && wa < wc[ID3e(j,m-1,l,n0c,nc,n2c)] ){ m--; }
 		} else {
-		    while( wa >= wc[m] && m<nc ){ m++; }
+		    while( wa >= wc[ID3e(j,m,l,n0c,nc,n2c)] && m<nc ){ m++; }
 		    // m can be nc, meaning the entire trapezoid is outside 
 		}
 
@@ -1156,7 +1227,7 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 		    wac = wa;   // left end of the current bin
 		    while(1){
 			//wbc = (wb<=wc[m]) ? wb : wc[m];  // current right end
-			wbc = fmin(wb, wc[m]);
+			wbc = fmin(wb, wc[ID3e(j,m,l,n0c,nc,n2c)]);
 
 			// do the integration
 			if (wb != wa){
@@ -1168,8 +1239,8 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 			}
 			  // ^ f value at (a+b)/2     ^ width
 			Fv[ID3c(j,m,l)] += fi;
-			if ( wb <= wc[m] || m == nc-1 ) break;
-			wac = wc[m];
+			if ( wb <= wc[ID3e(j,m,l,n0c,nc,n2c)] || m == nc-1 ) break;
+			wac = wc[ID3e(j,m,l,n0c,nc,n2c)];
 			m++;
 		    }
 		} else {
@@ -1189,8 +1260,9 @@ cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
    axis. -- This method acutually uses cell_integ_irreg and make sumation.
  */
 static VALUE
-cum_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
+cum_integ_irreg(obj, f, mask, z, zdim, nzbound, ccell, w)
      VALUE obj;
+     VALUE mask;  // [nil, or NArray] if NArray, mask of f
      VALUE f;
      VALUE z;
      VALUE zdim;
@@ -1200,7 +1272,7 @@ cum_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 {
     VALUE F;
 
-    F = cell_integ_irreg(obj, f, z, zdim, nzbound, ccell, w);
+    F = cell_integ_irreg(obj, f, mask, z, zdim, nzbound, ccell, w);
     cum_sum_dfloat_bang(obj, F, zdim);
     return F;
 }
@@ -1233,7 +1305,7 @@ cum_integ_irreg(obj, f, z, zdim, nzbound, ccell, w)
 
  */
 static VALUE
-cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
+cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb, misval)
      VALUE obj;
      VALUE f;     // [NArray] multi-D data
      VALUE zdim;  // [Integer] dimension of zcrd in f
@@ -1241,15 +1313,17 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
      VALUE upper; // true/false to cap the upper/lower side (with z)
      VALUE zb;    // [NArray] the "surface" z; zb.rank must be f.rank-1
      VALUE fb;    // [nil or NArray] the f value at surface (zb.shape==fb.shape)
+     VALUE misval;    // [nil or Float] if Float, missing value of f
 {
     VALUE fe;  // [NArray] return value, extended f by fb
     VALUE ze;  // [NArray] return value, grid points of fe along zdim
     VALUE nze;  // [NArray] return value, valid data lengths along zdim in fe
     VALUE result; // [Array] [fe, ze, nze] (return the two in an Array)
     struct NARRAY *na;
-    int rank, zd, d;
+    int rank, zd, d, w_mis, mis;
     na_shape_t n0, nz, n2, nc;
     double *fv, *zcv, *zbv, *fbv, *fev, *zev;
+    double ze_filv, rmis;
     int32_t *nzev;
     int zcincr, capupper, sgn;
     na_shape_t j, k, l;
@@ -1266,11 +1340,15 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
     zcrd = na_cast_object(zcrd, NA_DFLOAT);
     zb = na_cast_object(zb, NA_DFLOAT);
     if(fb != Qnil){ fb = na_cast_object(fb, NA_DFLOAT); }
+    w_mis = (misval != Qnil);
+    if (w_mis) {
+        rmis = NUM2DBL(misval);
+    }
 
     // read & check
 
     rank = NA_RANK(f);
-    if (NA_RANK(zb)!=rank-1){rb_raise(rb_eArgError, "zb.rank must f.rank-1");}
+    if (NA_RANK(zb)!=rank-1){rb_raise(rb_eArgError,"zb.rank must be f.rank-1");}
 
     zd = NUM2INT(zdim);
     if (zd < 0) zd += rank;    // negative: count from the last dim
@@ -1316,6 +1394,11 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
 	rb_raise(rb_eArgError,"Unexpected data alignment: To ensure that the zdim dimension of the output NArray (fe, ze) starts from the valid data (i.e., its beginning is inside the domain), it should be either that zcrd is increasing and upper==true or that zcrd is decreasing and upper==false");
     }
 
+    if (capupper) {
+        ze_filv = 1e200;
+    } else {
+        ze_filv = -1e200;
+    }
     // prepare the output array
 
     nc = nz+1;
@@ -1355,7 +1438,7 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
 	}
 	for (j=0; j<n0; j++){
 	    fev[ID3c(j,nc-1,l)] = 0e0;   // clear
-	    zev[ID3c(j,nc-1,l)] = 0e0;      // clear
+	    zev[ID3c(j,nc-1,l)] = ze_filv;      // clear
 	}
     }
 
@@ -1364,7 +1447,8 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
 	for (l=0; l<n2; l++){
 	    for (j=0; j<n0; j++){
 		for (k=0; k<nz; k++){
-		    if ( (zcv[k] - zbv[ID2(j,l)])*sgn > 0 ){
+                    mis = (w_mis && fv[ID3z(j,k,l)] == rmis);
+		    if ( mis || (zcv[k] - zbv[ID2(j,l)])*sgn > 0 ){
 			fev[ID3c(j,k,l)] = fbv[ID2(j,l)];
 			zev[ID3c(j,k,l)] = zbv[ID2(j,l)];
 			nzev[ID2(j,l)] = k+1;
@@ -1383,12 +1467,13 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
 	for (l=0; l<n2; l++){
 	    for (j=0; j<n0; j++){
 		for (k=0; k<nz; k++){
-		    if ( (zcv[k] - zbv[ID2(j,l)])*sgn > 0 ){
-			//fev[ID3c(j,k,l)] = fv[ID3z(j,k-1,l)];//naive extension
-			fev[ID3c(j,k,l)] = 
-			    ( fv[ID3z(j,k-1,l)]*(zcv[k]-zbv[ID2(j,l)])
-			    + fv[ID3z(j,k,l)]*(zbv[ID2(j,l)]-zcv[k-1]) ) /
-			    (zcv[k] - zcv[k-1]);
+                    mis = (w_mis && fv[ID3z(j,k,l)] == rmis);
+		    if ( mis || (zcv[k] - zbv[ID2(j,l)])*sgn > 0 ){
+			fev[ID3c(j,k,l)] = fv[ID3z(j,k-1,l)];//naive extension
+			//fev[ID3c(j,k,l)] = 
+			//    ( fv[ID3z(j,k-1,l)]*(zcv[k]-zbv[ID2(j,l)])
+			//    + fv[ID3z(j,k,l)]*(zbv[ID2(j,l)]-zcv[k-1]) ) /
+			//    (zcv[k] - zcv[k-1]);
 			zev[ID3c(j,k,l)] = zbv[ID2(j,l)];
 			nzev[ID2(j,l)] = k+1;
 			break;
@@ -1409,6 +1494,211 @@ cap_by_boundary(obj, f, zdim, zcrd, upper, zb, fb)
     return result;
 }
 
+/* 
+   c_val_crossing (C extension): find the positions or the values of y where the values of z crosses zval along dim (using the linear interpolation)
+
+   ARGUMENT
+   * z [NArray of float or sfloat]
+   * zmask [nil or NArray byte]
+   * dim [Integer]
+   * zval [Numeric]
+   * y [nil or NArray of float or sfloat] if nil, dim indices are used
+   * nth [Integer] 1,2,3,... for the 1st, 2nd, 3rd,... crossing
+   * descend [true, false, or nil] true: inspect dim indices from the last
+   * incr [nil, true, or false] nil: any crsossing is detected; true:
+     only increasing crossing is detected; false: only decreasing crossing is ..
+
+   RETURN VALUE
+   * yc [NArray double or float] : value of y at the crossing
+   * ycmask [NArray byte]: mask Array to create NArrayMiss from yc & ycmask
+ */
+static VALUE
+val_crossing(obj, z, zmask, dim, zval, y, nth, descend, incr)
+     VALUE obj;
+     VALUE z;
+     VALUE zmask;
+     VALUE dim;
+     VALUE zval;
+     VALUE y;
+     VALUE nth;
+     VALUE descend;
+     VALUE incr;
+{
+    VALUE yc;      // return value 1 (NArray)
+    VALUE ycmask;  // return value 2 (NArray byte)
+    double *yc_d;
+    float *yc_f;
+    u_int8_t *ycmsk;
+    int rank, dm, d, y1d;
+    struct NARRAY *na;
+    na_shape_t *shape, *oshape;
+    double *z_d, *y_d, zcv, z1, z2;
+    float *z_f, *y_f;
+    int zmis;
+    u_int8_t *zmsk;
+    na_shape_t n0, n1, n2;
+    na_shape_t j, k, l;
+    double a; // fractional position: 0<=a<=1
+    na_shape_t kf, ke, kstp;
+    int zdbl, ydbl;
+    int ith, nthv;
+    int icross, dcross;
+    double fillv = 9.9692099683868690e+36; // from NetCDF
+
+    if (!IsNArray(z)) {rb_raise(rb_eArgError, "z must be a NArray");}
+    if (y!= Qnil && !IsNArray(y)) {
+        rb_raise(rb_eArgError, "y must be nill or a NArray");
+    }
+
+    rank = NA_RANK(z);
+    GetNArray(z, na);
+    shape = na->shape;
+
+    if ( NA_TYPE(z) == NA_DFLOAT) {
+        zdbl = 1; // true
+        z_d = (double *)NA_PTR(na, 0);
+    } else if (NA_TYPE(z) == NA_SFLOAT) {
+        zdbl = 0; // false
+        z_f = (float *)NA_PTR(na, 0);
+    } else {
+        rb_raise(rb_eArgError, "z must be a DFLOAT or SFLOAT NArray");
+    }
+
+    if (zmask == Qnil) {
+        zmis = 0; // no need to consider data missing;
+    } else {
+        if (!IsNArray(zmask)) {rb_raise(rb_eArgError, "zmask is not a NArray");}
+        zmis = 1; // data missing may exist
+        GetNArray(zmask, na);
+        zmsk = (u_int8_t *)NA_PTR(na, 0);
+    }
+    
+
+    dm = NUM2INT(dim);
+    if (dm < 0) dm += rank;    // negative: count from the last dim
+
+    if (dm < 0 || dm >= rank){
+        rb_raise(rb_eArgError, 
+	   "Invalid dimension (%d) for a rank %d NArray", NUM2INT(dim), rank);
+    }
+
+    zcv = NUM2DBL(zval);
+
+    oshape = ALLOCA_N(na_shape_t, rank-1);
+    for (d=0, n0=1 ; d<dm ; d++){
+	n0 *= shape[d];
+        oshape[d] = shape[d];
+    }
+    n1 = shape[dm];
+    for (d=dm+1, n2=1 ; d<rank ; d++){
+	n2 *= shape[d];
+        oshape[d-1] = shape[d];
+    }
+
+    if ( descend == Qtrue ){
+        kf = n1-1;
+        ke = -1;
+        kstp = -1;
+    } else {
+        kf = 0;
+        ke = n1;
+        kstp = 1;
+    }
+    
+    if ( incr == Qnil ){
+        icross = 1;
+        dcross = 1;
+    } else if ( incr == Qtrue ){
+        icross = 1;
+        dcross = 0;
+    } else {
+        icross = 0;
+        dcross = 1;
+    }
+
+    nthv = NUM2INT(nth);
+    if (nthv <= 0) {
+        rb_raise(rb_eArgError, "nth (%d) must be positive (1,2,...)", nthv);
+    }
+
+    if ( y == Qnil ) {
+        ydbl = 1; // true
+        y1d = 1; // true
+        y_d = ALLOCA_N(double, n1);
+        for (k=0; k<n1; k++) {y_d[k] = (double) k;}
+    } else {
+        GetNArray(y, na);
+        if ( NA_TYPE(y) == NA_DFLOAT) {
+            ydbl = 1; // true
+            y_d = (double *)NA_PTR(na, 0);
+        } else if (NA_TYPE(y) == NA_SFLOAT) {
+            ydbl = 0; // false
+            y_f = (float *)NA_PTR(na, 0);
+        } else {
+            rb_raise(rb_eArgError, "expects a DFLOAT or SFLOAT NArray");
+        }
+        if (NA_TOTAL(y) == n1) {
+            // treated as 1D along dim
+            y1d = 1; // true
+        } else if (NA_TOTAL(y) == NA_TOTAL(z)) {
+            // treated as y and z share a shape
+            y1d = 0; // false
+        } else {
+            rb_raise(rb_eArgError, "Shape (length) of y mismatches that of z");
+        }
+    }
+
+    if (ydbl) {
+        yc = na_make_object(NA_DFLOAT, rank-1, oshape, cNArray);
+        yc_d = NA_PTR_TYPE(yc, double *);
+        for (j=0; j<n0*n2; j++){yc_d[j] = fillv;}
+    } else {
+        yc = na_make_object(NA_SFLOAT, rank-1, oshape, cNArray);
+        yc_f = NA_PTR_TYPE(yc, float *);
+        for (j=0; j<n0*n2; j++){yc_f[j] = (float) fillv;}
+    }
+    ycmask = na_make_object(NA_BYTE, rank-1, oshape, cNArray);
+    ycmsk = NA_PTR_TYPE(ycmask, u_int8_t *);
+    for (j=0; j<n0*n2; j++){ycmsk[j] = 0;}
+
+    for (l=0; l<n2; l++){
+        for (j=0; j<n0; j++){
+            z1 = ( zdbl ? z_d[ID3(j,kf,l)] : z_f[ID3(j,kf,l)] );
+            ith = 0;
+            for (k=kf+kstp; k!=ke; k+=kstp) {
+                z2 = ( zdbl ? z_d[ID3(j,k,l)] : z_f[ID3(j,k,l)] );
+                if ( ( !zmis || (zmsk[ID3(j,k-kstp,l)] && zmsk[ID3(j,k,l)]) ) &&
+                     ( icross && z1<zcv && zcv<=z2 ||
+                       dcross && z1>zcv && zcv>=z2 ) ){
+                    ith++;
+                    if (ith == nthv){
+                        a = (zcv-z1) / (z2-z1);
+                        if (y1d) {
+                            if (ydbl) {
+                                yc_d[ID2(j,l)] = (1.0-a)*y_d[k-kstp] + a*y_d[k];
+                            } else {
+                                yc_f[ID2(j,l)] = (1.0-a)*y_f[k-kstp] + a*y_f[k];
+                            }
+                        } else {
+                            if (ydbl) {
+                                yc_d[ID2(j,l)] = (1.0-a)*y_d[ID3(j,k-kstp,l)]
+                                                     + a*y_d[ID3(j,k,l)];
+                            } else {
+                                yc_f[ID2(j,l)] = (1.0-a)*y_f[ID3(j,k-kstp,l)]
+                                                     + a*y_f[ID3(j,k,l)];
+                            }
+                        }
+                        ycmsk[ID2(j,l)] = 1;
+                        break;
+                    }
+                }
+                z1 = z2;
+            }
+        }
+    }
+    return rb_ary_new3(2, yc, ycmask);
+}
+
 void
 init_gphys_dim_op()
 {
@@ -1432,9 +1722,11 @@ init_gphys_dim_op()
     rb_define_singleton_method(cGPhys, "c_bin_sum", bin_sum, -1);
 
     rb_define_private_method(cVArray, "c_cum_sum", cum_sum, 2);
+    rb_define_singleton_method(cGPhys, "c_cum_sum", cum_sum, 2);
     rb_define_singleton_method(cGPhys, "c_cell_integ_irreg", 
-			       cell_integ_irreg, 6);
-    rb_define_singleton_method(cGPhys, "c_cum_integ_irreg", cum_integ_irreg, 6);
+			       cell_integ_irreg, 7);
+    rb_define_singleton_method(cGPhys, "c_cum_integ_irreg", cum_integ_irreg, 7);
 
-    rb_define_singleton_method(cGPhys, "c_cap_by_boundary", cap_by_boundary, 6);
+    rb_define_singleton_method(cGPhys, "c_cap_by_boundary", cap_by_boundary, 7);
+    rb_define_singleton_method(cGPhys, "c_val_crossing", val_crossing, 8);
 }

data/ext/numru/gphys/ext_init.c

@@ -1,3 +1,9 @@
+void init_ext_coord();
+void init_gphys_interpo();
+void init_gphys_multibitIO();
+void init_gphys_dim_op();
+void init_gphys_quad_mesh_sample();
+
 void
 Init_gphys_ext()
 {