ruby-dcl 1.6.2

data/demo/grph2/ximage/ximg01.rb

@@ -0,0 +1,145 @@
+#
+# ximg01.rb
+#
+# $Id: ximg01.rb,v 1.1.1.1 2011-02-23 07:21:27 horinout Exp $
+#
+
+#-----------------------------------------------------------------------
+#     TOMS OZONE DISTRIBUTION (MONTHLY MEAN CLIMATOLOGY)
+#-----------------------------------------------------------------------
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+
+KXBK = 12
+IXBK = KXBK*2+1
+JXBK = 37
+IXBG = 73
+JXBG = 37
+IXGX = 361
+JXGX = 181
+NCL = 100
+NCL1 = NCL+1
+
+bkdata = NArray.sfloat(IXBK*JXBK)
+bgdata = NArray.sfloat(IXBG, JXBG)
+gxdata = NArray.sfloat(IXGX, JXGX)
+tlevn = NArray.sfloat(NCL1)
+
+def fftezb(fc, nx)
+  nn = 0
+  maxwn = fc.shape[0]
+
+  nmax = 512
+  if (nx > nmax)
+    cmsg = format("WORKING AREA IS NOT ENOUGH / NX SHOULD BE .LE. %4d.", nmax)
+    DCL::msgdmp('E', 'FFTEZB', cmsg)
+  end
+  if (nx < maxwn*2)
+    cmsg = "MAXWN CANNOT BE CALCULATED / NX SOULD BE .GE. MAXWN*2.0"
+    DCL::msgdmp('E', 'FFTEZB', cmsg)
+  end
+
+  if (nx != nn)
+    wsave = DCL::rffti(nx)
+    nn=nx
+  end
+  y = Array.new(nx, 0)
+  y[0] = fc[0]
+  1.step(maxwn-1, 2) do |i|
+    y[i] = fc[i] * 0.5
+    y[i+1] = fc[i+1] * -0.5
+  end
+  y = DCL::rfftb(y, wsave)
+end
+
+def bktobg(bkdata, bgdata)
+  rmiss = DCL::glrget('RMISS')
+#     CALL DTPGET('MAXWN',KX)
+  for j in 0..JXBG-1
+    if (bkdata[0,j] == rmiss)
+      bgdata[true,j] = rmiss
+    else
+      wk = fftezb(bkdata[true,j], IXBG-1)
+      bgdata[0..-2, j] = wk
+      bgdata[-1,j]=bgdata[0,j]
+    end
+  end
+end
+
+#-- data ---
+ipatn = []
+for i in 0..NCL-1
+  ipatn[i] = ([11, i+1].max) *1000 + 999
+end
+tlevn.indgen(203.0, 3.0)
+
+cdsn = 'tomsclm.dat'
+file = open(cdsn, "r")
+
+DCL::swlstx('LWAIT', false)
+DCL::swlstx('LWAIT0', false)
+DCL::swlstx('LDUMP', false)
+DCL::swistx('IPOSX', 200)
+DCL::swistx('IPOSY', 200)
+DCL::swistx('IWIDTH', 800)
+DCL::swistx('IHEIGHT', 400)
+
+#-- graph ---
+iws = (ARGV[0] || (puts ' WORKSTATION ID (I)  ? ;'; DCL::sgpwsn; gets)).to_i
+DCL::gropn iws
+DCL::gllset('LMISS', true)
+rmiss = DCL::glrget('RMISS')
+DCL::sglset('LFULL', true)
+DCL::sglset('LSOFTF', false)
+DCL::umlset('LGLOBE', true)
+DCL::slrat(1.0, 0.5)
+
+for m in 1..12
+  mon = file.gets.split(" ")[-1].to_i
+  bkdata.reshape(IXBK*JXBK)
+  i = 0
+  (JXBK*3).times do |j|
+    file.gets.split(" ").each do |data|
+      bkdata[i] = data.to_f
+      i += 1
+    end
+  end
+  bktobg(bkdata.reshape(IXBK, JXBK), bgdata)
+  gxdata.fill!(rmiss)
+  for j in 0..JXBG-1
+    for i in 0..IXBG-1
+      gxdata[i*5, j*5] = bgdata[i,j]
+    end
+    wk = DCL::vrintr(gxdata[true, j*5], IXGX, 1)
+    gxdata[true, j*5] = wk
+  end
+  for i in 0..IXGX-1
+    wk = DCL::vrintr(gxdata[i, true], JXGX, 1)
+    gxdata[i, true] = wk
+  end
+
+  DCL::grfrm
+  DCL::grswnd(0.0, 360.0, -90.0, 90.0)
+  DCL::grsmpl(180.0, 90.0, 0.0)
+  DCL::grstrn(DCL::isgtrc('HMR'))
+  DCL::umpfit
+  DCL::grstrf
+
+  DCL::slpwwr(1)
+  DCL::ueitlv
+  DCL::uestln(tlevn, ipatn)
+  DCL::uetonf(gxdata)
+
+  DCL::umpgrd
+  DCL::umplim
+  DCL::umpmap('coast_world')
+end
+file.close
+
+DCL::grcls
+

