ruby-dcl 1.6.2

data/dcl_rubydcloriginal.c

@@ -0,0 +1,129 @@
+/*
+ Original methods of Ruby-DCL
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+#define DFLT_SIZE 32
+
+extern char    *dcl_obj2ccharary(VALUE, int, int);
+extern integer *dcl_obj2cintegerary(VALUE);
+extern real    *dcl_obj2crealary(VALUE);
+extern complex *dcl_obj2ccomplexary(VALUE);
+extern logical *dcl_obj2clogicalary(VALUE);
+
+extern VALUE dcl_ccharary2obj(char *, int, int);
+extern VALUE dcl_cintegerary2obj(integer *, int, int, int *);
+extern VALUE dcl_crealary2obj(real *, int, int, int *);
+extern VALUE dcl_ccomplexary2obj(complex *, int, char *);
+extern VALUE dcl_clogicalary2obj(logical *, int, int, int *);
+
+extern void dcl_freeccharary(char *);
+extern void dcl_freecintegerary(integer *);
+extern void dcl_freecrealary(real *);
+extern void dcl_freeccomplexary(complex *);
+extern void dcl_freeclogicalary(logical *);
+
+/* for functions which return doublereal */
+/* fnclib */
+extern doublereal rd2r_(real *);
+extern doublereal rr2d_(real *);
+extern doublereal rexp_(real *, integer *, integer *);
+extern doublereal rfpi_(void);
+extern doublereal rmod_(real *, real *);
+/* gnmlib */
+extern doublereal rgnlt_(real *);
+extern doublereal rgnle_(real *);
+extern doublereal rgngt_(real *);
+extern doublereal rgnge_(real *);
+/* rfalib */
+extern doublereal rmax_(real *, integer *, integer *);
+extern doublereal rmin_(real *, integer *, integer *);
+extern doublereal rsum_(real *, integer *, integer *);
+extern doublereal rave_(real *, integer *, integer *);
+extern doublereal rvar_(real *, integer *, integer *);
+extern doublereal rstd_(real *, integer *, integer *);
+extern doublereal rrms_(real *, integer *, integer *);
+extern doublereal ramp_(real *, integer *, integer *);
+/* rfblib */
+extern doublereal rprd_(real *, real *, integer *, integer *, integer *);
+extern doublereal rcov_(real *, real *, integer *, integer *, integer *);
+extern doublereal rcor_(real *, real *, integer *, integer *, integer *);
+
+
+extern VALUE mDCL;
+
+static VALUE
+dcl_uemrkz(obj, n, upx, upy, z, itype, index, rsize)
+    VALUE obj, n, upx, upy, z, itype, index, rsize;
+{
+    integer i_n;
+    real *i_upx;
+    real *i_upy;
+    real *i_z;
+    integer i_itype;
+    integer i_index;
+    real i_rsize;
+
+    integer idx,one,k;
+    logical lmiss;
+    real rmiss;
+    char *str;
+
+    if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
+      n = rb_funcall(n, rb_intern("to_i"), 0);
+    }
+    if (TYPE(upx) == T_FLOAT) {
+      upx = rb_Array(upx);
+    }
+    if (TYPE(upy) == T_FLOAT) {
+      upy = rb_Array(upy);
+    }
+    if (TYPE(z) == T_FLOAT) {
+      z = rb_Array(z);
+    }
+    if ((TYPE(itype) != T_BIGNUM) || (TYPE(itype) != T_FIXNUM)) {
+      itype = rb_funcall(itype, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(index) != T_BIGNUM) || (TYPE(index) != T_FIXNUM)) {
+      index = rb_funcall(index, rb_intern("to_i"), 0);
+    }
+    if (TYPE(rsize) != T_FLOAT) {
+      rsize = rb_funcall(rsize, rb_intern("to_f"), 0);
+    }
+
+    i_n = NUM2INT(n);
+    i_itype = NUM2INT(itype);
+    i_index = NUM2INT(index);
+    i_rsize = (real)NUM2DBL(rsize);
+    i_upx = dcl_obj2crealary(upx);
+    i_upy = dcl_obj2crealary(upy);
+    i_z = dcl_obj2crealary(z);
+
+    one = 1;
+    str = "LMISS";
+    gllget_(str, &lmiss, (ftnlen)strlen(str));
+    str = "RMISS";
+    glrget_(str, &rmiss, (ftnlen)strlen(str));
+    for(k=0 ; k<i_n; k++){
+	if( !lmiss || i_z[k] != rmiss ){
+	    idx = (iueton_(i_z+k)/1000)*10 + i_index ;
+	    uumrkz_(&one, i_upx+k, i_upy+k, &i_itype, &idx, &i_rsize);
+        }
+    }
+
+    dcl_freecrealary(i_upx);
+    dcl_freecrealary(i_upy);
+
+    return Qnil;
+}
+
+void
+init_rubydcloriginal(mDCL)
+VALUE mDCL;
+{
+    rb_define_module_function(mDCL, "uemrkz", dcl_uemrkz, 7);
+}

