gphys 1.5.5 → 1.5.7

data/ext/numru/ganalysis/ext_init.c

@@ -0,0 +1,9 @@
+void init_ganalysis_pde_ext();
+void init_narray_ext_dfloat();
+
+void
+Init_ganalysis_ext()
+{
+    init_ganalysis_pde_ext();
+    init_narray_ext_dfloat();
+}

data/ext/numru/ganalysis/extconf.rb

@@ -0,0 +1,43 @@
+require 'mkmf'
+gem_path = nil
+
+if Gem.respond_to?(:find_files) and Gem.find_files("narray.h").length > 0
+  require "rbconfig"
+  so = RbConfig::CONFIG["DLEXT"]
+  narray_include = File.expand_path(File.dirname(Gem.find_files("narray.h")[0]))
+  narray_lib = File.expand_path(File.dirname(Gem.find_files("narray." + so)[0]))
+else
+  gem_home=(`gem environment GEM_HOME`).chomp
+  narray_dir = Dir.glob("#{gem_home}/gems/narray-*/ext/narray").sort[-1]
+  if narray_dir
+    narray_include = narray_lib = narray_dir
+  else
+    narray_include = narray_lib = [ $sitearchdir, $vendorarchdir]
+  end
+end
+dir_config('narray', narray_include, narray_lib)
+
+require "narray"
+if NArray.const_defined?(:SUPPORT_BIGMEM) && NArray::SUPPORT_BIGMEM
+
+  case RbConfig::CONFIG["CC"]
+  when "gcc"
+    omp_opt = "-fopenmp"
+  else
+    omp_opt = nil
+  end
+  omp_opt = arg_config("--openmp", omp_opt)
+
+  omp_opt = nil if omp_opt.to_s.empty?
+
+  if omp_opt
+    $CFLAGS << " " << omp_opt
+    $DLDFLAGS << " " << omp_opt
+    warn "OpenMP support: ON"
+  else
+    warn "OpenMP support: OFF"
+    warn "if you want to enable openmp, set --openmp=compile_option"
+  end
+end
+
+create_makefile('numru/ganalysis_ext')

data/ext/numru/ganalysis/narray_ext_dfloat.c

@@ -0,0 +1,84 @@
+/* narray_ext_dfloat.c : Extention library of NArray (DFLOAT only)
+ */
+#include<stdio.h>
+#include<string.h>
+#include "ruby.h"
+#include "narray.h"
+#ifndef NARRAY_BIGMEM
+typedef int na_shape_t;
+#endif
+
+typedef double c_num_t;
+#define NATYPE NA_DFLOAT
+
+static VALUE
+cum_sum_dfloat(obj, self, dim)
+     VALUE obj;
+     VALUE self;
+     VALUE dim;
+{
+    VALUE res;
+    int d, dj, rank;
+    struct NARRAY *na;
+    na_shape_t i, j, k, ni, nj, nk, nij;
+    na_shape_t *sh;
+    c_num_t *p, *c;
+    
+    /* check & read arguments */
+    dj = NUM2INT(dim);
+
+    if (NA_TYPE(self) != NATYPE) rb_raise(rb_eArgError,"Unexpected type");
+    rank = NA_RANK(self);
+    if (dj<-rank || dj>=rank) rb_raise(rb_eArgError,
+                     "dim (%d) out of range (%d to %d)", dj, -rank, rank-1);
+    if (dj<0) dj += rank;
+    
+    /* interpret shape as 3D */
+    GetNArray(self, na);
+    sh = na->shape;
+    p = (c_num_t *) NA_PTR(na, 0);
+    ni = 1;
+    for(d=0; d<dj; d++) ni *= sh[d];
+    nj = sh[dj];
+    nij = ni*nj;
+    nk = 1;
+    for(d=dj+1; d<rank; d++) nk *= sh[d];
+
+    /* initialize the output object */
+    res = na_make_object(NATYPE, rank, sh, cNArray);
+    GetNArray(res, na);
+    c = (c_num_t *) NA_PTR(na, 0);
+
+    /* operation */
+    for(k=0; k<nk; k++){
+        for(i=0; i<ni; i++){
+            c[i+nij*k] = p[i+nij*k];   /* copy the first element */
+        }
+    }
+    for(k=0; k<nk; k++){
+        for(j=1; j<nj; j++){
+            for(i=0; i<ni; i++){
+                c[i+ni*j+nij*k] = p[i+ni*j+nij*k] + c[i+ni*(j-1)+nij*k];
+            }
+        }
+    }
+
+    return(res);
+}
+
+
+// VALUE cNArray;
+
+void
+init_narray_ext_dfloat()
+{
+    /* 以下はどうもうまく行かない。(NArrayが拡張ライブラリだからか)
+       rb_require("narray");
+       // cNArray = rb_define_class("NArray", rb_cObject);
+       rb_define_method(cNArray, "cum_sum_dfloat", cum_sum_dfloat, 1);
+     */
+    static VALUE mNumRu, mNArrayExt;
+    mNumRu = rb_define_module("NumRu");
+    mNArrayExt = rb_define_module_under(mNumRu, "NArrayExt");
+    rb_define_module_function(mNArrayExt, "cum_sum_dfloat", cum_sum_dfloat, 2);
+}