data/demo/math1/gt2dlib/gt2d01.rb

@@ -0,0 +1,33 @@
+#
+#      program gt2d01
+#
+#      T Horinouchi 2004/11/11
+
+require "numru/dcl"
+include NumRu
+include NMath
+
+nx=15
+ny=15
+
+ux = NArray.sfloat(nx).indgen!/(nx-1.0) - 0.5
+terrain = 0.1 * exp(-24*ux**2)
+uy = NArray.sfloat(ny).indgen!/(ny-1.0)
+
+cx = NArray.sfloat(nx,ny)
+cx[0,0] = DCL::glrget('rundef')
+cy = uy.reshape(1,ny)*(1.0-terrain) + terrain
+
+DCL::g2sctr(ux,uy, cx,cy)
+
+print "terrain following coordinate\n"
+
+uxp = 0.2
+uyp = 0.3
+print "original ux, uy:", uxp, "  ", uyp,"\n"
+
+cxp, cyp = DCL::g2fctr(uxp, uyp)
+print "transformed cx, cy:", cxp, "  ",  cyp,"\n"
+uxp, uyp = DCL::g2ictr(cxp, cyp)
+print "inverted ux, uy:", uxp, "  ",  uyp,"\n"
+print "(...Note that DCL uses single precision floats.)\n"

data/demo/math2/fftlib/fftl01.rb

@@ -0,0 +1,28 @@
+#
+# fftl01.rb
+#
+# $Id: fftl01.rb,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+
+N = 12
+NW = N/2
+NWS = 3*N+15
+
+rx = [0, 1, 2, 3, 4, 3, 2, 1, 0, -1, -2, -1].collect{|i| i.to_f}
+#rx = [0, 1, 2, 3, 2, 1, 0, -1, -2, -3, -2, -1].collect{|i| i.to_f}
+
+wsave = DCL::ezffti(N)
+printf " LIST OF RX : %s\n", "%5.1f"*N % rx
+a0, ak, bk = DCL::ezfftf(rx, wsave)
+printf " LIST OF CX : %8.3f%s\n", a0, "%8.3f"*NW % ak.to_a
+printf " LIST OF SX : %s%s\n", " "*8, "%8.3f"*NW % bk.to_a
+rx = DCL::ezfftb(a0, ak, bk, wsave)
+printf " LIST OF RX : %s\n", "%5.1f"*N % rx.to_a
+

data/demo/math2/fftlib/fftl02.rb