data/demo/gokuraku/hop/hop.rb

@@ -0,0 +1,26 @@
+#
+# hop.rb
+#   $Id: hop.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include NMath
+
+nmax = 400
+dt = 2*PI/(nmax-1)
+t = NArray.sfloat(nmax).indgen! * dt
+x = 1e2*sin(4*t)
+y = 1e-3*cos(5*t)+6
+
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::grfrm
+
+DCL::ussttl('X-TITLE', 'x-unit', 'Y-TITLE', 'y-unit')
+DCL::usgrph(x, y)
+
+DCL::grcls
+

data/demo/gokuraku/jump/jump1.rb

@@ -0,0 +1,64 @@
+#
+# jump1.rb
+#   $Id: jump1.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include NMath
+
+nmax = 400
+dt = 2*PI/(nmax-1)
+
+x = NArray.sfloat(nmax)
+y = NArray.sfloat(nmax)
+
+#-- data 1 ----
+dt = 2*PI/(nmax-1)
+t = NArray.sfloat(nmax).indgen! * dt
+x = 5*sin(4*t)
+y = 5*cos(5*t)
+
+#-- graph 1 ----
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::grfrm
+
+DCL::grswnd(-6.0, 6.0, -6.0, 6.0)
+DCL::grsvpt(0.15, 0.45, 0.65, 0.95)
+DCL::grstrn( 1 )
+DCL::grstrf
+
+DCL::ussttl('X1', '', 'Y1', '')
+DCL::usdaxs
+
+DCL::uulin(x, y)
+
+#-- data 2 ----
+iseed = 0
+
+x[0] = 2*(rand(iseed)-0.5)
+y[nmax-1] = x[0]
+
+for n in 1..nmax-1
+  x[n] = 2*(rand(iseed)-0.5)
+  y[n-1] = x[n]
+end
+
+#-- graph 2 ----
+DCL::grfig
+
+DCL::grswnd(-1.1, 1.1, -1.1, 1.1)
+DCL::grsvpt(0.15, 0.95, 0.1, 0.5)
+DCL::grstrn(1)
+DCL::grstrf
+
+DCL::ussttl('X2-TITLE', '', 'Y2-TITLE', '')
+DCL::usdaxs
+
+DCL::uumrk(x, y)
+
+DCL::grcls
+

data/demo/gokuraku/jump/jump2.rb

@@ -0,0 +1,50 @@
+#
+# jump2.rb
+#   $Id: jump2.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+nmax = 100
+
+x = NArray.sfloat(nmax)
+y = NArray.sfloat(nmax)
+
+#-- data ----
+r  = 0.2
+r0 = 0.0
+for i in 0..nmax-1
+  r = 3.6*r*(1-r)
+  r0 += r*4 - 2.58
+  x2 = (i-49.0)**2
+  rexp = 4.0*(i+1)/nmax
+  x[i] = 10**rexp
+  y[i] = 1.0e5*exp(-x2) + 10.0**r0
+end
+
+y[19] = 1.0e4
+y[39] = 2.0e3
+y[64] = 3.0e4
+y[69] = 5.0e2
+
+#-- graph ----
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::grfrm
+
+DCL::grswnd(1.0e0, 1.0e4, 1.0e-1, 1.0e6)
+DCL::grsvpt(0.2,  0.8,   0.2,  0.8)
+DCL::grstrn(4)
+DCL::grstrf
+
+DCL::ussttl('FREQUENCY', '/s', 'POWER', 'm|2"/s|2"')
+DCL::usdaxs
+
+DCL::uulin(x, y)
+
+DCL::grcls
+

data/demo/gokuraku/layout/lay1.rb

@@ -0,0 +1,46 @@
+#
+# lay1.rb
+#   $Id: lay1.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+nmax = 401
+jmax = 51
+
+y = NArray.sfloat(nmax)
+
+#-- data ----
+y0 = 0.5
+for n in 0..nmax-1
+  y[n] = 5.0*y0 + 10.0
+  y0 = 3.7*y0*(1.0-y0)
+end
+
+rundef = DCL::glrget('RUNDEF')
+
+#-- graph ----
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::sldiv('Y', 3, 2)
+
+for i in 1..8
+
+  DCL::grfrm
+
+  j = (i-1)*(jmax-1)
+  xmin = j + 1600.0
+  xmax = xmin + jmax - 1
+
+  DCL::grswnd(xmin, xmax, rundef, rundef)
+  DCL::ussttl('TIME', 'YEAR', 'TEMPERATURE', 'DEG')
+  DCL::usgrph(rundef, y[j..j+jmax-1])
+
+end
+
+DCL::grcls
+