data/ext/numru/ganalysis/pde_ext.c

@@ -0,0 +1,130 @@
+/* c_pde.c : Extention library for partial differential equation solvers
+ * All in NArray
+ */
+
+#include<stdio.h>
+#include<string.h>
+#include<math.h>
+#include "ruby.h"
+#include "narray.h"
+
+/* for compatibility for NArray and NArray with big memory patch */
+#ifndef NARRAY_BIGMEM
+typedef int na_shape_t;
+#endif
+
+#define ID(i,j) ((i)+nx*(j))
+
+/* Eq: A z_xx + 2 B z_xy + C z_yy + D z_x + E z_y = F
+ *              ^^^
+ *
+ * Assumption: dx and dy are constants (uniform).
+ * Boundary values are not changed. --> change afterwords if not Dirichlet.
+ *
+ * Basic discretization: by central differences:
+ *   A/dx^2 (z[i-1,j]-2z[i,j]+z[i+1,j])
+ *   + B/(2dxdy) ((z[i+1,j+1]-z[i-1,j+1]-z[i+1,j-1]+z[i-1,j-1])
+ *   + C/dy^2 (z[i,j-1]-2z[i,j]+z[i,j+1])
+ *   + D/(2dx) (z[i+1,j]-z[i-1,j]) + E/(2dy) (z[i,j+1]-z[i,j-1]) - F = 0
+ * 
+ * * Z [2D Float(=DFLOAT) NArray] (inout) -- to be overwritten
+ * * A, B, ... [2D Float(=DFLOAT) NArray] coeffitients
+ * * OME [Float] constant, which should 1<= OME < 2 (Gauss-Seidel if OME=1)
+ * * Return value: res = |H dz| (L2 norm),
+ *   where H = 2(diag(A)/dx^2+diag(C)/dy^2).
+ *   Convergence can be judged by res/|F| < eps
+ */
+static VALUE
+SOR_2D_2ndorder_1step(obj, Z, A, B, C, D, E, F, DX, DY, OME, Ignore_non_eliptic)
+     VALUE obj;
+     VALUE Z;
+     VALUE A, B, C, D, E, F;
+     VALUE DX, DY, OME;
+     VALUE Ignore_non_eliptic;
+{
+    double *z, *ap, *bp, *cp, *dp, *ep, *fp;
+    double a, b, c, d, e, f, g, h, sum=0;
+    double dx, dy, ome;
+    struct NARRAY *na;
+    na_shape_t nx, ny, i, j;
+    VALUE res;
+
+    /* check & read arguments */
+    
+    if (NA_TYPE(Z) != NA_DFLOAT) rb_raise(rb_eArgError, "Z nust be DFLOAT");
+    if (NA_TYPE(A) != NA_DFLOAT) rb_raise(rb_eArgError, "A nust be DFLOAT");
+    if (NA_TYPE(B) != NA_DFLOAT) rb_raise(rb_eArgError, "B nust be DFLOAT");
+    if (NA_TYPE(C) != NA_DFLOAT) rb_raise(rb_eArgError, "C nust be DFLOAT");
+    if (NA_TYPE(D) != NA_DFLOAT) rb_raise(rb_eArgError, "D nust be DFLOAT");
+    if (NA_TYPE(E) != NA_DFLOAT) rb_raise(rb_eArgError, "E nust be DFLOAT");
+    if (NA_TYPE(F) != NA_DFLOAT) rb_raise(rb_eArgError, "F nust be DFLOAT");
+
+    if (NA_RANK(Z) != 2) rb_raise(rb_eArgError, "Z must be 2-dimensional");
+    nx = NA_SHAPE0(Z);
+    ny = NA_SHAPE1(Z);
+    if (NA_SHAPE0(A)!=nx || NA_SHAPE1(A)!=ny) rb_raise(rb_eArgError,
+                                                       "A: invalid shape");
+    if (NA_SHAPE0(B)!=nx || NA_SHAPE1(B)!=ny) rb_raise(rb_eArgError,
+                                                       "B: invalid shape");
+    if (NA_SHAPE0(C)!=nx || NA_SHAPE1(C)!=ny) rb_raise(rb_eArgError,
+                                                       "C: invalid shape");
+    if (NA_SHAPE0(D)!=nx || NA_SHAPE1(D)!=ny) rb_raise(rb_eArgError,
+                                                       "D: invalid shape");
+    if (NA_SHAPE0(E)!=nx || NA_SHAPE1(E)!=ny) rb_raise(rb_eArgError,
+                                                       "E: invalid shape");
+    if (NA_SHAPE0(F)!=nx || NA_SHAPE1(F)!=ny) rb_raise(rb_eArgError,
+                                                       "F: invalid shape");
+
+    GetNArray(Z, na); z = (double *)NA_PTR(na, 0);
+    GetNArray(A, na); ap = (double *)NA_PTR(na, 0);
+    GetNArray(B, na); bp = (double *)NA_PTR(na, 0);
+    GetNArray(C, na); cp = (double *)NA_PTR(na, 0);
+    GetNArray(D, na); dp = (double *)NA_PTR(na, 0);
+    GetNArray(E, na); ep = (double *)NA_PTR(na, 0);
+    GetNArray(F, na); fp = (double *)NA_PTR(na, 0);
+
+    dx = NUM2DBL(DX);
+    dy = NUM2DBL(DY);
+    if (dx==0.0) rb_raise(rb_eArgError, "dx == 0");
+    if (dy==0.0) rb_raise(rb_eArgError, "dy == 0");
+    ome = NUM2DBL(OME);
+
+    /* solve (1 step) */
+    for (j=1; j<ny-1; j++){
+        for (i=1; i<nx-1; i++){
+            a = ap[ID(i,j)] / (dx*dx);
+            b = bp[ID(i,j)] / (dx*dy);
+            c = cp[ID(i,j)] / (dy*dy);
+            if (Ignore_non_eliptic == Qfalse || Ignore_non_eliptic == Qnil ) {
+                if((a*c-b*b)<=0.0) 
+                    rb_raise(rb_eStandardError,"non-eliptic@[%d,%d]",i,j);
+            }
+            d = dp[ID(i,j)] / dx;
+            e = ep[ID(i,j)] / dy;
+            f = fp[ID(i,j)];
+            h = 2*(a+c);
+            g = ome * ( a*( z[ID(i-1,j)]+z[ID(i+1,j)] )
+                      + b/2*( z[ID(i+1,j+1)] - z[ID(i-1,j+1)] - z[ID(i+1,j-1)]
+                             +z[ID(i-1,j-1)] )
+                      + c*( z[ID(i,j-1)]+z[ID(i,j+1)] )
+                      + d/2*( z[ID(i+1,j)]-z[ID(i-1,j)] )
+                      + e/2*( z[ID(i,j+1)]-z[ID(i,j-1)] )
+                      - f - h*z[ID(i,j)]);
+            sum += g*g;
+            z[ID(i,j)] += g/h;
+        }
+    }
+    res = DBL2NUM( sqrt(sum) );
+    return(res);
+}
+
+void
+init_ganalysis_pde_ext()
+{
+    static VALUE mNumRu, mGA, mPDE;
+    mNumRu = rb_define_module("NumRu");
+    mGA = rb_define_module_under(mNumRu, "GAnalysis");
+    mPDE = rb_define_module_under(mGA, "PDE");
+    rb_define_module_function(mPDE, "SOR_2D_2ndorder_1step", 
+                              SOR_2D_2ndorder_1step, 11);
+}