@@ -0,0 +1,224 @@
+#
+# fftl02.rb
+#
+# $Id: fftl02.rb,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+
+#-----------------------------------------------------------------------
+module Tfftp
+#
+#
+# PURPOSE                TO DEMONSTRATE THE USE OF FFTPACK, AND TO
+#                        TEST THE PERFORMANCE OF FFTPACK ON ONE
+#                        WELL-CONDITIONED PROBLEM.
+#
+# USAGE                  CALL TFFTPK (IERROR)
+#
+# ARGUMENTS
+#
+# ON OUTPUT              IERROR
+#                          INTEGER VARIABLE SET TO ZERO IF FFTPACK
+#                          CORRECTLY SOLVED THE TEST PROBLEM, AND
+#                          ONE IF FFTPACK FAILED.
+#
+# I/O                    IF THE TEST SUCCEEDS(FAILS), THE MESSAGE
+#
+#                           FFTPACK TEST SUCCESSFUL (UNSUCCESSFUL)
+#
+#                        IS WRITTEN ON UNIT 6. IN THE CASE OF FAILURE,
+#                        ADDITIONAL MESSAGES ARE WRITTEN IDENTIFYING THE
+#                        FAILURE MORE EXPLICITLY.
+#
+# PRECISION              SINGLE
+#
+# REQUIRED LIBRARY       NONE
+# FILES
+#
+# LANGUAGE               FORTRAN
+#
+# HISTORY                WRITTEN BY MEMBERS OF THE SCIENTIFIC
+#                        COMPUTING DIVISION OF NCAR,
+#                        BOULDER COLORADO.
+#
+# ALGORITHM              FOR EACH OF THE ROUTINES, RFFTF, RFFTB, EZFFTF,
+#                        AND EZFFTB IN THE FFTPACK PACKAGE A SIMILAR
+#                        TEST IS RUN. AN APPROPIATE VECTOR, FOR WHICH
+#                        THE EXACT TRANSFORM IS KNOWN IS USED AS THE
+#                        INPUT VECTOR. THE ROUTINE IS CALLED TO PERFORM
+#                        THE TRANSFORM. THE CALCULATED TRANSFORM VECTOR
+#                        IS COMPARED WITH THE EXACT TRANSFORM TO SEE
+#                        WHETHER THE PERFORMANCE CRITERION IS MET WITHIN
+#                        THE SPECIFED TOLERANCE.
+#
+#                        FOR RFFTF AND EZFFTF, A REAL VECTOR, THE ELEMEN
+#                        WHICH ARE EQUAL TO ONE, IS USED AS INPUT. THE
+#                        TRANSFORMED VECTOR HAS THE FIRST ELEMENT EQUAL
+#                        TO THE LENGTH OF THE INPUT VECTOR. ALL OTHER
+#                        ELEMENTS ARE EQUAL TO ZERO.
+#
+#                        FOR RFFTB AND EZFFTB, THE INPUT VECTOR HAS FIRS
+#                        ELEMENT EQUAL TO ONE AND ALL THE OTHER ELEMENTS
+#                        EQUAL TO ZERO. THE TRANSFORMED VECTOR HAS ALL
+#                        COMPONENTS EQUAL TO ONE.
+#
+# PORTABILITY            ANSI STANDARD
+#
+#
+  N = 36
+  DIM1 = 2*N+15
+  DIM2 = 3*N+15
+  ND2 = N/2
+  TOL = 0.01
+
+  M998  = " FFTPACK TEST SUCCESSFUL\n"
+  M999  = " FFTPACK TEST UNSUCCESSFUL\n"
+  M1001 = " IN FFTPACK, ENTRY RFFTF RESULTS IN ERROR\n"
+  M1002 = " IN FFTPACK, ENTRY RFFTB RESULTS IN ERROR\n"
+  M1003 = " IN FFTPACK, ENTRY EZFFTF RESULTS IN ERROR\n"
+  M1004 = " IN FFTPACK, ENTRY EZFFTB RESULTS IN ERROR\n"
+
+#  def stores(x)
+#
+# FORCES THE ARGUMENT VALUE X TO BE STORED IN MEMORY LOCATION V.
+#
+#    common /value/ v
+#    v=x
+#  end
+  def trunc(x)
+#
+# TRUNC IS A PORTABLE FORTRAN FUNCTION WHICH TRUNCATES A VALUE TO THE
+# MACHINE SINGLE PRECISION WORD SIZE, REGARDLESS OF WHETHER LONGER
+# PRECISION INTERNAL REGISTERS ARE USED FOR FLOATING POINT ARITHMETIC IN
+# COMPUTING THE VALUE INPUT TO TRUNC.  THE METHOD USED IS TO FORCE A
+# STORE INTO MEMORY BY USING A COMMON BLOCK IN ANOTHER SUBROUTINE.
+#
+#    common /value/ v
+#    stores(x)
+#    trunc=v
+    x.to_f  #????
+  end
+#
+# STATEMENT FUNCTION SMALL(EX) IS FOR TESTING WHETHER X IS CLOSE TO ZERO
+# INDEPENDENTLY OF MACHINE WORD SIZE. SMALL(EX) IS EXACTLY ZERO ONLY IF
+# ABS(X) .LT. EPS/TOL, WHERE EPS IS THE MACHINE PRECESION AND TOL IS A
+# TOLERANCE FACTOR USED TO CONTROL THE STRICTNESS OF THE TEST.
+#
+  def small(ex)
+    trunc(1.0+TOL*ex.abs)-1.0
+  end
+
+  def fft_test
+    rldat = NArray.sfloat(N)
+#
+# CALL INITIALIZATION ROUTINE FOR RFFTF AND RFFTB.
+#
+    wrfft = DCL::rffti(N)
+#
+# TEST OF RFFTF.
+#
+    rldat.fill!(1.0)
+#
+    result = DCL::rfftf(rldat, wrfft)
+#
+# TEST RESULTS OF RFFTF
+#
+    error = (N.to_f - result[0]).abs
+    for i in 1..N-1
+      error = [error, (result[i]).abs].max
+    end
+    if (small(error) == 0)
+      ier1 = 0
+    else
+      ier1 = 1
+      print M1001
+    end
+#
+# TEST OF RFFTB.
+#
+    rldat.fill!(0.0)
+    rldat[0] = 1.0
+#
+    result = DCL::rfftb(rldat, wrfft)
+#
+# TEST RESULTS OF RFFTB
+#
+    error = 0.0
+    for i in 0..N-1
+      error = [error, (1.0 - result[i]).abs].max
+    end
+    if (small(error) == 0)
+      ier2 = 0
+    else
+      ier2 = 1
+      print M1002
+    end
+#
+# CALL INITIALIZATION ROUTINE EZFFTI FOR EZFFTF AND EZFFTB
+#
+    wezfft = DCL::ezffti(N)
+#
+# TEST OF EZFFTF.
+#
+    rldat.fill!(1.0)
+#
+#
+    azero, a, b = DCL::ezfftf(rldat, wezfft)
+#
+# TEST RESULTS OF EZFFTF
+#
+    error = (azero - 1.0).abs
+    for i in 0..ND2-1
+      error = [(a[i]).abs + (b[i]).abs, error].max
+    end
+    if (small(error) == 0)
+      ier3 = 0
+    else
+      ier3 = 1
+      print M1003
+    end
+#
+# TEST OF EZFFTB.
+#
+    azero = 1.0
+    a[0..ND2-1] = 0.0
+    b[0..ND2-1] = 0.0
+#
+    result = DCL::ezfftb(azero, a, b, wezfft)
+#
+# TEST RESULTS OF EZFFTB
+#
+    error = 0.0
+    for i in 0..N-1
+      error = [(1.0 - result[i]).abs, error].max
+    end
+    if (small(error) == 0)
+      ier4 = 0
+    else
+      ier4 = 1
+      print M1004
+    end
+#
+#
+    ierror = ier1 + ier2 + ier3 + ier4
+    if (ierror == 0)
+      print M998
+    else
+      ierror = 1
+      print M999
+    end
+    ierror
+  end
+end
+
+
+include Tfftp
+
+ier = Tfftp::fft_test
+

data/demo/math2/intrlib/intr01.rb

@@ -0,0 +1,22 @@
+#
+# intr01.rb
+#
+# $Id: intr01.rb,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+#
+
+require "narray"
+require "numru/dcl"
+
+include NumRu
+include Math
+
+
+N = 12
+
+rx = [0, 1, 2, 999, 4, 3, 999, 999, 0, -1, -2, 999].collect{|i| i.to_f}
+
+printf " LIST OF RX : %s\n", "%5.0f"*N % rx.to_a
+rx = DCL::vrintr(rx, N, 1)
+print " AFTER CALLING VRINTR(RX,12,1)\n"
+printf " LIST OF RX : %s\n", "%5.0f"*N % rx.to_a
+