data/demo/gokuraku/layout/lay2.rb

@@ -0,0 +1,44 @@
+#
+# lay2.rb
+#   $Id: lay2.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+nmax = 401
+xmin = 1600.0
+xmax = 2000.0
+
+x = NArray.sfloat(nmax)
+y = NArray.sfloat(nmax)
+
+#-- data ----
+x.indgen(xmin, (xmax-xmin)/(nmax-1))
+y0 = 0.5
+for n in 0..nmax-1
+  y[n] = 5.0*y0 + 10.0
+  y0   = 3.7*y0*(1.0-y0)
+end
+
+#-- graph ----
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::sglset('LFULL', true)
+DCL::grfrm
+
+DCL::grswnd(xmin, xmax, 11.0, 15.0)
+DCL::grsvpt(0.15, 0.95, 0.15, 0.65)
+DCL::uspfit
+DCL::grstrf
+
+DCL::ussttl('TIME', 'YEAR', 'TEMPERATURE', 'DEG')
+DCL::usdaxs
+
+DCL::uulin(x, y)
+
+DCL::grcls
+

data/demo/gokuraku/step/step0.rb

@@ -0,0 +1,34 @@
+#
+# step0.rb
+#   $Id: step0.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include NMath
+
+nmax = 400
+dt = 2*PI/(nmax-1)
+
+x = NArray.sfloat(nmax)
+y = NArray.sfloat(nmax)
+
+t = NArray.sfloat(nmax).indgen! * dt
+x = 1e2*sin(4*t)
+y = 1e-3*cos(5*t)+6
+
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::grfrm
+
+DCL::ussttl('X-TITLE', 'x-unit', 'Y-TITLE', 'y-unit')
+DCL::usspnt(x, y)
+DCL::uspfit
+DCL::grstrf
+DCL::usdaxs
+DCL::uulin(x, y)
+
+DCL::grcls
+

data/demo/gokuraku/step/step1.rb

@@ -0,0 +1,84 @@
+#
+# step1.rb
+#   $Id: step1.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include NMath
+
+nmax = 201
+imax = 5
+len_2 = 5
+
+ix  = 0
+iy0 = 1
+iy1 = 2
+iy2 = 3
+iy3 = 4
+
+z1 = NArray.sfloat(nmax, len_2)
+
+a = []
+
+#-- data ----
+for m in 1..imax
+  tm = (2*m - 1)*PI
+  a[m-1] = (-1.0)**m * 2/tm
+end
+
+idx = NArray.sfloat(nmax).indgen!
+z1[true,ix] = 1.0*idx/(nmax-1)
+tn = 2*PI*z1[true,ix]
+z1[ ( (tn>=(PI/2)) & (tn<(PI*3/2)) ).where, iy0] = 1.0
+z1[true,iy1] = 0.5 + a[0]*cos(tn)
+z1[true,iy2] = 0.5
+z1[true,iy3] = 0.5
+
+for k in 1..imax
+  tk = 2*k - 1
+  tc = a[k-1]*cos(tk*tn)
+
+  z1[true,iy2] = z1[true,iy2] +
+    if (k <= 3) then tc else 0 end
+  z1[true,iy3] = z1[true,iy3] + tc
+end
+
+#-- graph ----
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::grfrm
+
+x  = z1[true,ix]
+y0 = z1[true,iy0]
+y1 = z1[true,iy1]
+y2 = z1[true,iy2]
+y3 = z1[true,iy3]
+
+DCL::usspnt(x, y0)
+DCL::usspnt(x, y1)
+DCL::usspnt(x, y2)
+DCL::usspnt(x, y3)
+
+DCL::uspfit
+DCL::grstrf
+
+DCL::ussttl('FREQUENCY', '/DAY', 'RESPONSE', '')
+DCL::usdaxs
+
+DCL::uulin(x, y0)
+
+DCL::uuslnt(2)
+DCL::uuslni(3)
+DCL::uulin(x, y1)
+
+DCL::uuslnt(3)
+DCL::uulin(x, y2)
+
+DCL::uuslnt(4)
+DCL::uulin(x, y3)
+
+DCL::grcls
+