ruby-dcl 1.6.2
Sign up to get free protection for your applications and to get access to all the features.
- data/ChangeLog +321 -0
- data/GenWrapper/Makefile +14 -0
- data/GenWrapper/cproto2init.rb +41 -0
- data/GenWrapper/dcl_narrayed_funcs.rb +181 -0
- data/GenWrapper/dcl_rb_footing +29 -0
- data/GenWrapper/dcl_rb_heading +129 -0
- data/GenWrapper/def.rb +20 -0
- data/GenWrapper/elim_ary_size.rb +398 -0
- data/GenWrapper/etc/Mk_proto +375 -0
- data/GenWrapper/etc/dcl_gen +13 -0
- data/GenWrapper/etc/p_header +63 -0
- data/GenWrapper/etc/p_init +410 -0
- data/GenWrapper/pparse.rb +137 -0
- data/GenWrapper/proto/Makefile +35 -0
- data/GenWrapper/proto/grph1_00 +17 -0
- data/GenWrapper/proto/grph1_csgi.fp +27 -0
- data/GenWrapper/proto/grph1_scpack.fp +442 -0
- data/GenWrapper/proto/grph1_sgpack.fp +1406 -0
- data/GenWrapper/proto/grph1_slpack.fp +316 -0
- data/GenWrapper/proto/grph1_stpack.fp +411 -0
- data/GenWrapper/proto/grph1_swpack.fp +746 -0
- data/GenWrapper/proto/grph2_00 +16 -0
- data/GenWrapper/proto/grph2_grpack.fp +139 -0
- data/GenWrapper/proto/grph2_ucpack.fp +522 -0
- data/GenWrapper/proto/grph2_udpack.fp +692 -0
- data/GenWrapper/proto/grph2_uepack.fp +601 -0
- data/GenWrapper/proto/grph2_ugpack.fp +436 -0
- data/GenWrapper/proto/grph2_uhpack.fp +246 -0
- data/GenWrapper/proto/grph2_ulpack.fp +516 -0
- data/GenWrapper/proto/grph2_umpack.fp +676 -0
- data/GenWrapper/proto/grph2_uspack.fp +989 -0
- data/GenWrapper/proto/grph2_uupack.fp +663 -0
- data/GenWrapper/proto/grph2_uvpack.fp +246 -0
- data/GenWrapper/proto/grph2_uwpack.fp +203 -0
- data/GenWrapper/proto/grph2_uxpack.fp +295 -0
- data/GenWrapper/proto/grph2_uypack.fp +295 -0
- data/GenWrapper/proto/grph2_uzpack.fp +574 -0
- data/GenWrapper/proto/math1_00 +12 -0
- data/GenWrapper/proto/math1_blklib.fp +58 -0
- data/GenWrapper/proto/math1_chrlib.fp +83 -0
- data/GenWrapper/proto/math1_fnclib.fp +79 -0
- data/GenWrapper/proto/math1_gnmlib.fp +118 -0
- data/GenWrapper/proto/math1_gt2dlib.fp +144 -0
- data/GenWrapper/proto/math1_ifalib.fp +123 -0
- data/GenWrapper/proto/math1_indxlib.fp +222 -0
- data/GenWrapper/proto/math1_intlib.fp +46 -0
- data/GenWrapper/proto/math1_lrllib.fp +276 -0
- data/GenWrapper/proto/math1_maplib.fp +24 -0
- data/GenWrapper/proto/math1_oslib.fp +28 -0
- data/GenWrapper/proto/math1_rfalib.fp +420 -0
- data/GenWrapper/proto/math1_rfblib.fp +51 -0
- data/GenWrapper/proto/math1_sublib.fp +60 -0
- data/GenWrapper/proto/math1_syslib.fp +767 -0
- data/GenWrapper/proto/math1_vialib.fp +339 -0
- data/GenWrapper/proto/math1_viblib.fp +264 -0
- data/GenWrapper/proto/math1_vralib.fp +339 -0
- data/GenWrapper/proto/math1_vrblib.fp +264 -0
- data/GenWrapper/proto/math1_xfclib.fp +68 -0
- data/GenWrapper/proto/math2_00 +12 -0
- data/GenWrapper/proto/math2_fftlib.fp +803 -0
- data/GenWrapper/proto/math2_intrlib.fp +32 -0
- data/GenWrapper/proto/math2_odelib.fp_notused +568 -0
- data/GenWrapper/proto/math2_rnmlib.fp +54 -0
- data/GenWrapper/proto/math2_shtlib.fp +1292 -0
- data/GenWrapper/proto/math2_shtlib.fp_old +1294 -0
- data/GenWrapper/proto/math2_vstlib.fp +84 -0
- data/GenWrapper/proto/misc1_00 +17 -0
- data/GenWrapper/proto/misc1_chnlib.fp +47 -0
- data/GenWrapper/proto/misc1_datelib.fp +352 -0
- data/GenWrapper/proto/misc1_fmtlib.fp +19 -0
- data/GenWrapper/proto/misc1_misclib.fp +26 -0
- data/GenWrapper/proto/misc1_randlib.fp +36 -0
- data/GenWrapper/proto/misc1_timelib.fp +151 -0
- data/GenWrapper/proto2c.rb +13 -0
- data/GenWrapper/prototype.rb +209 -0
- data/GenWrapper/util.rb +9 -0
- data/GenWrapper/variable.rb +671 -0
- data/README +29 -0
- data/Rakefile +44 -0
- data/ToDo +2 -0
- data/dcl_cary2obj.c +354 -0
- data/dcl_narrayed_funcs.c +518 -0
- data/dcl_obj2cary.c +512 -0
- data/dcl_rubydcloriginal.c +129 -0
- data/demo/gokuraku/hop/hop.rb +26 -0
- data/demo/gokuraku/jump/jump1.rb +64 -0
- data/demo/gokuraku/jump/jump2.rb +50 -0
- data/demo/gokuraku/layout/lay1.rb +46 -0
- data/demo/gokuraku/layout/lay2.rb +44 -0
- data/demo/gokuraku/step/step0.rb +34 -0
- data/demo/gokuraku/step/step1.rb +84 -0
- data/demo/gokuraku/step/step2.rb +62 -0
- data/demo/gokuraku/u1d/u1d1.rb +37 -0
- data/demo/gokuraku/u1d/u1d2.rb +50 -0
- data/demo/gokuraku/u2d/u2d1.rb +46 -0
- data/demo/gokuraku/u2d/u2d2.rb +49 -0
- data/demo/gokuraku/u2d/u2d3.rb +45 -0
- data/demo/gokuraku/u2d/u2d4.rb +61 -0
- data/demo/grph1/scpack/scpkt2.rb +40 -0
- data/demo/grph1/scpack/scpkt3.rb +102 -0
- data/demo/grph1/scpack/scpkt6.rb +84 -0
- data/demo/grph1/scpack/scpkt7.rb +59 -0
- data/demo/grph1/scpack/scpkt8.rb +60 -0
- data/demo/grph1/scpack/t810630.dat +296 -0
- data/demo/grph1/scpack/t811231.dat +296 -0
- data/demo/grph1/sgpack/sgfont.rb +52 -0
- data/demo/grph1/sgpack/sgfonz.rb +53 -0
- data/demo/grph1/sgpack/sgksx1.rb +44 -0
- data/demo/grph1/sgpack/sgksx2.rb +90 -0
- data/demo/grph1/sgpack/sgksx3.rb +75 -0
- data/demo/grph1/sgpack/sglidx.rb +40 -0
- data/demo/grph1/sgpack/sgltyp.rb +48 -0
- data/demo/grph1/sgpack/sgpk01.rb +39 -0
- data/demo/grph1/sgpack/sgpk02.rb +79 -0
- data/demo/grph1/sgpack/sgpk03.rb +107 -0
- data/demo/grph1/sgpack/sgpk04.rb +86 -0
- data/demo/grph1/sgpack/sgpk05.rb +66 -0
- data/demo/grph1/sgpack/sgpk06.rb +91 -0
- data/demo/grph1/sgpack/sgpk07.rb +66 -0
- data/demo/grph1/sgpack/sgpk08.rb +67 -0
- data/demo/grph1/sgpack/sgpk09.rb +61 -0
- data/demo/grph1/sgpack/sgpk10.rb +58 -0
- data/demo/grph1/sgpack/sgtclr.rb +59 -0
- data/demo/grph1/sgpack/sgtone.rb +70 -0
- data/demo/grph1/sgpack/sgtonz.rb +66 -0
- data/demo/grph1/slpack/slpk01.rb +37 -0
- data/demo/grph1/slpack/slpk02.rb +29 -0
- data/demo/grph1/slpack/slpk03.rb +36 -0
- data/demo/grph1/slpack/slpk04.rb +36 -0
- data/demo/grph2/g2pack/g2pk01.rb +78 -0
- data/demo/grph2/g2pack/g2pk02.rb +75 -0
- data/demo/grph2/grpack/grpk01.rb +65 -0
- data/demo/grph2/ucpack/ucpk01.rb +95 -0
- data/demo/grph2/ucpack/ucpk02.rb +95 -0
- data/demo/grph2/udegpk/u2df01.rb +50 -0
- data/demo/grph2/udegpk/u2df02.rb +76 -0
- data/demo/grph2/udegpk/u2df03.rb +80 -0
- data/demo/grph2/udegpk/u2df04.rb +52 -0
- data/demo/grph2/udegpk/u2df05.rb +70 -0
- data/demo/grph2/udegpk/u2df06.rb +59 -0
- data/demo/grph2/udegpk/u2df07.rb +68 -0
- data/demo/grph2/udegpk/u2df08.rb +91 -0
- data/demo/grph2/udegpk/u2df09b.rb +88 -0
- data/demo/grph2/udegpk/u2df09c.rb +89 -0
- data/demo/grph2/udegpk/u2df09e.rb +88 -0
- data/demo/grph2/udegpk/u2df09f.rb +89 -0
- data/demo/grph2/ulpack/ulpk01.rb +111 -0
- data/demo/grph2/ulpack/ulpk01n.rb +111 -0
- data/demo/grph2/ulpack/ulpk02.rb +111 -0
- data/demo/grph2/ulpack/ulpk02n.rb +111 -0
- data/demo/grph2/umpack/t811231.dat +296 -0
- data/demo/grph2/umpack/test01.rb +69 -0
- data/demo/grph2/umpack/test02.rb +64 -0
- data/demo/grph2/umpack/test03.rb +84 -0
- data/demo/grph2/umpack/test04.rb +54 -0
- data/demo/grph2/umpack/test05.rb +85 -0
- data/demo/grph2/umpack/test06.rb +44 -0
- data/demo/grph2/umpack/test07.rb +43 -0
- data/demo/grph2/umpack/test08.rb +37 -0
- data/demo/grph2/umpack/test09.rb +86 -0
- data/demo/grph2/umpack/test10.rb +52 -0
- data/demo/grph2/umpack/umpk01.rb +65 -0
- data/demo/grph2/umpack/umpk02.rb +54 -0
- data/demo/grph2/umpack/umpk03.rb +46 -0
- data/demo/grph2/umpack/umpk04.rb +65 -0
- data/demo/grph2/umpack/umpk05.rb +84 -0
- data/demo/grph2/uspack/uspk01.rb +39 -0
- data/demo/grph2/uspack/uspk02.rb +47 -0
- data/demo/grph2/uspack/uspk03.rb +38 -0
- data/demo/grph2/uspack/uspk04.rb +64 -0
- data/demo/grph2/uspack/uspk05.rb +68 -0
- data/demo/grph2/uspack/uspk06.rb +43 -0
- data/demo/grph2/uspack/uspk07.rb +62 -0
- data/demo/grph2/uspack/uspk08.rb +46 -0
- data/demo/grph2/uspack/uspk09.rb +89 -0
- data/demo/grph2/uspack/uspk10.rb +48 -0
- data/demo/grph2/uspack/uspk11.rb +71 -0
- data/demo/grph2/uspack/uspk12.rb +51 -0
- data/demo/grph2/uupack/uupk01.rb +50 -0
- data/demo/grph2/uupack/uupk02.rb +74 -0
- data/demo/grph2/uupack/uupk03.rb +56 -0
- data/demo/grph2/uupack/uupk04.rb +84 -0
- data/demo/grph2/uupack/uupk05.rb +74 -0
- data/demo/grph2/uupack/uupk06.rb +77 -0
- data/demo/grph2/uupack/uupk07.rb +88 -0
- data/demo/grph2/uxyzpk/uxyz01.rb +38 -0
- data/demo/grph2/uxyzpk/uxyz02.rb +36 -0
- data/demo/grph2/uxyzpk/uxyz03.rb +37 -0
- data/demo/grph2/uxyzpk/uxyz04.rb +54 -0
- data/demo/grph2/uxyzpk/uxyz05.rb +41 -0
- data/demo/grph2/uxyzpk/uxyz06.rb +42 -0
- data/demo/grph2/uxyzpk/uxyz07.rb +38 -0
- data/demo/grph2/uxyzpk/uxyz08.rb +60 -0
- data/demo/grph2/uxyzpk/uxyz09.rb +52 -0
- data/demo/grph2/uxyzpk/uxyz10.rb +57 -0
- data/demo/grph2/ximage/MEMO +23 -0
- data/demo/grph2/ximage/tomsclm.dat +1344 -0
- data/demo/grph2/ximage/ximg01.rb +145 -0
- data/demo/math1/gt2dlib/gt2d01.rb +33 -0
- data/demo/math2/fftlib/fftl01.rb +28 -0
- data/demo/math2/fftlib/fftl02.rb +224 -0
- data/demo/math2/intrlib/intr01.rb +22 -0
- data/demo/math2/rnmlib/rnml01.rb +21 -0
- data/demo/math2/vstlib/vstl01.rb +29 -0
- data/demo/math2/vstlib/vstl02.rb +38 -0
- data/demo/rakuraku/color/color1.rb +61 -0
- data/demo/rakuraku/color/color2.rb +57 -0
- data/demo/rakuraku/color/color3.rb +81 -0
- data/demo/rakuraku/kihon/kihon1.rb +39 -0
- data/demo/rakuraku/kihon/kihon2.rb +56 -0
- data/demo/rakuraku/kihon/kihon3.rb +57 -0
- data/demo/rakuraku/kihon/kihon4.rb +70 -0
- data/demo/rakuraku/kihon/kihon5.rb +56 -0
- data/demo/rakuraku/kihon/kihon6.rb +40 -0
- data/demo/rakuraku/kihon/kihon7.rb +98 -0
- data/demo/rakuraku/kihon/kihon8.rb +93 -0
- data/demo/rakuraku/kihon/kihon9.rb +77 -0
- data/demo/rakuraku/kihon/kihona.rb +123 -0
- data/demo/rakuraku/kihon/kihonb.rb +73 -0
- data/demo/rakuraku/kihon/kihonc.rb +110 -0
- data/demo/rakuraku/layout/lay1.rb +29 -0
- data/demo/rakuraku/layout/lay2.rb +28 -0
- data/demo/rakuraku/layout/lay3.rb +29 -0
- data/demo/rakuraku/map3d/map3d1.rb +68 -0
- data/demo/rakuraku/map3d/map3d2.rb +67 -0
- data/demo/rakuraku/map3d/map3d3.rb +66 -0
- data/demo/rakuraku/map3d/map3d4.rb +107 -0
- data/demo/rakuraku/map3d/map3d5.rb +118 -0
- data/demo/rakuraku/map3d/map3d6.rb +96 -0
- data/demo/rakuraku/map3d/map3d7.rb +98 -0
- data/demo/rakuraku/miss/miss1.rb +76 -0
- data/demo/rakuraku/miss/miss2.rb +60 -0
- data/demo/rakuraku/quick/quick1.rb +35 -0
- data/demo/rakuraku/quick/quick2.rb +33 -0
- data/demo/rakuraku/quick/quick3.rb +46 -0
- data/demo/rakuraku/quick/quick4.rb +47 -0
- data/demo/rakuraku/quick/quick5.rb +46 -0
- data/demo/rakuraku/u2d/u2d1.rb +50 -0
- data/demo/rakuraku/u2d/u2d2.rb +51 -0
- data/demo/rakuraku/u2d/u2d3.rb +70 -0
- data/demo/rakuraku/u2d/u2d4.rb +59 -0
- data/demo/rakuraku/u2d/u2d5.rb +61 -0
- data/demo/rakuraku/u2d/u2d6.rb +57 -0
- data/demo/rakuraku/u2d/u2d7.rb +103 -0
- data/demo/rakuraku/uspack/uspac1.rb +35 -0
- data/demo/rakuraku/uspack/uspac2.rb +66 -0
- data/demo/rakuraku/uspack/uspac3.rb +37 -0
- data/demo/rakuraku/uspack/uspac4.rb +49 -0
- data/demo/rakuraku/uxyz/uxyz1.rb +37 -0
- data/demo/rakuraku/uxyz/uxyz2.rb +35 -0
- data/demo/rakuraku/uxyz/uxyz3.rb +38 -0
- data/demo/rakuraku/uxyz/uxyz4.rb +36 -0
- data/demo/rakuraku/uxyz/uxyz5.rb +57 -0
- data/demo/rakuraku/uxyz/uxyz6.rb +43 -0
- data/demo/rakuraku/uxyz/uxyz7.rb +39 -0
- data/demo/rakuraku/uxyz/uxyz8.rb +56 -0
- data/demo/rubydcloriginal/uemrkz1.rb +37 -0
- data/dummy.c +9 -0
- data/extconf.rb +133 -0
- data/grph1_csgi.c +119 -0
- data/grph1_scpack.c +1388 -0
- data/grph1_sgpack.c +3876 -0
- data/grph1_slpack.c +432 -0
- data/grph1_stpack.c +1044 -0
- data/grph1_swpack.c +1922 -0
- data/grph1_zgpack.c.org +141 -0
- data/grph2_grpack.c +368 -0
- data/grph2_ucpack.c +1232 -0
- data/grph2_udpack.c +1404 -0
- data/grph2_uepack.c +1443 -0
- data/grph2_ugpack.c +1073 -0
- data/grph2_uhpack.c +943 -0
- data/grph2_ulpack.c +1304 -0
- data/grph2_umpack.c +1540 -0
- data/grph2_uspack.c +2481 -0
- data/grph2_uupack.c +1689 -0
- data/grph2_uvpack.c +943 -0
- data/grph2_uwpack.c +552 -0
- data/grph2_uxpack.c +555 -0
- data/grph2_uypack.c +555 -0
- data/grph2_uzpack.c +1455 -0
- data/init.c.default +187 -0
- data/init.c.gtk +189 -0
- data/lib/dcl.rb +5084 -0
- data/math1_blklib.c +227 -0
- data/math1_chrlib.c +239 -0
- data/math1_fnclib.c +254 -0
- data/math1_gnmlib.c +356 -0
- data/math1_gt2dlib.c +514 -0
- data/math1_ifalib.c +427 -0
- data/math1_indxlib.c +709 -0
- data/math1_intlib.c +167 -0
- data/math1_lrllib.c +817 -0
- data/math1_maplib.c +172 -0
- data/math1_oslib.c +111 -0
- data/math1_rfalib.c +1417 -0
- data/math1_rfblib.c +232 -0
- data/math1_sublib.c +221 -0
- data/math1_syslib.c +2025 -0
- data/math1_vialib.c +1156 -0
- data/math1_viblib.c +1027 -0
- data/math1_vralib.c +1156 -0
- data/math1_vrblib.c +1027 -0
- data/math1_xfclib.c +142 -0
- data/math2_fftlib.c +833 -0
- data/math2_intrlib.c +138 -0
- data/math2_rnmlib.c +226 -0
- data/math2_shtlib.c +1568 -0
- data/math2_vstlib.c +366 -0
- data/misc1_chnlib.c +179 -0
- data/misc1_datelib.c +953 -0
- data/misc1_fmtlib.c +99 -0
- data/misc1_misclib.c +118 -0
- data/misc1_randlib.c +142 -0
- data/misc1_timelib.c +380 -0
- data/obsolete/README +2 -0
- data/obsolete/dcl_ext.html +112 -0
- data/obsolete/dcl_ext.rb +313 -0
- metadata +433 -0
data/math1_xfclib.c
ADDED
@@ -0,0 +1,142 @@
|
|
1
|
+
/*
|
2
|
+
* $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
|
3
|
+
*/
|
4
|
+
|
5
|
+
#include <stdio.h>
|
6
|
+
#include "ruby.h"
|
7
|
+
#include "libtinyf2c.h"
|
8
|
+
#include "narray.h"
|
9
|
+
|
10
|
+
/* for compatibility with ruby 1.6 */
|
11
|
+
#ifndef StringValuePtr
|
12
|
+
#define StringValuePtr(s) STR2CSTR(s)
|
13
|
+
#endif
|
14
|
+
|
15
|
+
#define DFLT_SIZE 32
|
16
|
+
|
17
|
+
extern char *dcl_obj2ccharary(VALUE, int, int);
|
18
|
+
extern integer *dcl_obj2cintegerary(VALUE);
|
19
|
+
extern real *dcl_obj2crealary(VALUE);
|
20
|
+
extern complex *dcl_obj2ccomplexary(VALUE);
|
21
|
+
extern logical *dcl_obj2clogicalary(VALUE);
|
22
|
+
|
23
|
+
extern VALUE dcl_ccharary2obj(char *, int, int);
|
24
|
+
extern VALUE dcl_cintegerary2obj(integer *, int, int, int *);
|
25
|
+
extern VALUE dcl_crealary2obj(real *, int, int, int *);
|
26
|
+
extern VALUE dcl_ccomplexary2obj(complex *, int, char *);
|
27
|
+
extern VALUE dcl_clogicalary2obj(logical *, int, int, int *);
|
28
|
+
|
29
|
+
extern void dcl_freeccharary(char *);
|
30
|
+
extern void dcl_freecintegerary(integer *);
|
31
|
+
extern void dcl_freecrealary(real *);
|
32
|
+
extern void dcl_freeccomplexary(complex *);
|
33
|
+
extern void dcl_freeclogicalary(logical *);
|
34
|
+
|
35
|
+
/* for functions which return real */
|
36
|
+
/* fnclib */
|
37
|
+
extern real rd2r_(real *);
|
38
|
+
extern real rr2d_(real *);
|
39
|
+
extern real rexp_(real *, integer *, integer *);
|
40
|
+
extern real rfpi_(void);
|
41
|
+
extern real rmod_(real *, real *);
|
42
|
+
/* gnmlib */
|
43
|
+
extern real rgnlt_(real *);
|
44
|
+
extern real rgnle_(real *);
|
45
|
+
extern real rgngt_(real *);
|
46
|
+
extern real rgnge_(real *);
|
47
|
+
/* rfalib */
|
48
|
+
extern real rmax_(real *, integer *, integer *);
|
49
|
+
extern real rmin_(real *, integer *, integer *);
|
50
|
+
extern real rsum_(real *, integer *, integer *);
|
51
|
+
extern real rave_(real *, integer *, integer *);
|
52
|
+
extern real rvar_(real *, integer *, integer *);
|
53
|
+
extern real rstd_(real *, integer *, integer *);
|
54
|
+
extern real rrms_(real *, integer *, integer *);
|
55
|
+
extern real ramp_(real *, integer *, integer *);
|
56
|
+
/* rfblib */
|
57
|
+
extern real rprd_(real *, real *, integer *, integer *, integer *);
|
58
|
+
extern real rcov_(real *, real *, integer *, integer *, integer *);
|
59
|
+
extern real rcor_(real *, real *, integer *, integer *, integer *);
|
60
|
+
|
61
|
+
|
62
|
+
extern VALUE mDCL;
|
63
|
+
|
64
|
+
static VALUE
|
65
|
+
dcl_ifromc(obj, cx)
|
66
|
+
VALUE obj, cx;
|
67
|
+
{
|
68
|
+
char *i_cx;
|
69
|
+
integer o_rtn_val;
|
70
|
+
VALUE rtn_val;
|
71
|
+
|
72
|
+
if (TYPE(cx) != T_STRING) {
|
73
|
+
cx = rb_funcall(cx, rb_intern("to_str"), 0);
|
74
|
+
}
|
75
|
+
|
76
|
+
i_cx = StringValuePtr(cx);
|
77
|
+
|
78
|
+
|
79
|
+
o_rtn_val = ifromc_(i_cx, (ftnlen)strlen(i_cx));
|
80
|
+
|
81
|
+
rtn_val = INT2NUM(o_rtn_val);
|
82
|
+
|
83
|
+
|
84
|
+
return rtn_val;
|
85
|
+
|
86
|
+
}
|
87
|
+
|
88
|
+
static VALUE
|
89
|
+
dcl_lfromc(obj, cx)
|
90
|
+
VALUE obj, cx;
|
91
|
+
{
|
92
|
+
char *i_cx;
|
93
|
+
logical o_rtn_val;
|
94
|
+
VALUE rtn_val;
|
95
|
+
|
96
|
+
if (TYPE(cx) != T_STRING) {
|
97
|
+
cx = rb_funcall(cx, rb_intern("to_str"), 0);
|
98
|
+
}
|
99
|
+
|
100
|
+
i_cx = StringValuePtr(cx);
|
101
|
+
|
102
|
+
|
103
|
+
o_rtn_val = lfromc_(i_cx, (ftnlen)strlen(i_cx));
|
104
|
+
|
105
|
+
rtn_val = (o_rtn_val == FALSE_) ? Qfalse : Qtrue;
|
106
|
+
|
107
|
+
|
108
|
+
return rtn_val;
|
109
|
+
|
110
|
+
}
|
111
|
+
|
112
|
+
static VALUE
|
113
|
+
dcl_rfromc(obj, cx)
|
114
|
+
VALUE obj, cx;
|
115
|
+
{
|
116
|
+
char *i_cx;
|
117
|
+
real o_rtn_val;
|
118
|
+
VALUE rtn_val;
|
119
|
+
|
120
|
+
if (TYPE(cx) != T_STRING) {
|
121
|
+
cx = rb_funcall(cx, rb_intern("to_str"), 0);
|
122
|
+
}
|
123
|
+
|
124
|
+
i_cx = StringValuePtr(cx);
|
125
|
+
|
126
|
+
|
127
|
+
o_rtn_val = rfromc_(i_cx, (ftnlen)strlen(i_cx));
|
128
|
+
|
129
|
+
rtn_val = rb_float_new((double)o_rtn_val);
|
130
|
+
|
131
|
+
|
132
|
+
return rtn_val;
|
133
|
+
|
134
|
+
}
|
135
|
+
void
|
136
|
+
init_math1_xfclib(mDCL)
|
137
|
+
VALUE mDCL;
|
138
|
+
{
|
139
|
+
rb_define_module_function(mDCL, "ifromc", dcl_ifromc, 1);
|
140
|
+
rb_define_module_function(mDCL, "lfromc", dcl_lfromc, 1);
|
141
|
+
rb_define_module_function(mDCL, "rfromc", dcl_rfromc, 1);
|
142
|
+
}
|
data/math2_fftlib.c
ADDED
@@ -0,0 +1,833 @@
|
|
1
|
+
/*
|
2
|
+
* $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
|
3
|
+
*/
|
4
|
+
|
5
|
+
#include <stdio.h>
|
6
|
+
#include "ruby.h"
|
7
|
+
#include "libtinyf2c.h"
|
8
|
+
#include "narray.h"
|
9
|
+
|
10
|
+
/* for compatibility with ruby 1.6 */
|
11
|
+
#ifndef StringValuePtr
|
12
|
+
#define StringValuePtr(s) STR2CSTR(s)
|
13
|
+
#endif
|
14
|
+
|
15
|
+
#define DFLT_SIZE 32
|
16
|
+
|
17
|
+
extern char *dcl_obj2ccharary(VALUE, int, int);
|
18
|
+
extern integer *dcl_obj2cintegerary(VALUE);
|
19
|
+
extern real *dcl_obj2crealary(VALUE);
|
20
|
+
extern complex *dcl_obj2ccomplexary(VALUE);
|
21
|
+
extern logical *dcl_obj2clogicalary(VALUE);
|
22
|
+
|
23
|
+
extern VALUE dcl_ccharary2obj(char *, int, int);
|
24
|
+
extern VALUE dcl_cintegerary2obj(integer *, int, int, int *);
|
25
|
+
extern VALUE dcl_crealary2obj(real *, int, int, int *);
|
26
|
+
extern VALUE dcl_ccomplexary2obj(complex *, int, char *);
|
27
|
+
extern VALUE dcl_clogicalary2obj(logical *, int, int, int *);
|
28
|
+
|
29
|
+
extern void dcl_freeccharary(char *);
|
30
|
+
extern void dcl_freecintegerary(integer *);
|
31
|
+
extern void dcl_freecrealary(real *);
|
32
|
+
extern void dcl_freeccomplexary(complex *);
|
33
|
+
extern void dcl_freeclogicalary(logical *);
|
34
|
+
|
35
|
+
/* for functions which return real */
|
36
|
+
/* fnclib */
|
37
|
+
extern real rd2r_(real *);
|
38
|
+
extern real rr2d_(real *);
|
39
|
+
extern real rexp_(real *, integer *, integer *);
|
40
|
+
extern real rfpi_(void);
|
41
|
+
extern real rmod_(real *, real *);
|
42
|
+
/* gnmlib */
|
43
|
+
extern real rgnlt_(real *);
|
44
|
+
extern real rgnle_(real *);
|
45
|
+
extern real rgngt_(real *);
|
46
|
+
extern real rgnge_(real *);
|
47
|
+
/* rfalib */
|
48
|
+
extern real rmax_(real *, integer *, integer *);
|
49
|
+
extern real rmin_(real *, integer *, integer *);
|
50
|
+
extern real rsum_(real *, integer *, integer *);
|
51
|
+
extern real rave_(real *, integer *, integer *);
|
52
|
+
extern real rvar_(real *, integer *, integer *);
|
53
|
+
extern real rstd_(real *, integer *, integer *);
|
54
|
+
extern real rrms_(real *, integer *, integer *);
|
55
|
+
extern real ramp_(real *, integer *, integer *);
|
56
|
+
/* rfblib */
|
57
|
+
extern real rprd_(real *, real *, integer *, integer *, integer *);
|
58
|
+
extern real rcov_(real *, real *, integer *, integer *, integer *);
|
59
|
+
extern real rcor_(real *, real *, integer *, integer *, integer *);
|
60
|
+
|
61
|
+
|
62
|
+
extern VALUE mDCL;
|
63
|
+
|
64
|
+
static VALUE
|
65
|
+
dcl_cfftb(obj, n, c, wsave)
|
66
|
+
VALUE obj, n, c, wsave;
|
67
|
+
{
|
68
|
+
integer i_n;
|
69
|
+
real *io_c;
|
70
|
+
real *i_wsave;
|
71
|
+
|
72
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
73
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
74
|
+
}
|
75
|
+
if (TYPE(c) == T_FLOAT) {
|
76
|
+
c = rb_Array(c);
|
77
|
+
}
|
78
|
+
/* if ((TYPE(c) != T_ARRAY) &&
|
79
|
+
(rb_obj_is_kind_of(c, cNArray) != Qtrue)) {
|
80
|
+
rb_raise(rb_eTypeError, "invalid type");
|
81
|
+
} -- no check since obj2c*ary will do that */
|
82
|
+
if (TYPE(wsave) == T_FLOAT) {
|
83
|
+
wsave = rb_Array(wsave);
|
84
|
+
}
|
85
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
86
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
87
|
+
rb_raise(rb_eTypeError, "invalid type");
|
88
|
+
} -- no check since obj2c*ary will do that */
|
89
|
+
|
90
|
+
i_n = NUM2INT(n);
|
91
|
+
io_c = dcl_obj2crealary(c);
|
92
|
+
i_wsave = dcl_obj2crealary(wsave);
|
93
|
+
|
94
|
+
|
95
|
+
cfftb_(&i_n, io_c, i_wsave);
|
96
|
+
|
97
|
+
{int array_shape[1] = {2*i_n};
|
98
|
+
c = dcl_crealary2obj(io_c, (2*i_n), 1, array_shape);
|
99
|
+
}
|
100
|
+
|
101
|
+
dcl_freecrealary(io_c);
|
102
|
+
dcl_freecrealary(i_wsave);
|
103
|
+
|
104
|
+
return c;
|
105
|
+
|
106
|
+
}
|
107
|
+
|
108
|
+
static VALUE
|
109
|
+
dcl_cfftf(obj, n, c, wsave)
|
110
|
+
VALUE obj, n, c, wsave;
|
111
|
+
{
|
112
|
+
integer i_n;
|
113
|
+
real *io_c;
|
114
|
+
real *i_wsave;
|
115
|
+
|
116
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
117
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
118
|
+
}
|
119
|
+
if (TYPE(c) == T_FLOAT) {
|
120
|
+
c = rb_Array(c);
|
121
|
+
}
|
122
|
+
/* if ((TYPE(c) != T_ARRAY) &&
|
123
|
+
(rb_obj_is_kind_of(c, cNArray) != Qtrue)) {
|
124
|
+
rb_raise(rb_eTypeError, "invalid type");
|
125
|
+
} -- no check since obj2c*ary will do that */
|
126
|
+
if (TYPE(wsave) == T_FLOAT) {
|
127
|
+
wsave = rb_Array(wsave);
|
128
|
+
}
|
129
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
130
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
131
|
+
rb_raise(rb_eTypeError, "invalid type");
|
132
|
+
} -- no check since obj2c*ary will do that */
|
133
|
+
|
134
|
+
i_n = NUM2INT(n);
|
135
|
+
io_c = dcl_obj2crealary(c);
|
136
|
+
i_wsave = dcl_obj2crealary(wsave);
|
137
|
+
|
138
|
+
|
139
|
+
cfftf_(&i_n, io_c, i_wsave);
|
140
|
+
|
141
|
+
{int array_shape[1] = {2*i_n};
|
142
|
+
c = dcl_crealary2obj(io_c, (2*i_n), 1, array_shape);
|
143
|
+
}
|
144
|
+
|
145
|
+
dcl_freecrealary(io_c);
|
146
|
+
dcl_freecrealary(i_wsave);
|
147
|
+
|
148
|
+
return c;
|
149
|
+
|
150
|
+
}
|
151
|
+
|
152
|
+
static VALUE
|
153
|
+
dcl_cffti(obj, n)
|
154
|
+
VALUE obj, n;
|
155
|
+
{
|
156
|
+
integer i_n;
|
157
|
+
real *o_wsave;
|
158
|
+
VALUE wsave;
|
159
|
+
|
160
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
161
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
162
|
+
}
|
163
|
+
|
164
|
+
i_n = NUM2INT(n);
|
165
|
+
|
166
|
+
o_wsave= ALLOCA_N(real, (4*i_n+15));
|
167
|
+
|
168
|
+
cffti_(&i_n, o_wsave);
|
169
|
+
|
170
|
+
{int array_shape[1] = {4*i_n+15};
|
171
|
+
wsave = dcl_crealary2obj(o_wsave, (4*i_n+15), 1, array_shape);
|
172
|
+
}
|
173
|
+
|
174
|
+
|
175
|
+
return wsave;
|
176
|
+
|
177
|
+
}
|
178
|
+
|
179
|
+
static VALUE
|
180
|
+
dcl_cosqb(obj, n, x, wsave)
|
181
|
+
VALUE obj, n, x, wsave;
|
182
|
+
{
|
183
|
+
integer i_n;
|
184
|
+
real *io_x;
|
185
|
+
real *i_wsave;
|
186
|
+
|
187
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
188
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
189
|
+
}
|
190
|
+
if (TYPE(x) == T_FLOAT) {
|
191
|
+
x = rb_Array(x);
|
192
|
+
}
|
193
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
194
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
195
|
+
rb_raise(rb_eTypeError, "invalid type");
|
196
|
+
} -- no check since obj2c*ary will do that */
|
197
|
+
if (TYPE(wsave) == T_FLOAT) {
|
198
|
+
wsave = rb_Array(wsave);
|
199
|
+
}
|
200
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
201
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
202
|
+
rb_raise(rb_eTypeError, "invalid type");
|
203
|
+
} -- no check since obj2c*ary will do that */
|
204
|
+
|
205
|
+
i_n = NUM2INT(n);
|
206
|
+
io_x = dcl_obj2crealary(x);
|
207
|
+
i_wsave = dcl_obj2crealary(wsave);
|
208
|
+
|
209
|
+
|
210
|
+
cosqb_(&i_n, io_x, i_wsave);
|
211
|
+
|
212
|
+
{int array_shape[1] = {i_n};
|
213
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
214
|
+
}
|
215
|
+
|
216
|
+
dcl_freecrealary(io_x);
|
217
|
+
dcl_freecrealary(i_wsave);
|
218
|
+
|
219
|
+
return x;
|
220
|
+
|
221
|
+
}
|
222
|
+
|
223
|
+
static VALUE
|
224
|
+
dcl_cosqf(obj, n, x, wsave)
|
225
|
+
VALUE obj, n, x, wsave;
|
226
|
+
{
|
227
|
+
integer i_n;
|
228
|
+
real *io_x;
|
229
|
+
real *i_wsave;
|
230
|
+
|
231
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
232
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
233
|
+
}
|
234
|
+
if (TYPE(x) == T_FLOAT) {
|
235
|
+
x = rb_Array(x);
|
236
|
+
}
|
237
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
238
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
239
|
+
rb_raise(rb_eTypeError, "invalid type");
|
240
|
+
} -- no check since obj2c*ary will do that */
|
241
|
+
if (TYPE(wsave) == T_FLOAT) {
|
242
|
+
wsave = rb_Array(wsave);
|
243
|
+
}
|
244
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
245
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
246
|
+
rb_raise(rb_eTypeError, "invalid type");
|
247
|
+
} -- no check since obj2c*ary will do that */
|
248
|
+
|
249
|
+
i_n = NUM2INT(n);
|
250
|
+
io_x = dcl_obj2crealary(x);
|
251
|
+
i_wsave = dcl_obj2crealary(wsave);
|
252
|
+
|
253
|
+
|
254
|
+
cosqf_(&i_n, io_x, i_wsave);
|
255
|
+
|
256
|
+
{int array_shape[1] = {i_n};
|
257
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
258
|
+
}
|
259
|
+
|
260
|
+
dcl_freecrealary(io_x);
|
261
|
+
dcl_freecrealary(i_wsave);
|
262
|
+
|
263
|
+
return x;
|
264
|
+
|
265
|
+
}
|
266
|
+
|
267
|
+
static VALUE
|
268
|
+
dcl_cosqi(obj, n)
|
269
|
+
VALUE obj, n;
|
270
|
+
{
|
271
|
+
integer i_n;
|
272
|
+
real *o_wsave;
|
273
|
+
VALUE wsave;
|
274
|
+
|
275
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
276
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
277
|
+
}
|
278
|
+
|
279
|
+
i_n = NUM2INT(n);
|
280
|
+
|
281
|
+
o_wsave= ALLOCA_N(real, (3*i_n+15));
|
282
|
+
|
283
|
+
cosqi_(&i_n, o_wsave);
|
284
|
+
|
285
|
+
{int array_shape[1] = {3*i_n+15};
|
286
|
+
wsave = dcl_crealary2obj(o_wsave, (3*i_n+15), 1, array_shape);
|
287
|
+
}
|
288
|
+
|
289
|
+
|
290
|
+
return wsave;
|
291
|
+
|
292
|
+
}
|
293
|
+
|
294
|
+
static VALUE
|
295
|
+
dcl_cost(obj, n, x, wsave)
|
296
|
+
VALUE obj, n, x, wsave;
|
297
|
+
{
|
298
|
+
integer i_n;
|
299
|
+
real *io_x;
|
300
|
+
real *i_wsave;
|
301
|
+
|
302
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
303
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
304
|
+
}
|
305
|
+
if (TYPE(x) == T_FLOAT) {
|
306
|
+
x = rb_Array(x);
|
307
|
+
}
|
308
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
309
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
310
|
+
rb_raise(rb_eTypeError, "invalid type");
|
311
|
+
} -- no check since obj2c*ary will do that */
|
312
|
+
if (TYPE(wsave) == T_FLOAT) {
|
313
|
+
wsave = rb_Array(wsave);
|
314
|
+
}
|
315
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
316
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
317
|
+
rb_raise(rb_eTypeError, "invalid type");
|
318
|
+
} -- no check since obj2c*ary will do that */
|
319
|
+
|
320
|
+
i_n = NUM2INT(n);
|
321
|
+
io_x = dcl_obj2crealary(x);
|
322
|
+
i_wsave = dcl_obj2crealary(wsave);
|
323
|
+
|
324
|
+
|
325
|
+
cost_(&i_n, io_x, i_wsave);
|
326
|
+
|
327
|
+
{int array_shape[1] = {i_n};
|
328
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
329
|
+
}
|
330
|
+
|
331
|
+
dcl_freecrealary(io_x);
|
332
|
+
dcl_freecrealary(i_wsave);
|
333
|
+
|
334
|
+
return x;
|
335
|
+
|
336
|
+
}
|
337
|
+
|
338
|
+
static VALUE
|
339
|
+
dcl_costi(obj, n)
|
340
|
+
VALUE obj, n;
|
341
|
+
{
|
342
|
+
integer i_n;
|
343
|
+
real *o_wsave;
|
344
|
+
VALUE wsave;
|
345
|
+
|
346
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
347
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
348
|
+
}
|
349
|
+
|
350
|
+
i_n = NUM2INT(n);
|
351
|
+
|
352
|
+
o_wsave= ALLOCA_N(real, (3*i_n+15));
|
353
|
+
|
354
|
+
costi_(&i_n, o_wsave);
|
355
|
+
|
356
|
+
{int array_shape[1] = {3*i_n+15};
|
357
|
+
wsave = dcl_crealary2obj(o_wsave, (3*i_n+15), 1, array_shape);
|
358
|
+
}
|
359
|
+
|
360
|
+
|
361
|
+
return wsave;
|
362
|
+
|
363
|
+
}
|
364
|
+
|
365
|
+
static VALUE
|
366
|
+
dcl_ezfftb(obj, n, azero, a, b, wsave)
|
367
|
+
VALUE obj, n, azero, a, b, wsave;
|
368
|
+
{
|
369
|
+
integer i_n;
|
370
|
+
real *o_r;
|
371
|
+
real i_azero;
|
372
|
+
real *i_a;
|
373
|
+
real *i_b;
|
374
|
+
real *i_wsave;
|
375
|
+
VALUE r;
|
376
|
+
|
377
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
378
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
379
|
+
}
|
380
|
+
if (TYPE(azero) != T_FLOAT) {
|
381
|
+
azero = rb_funcall(azero, rb_intern("to_f"), 0);
|
382
|
+
}
|
383
|
+
if (TYPE(a) == T_FLOAT) {
|
384
|
+
a = rb_Array(a);
|
385
|
+
}
|
386
|
+
/* if ((TYPE(a) != T_ARRAY) &&
|
387
|
+
(rb_obj_is_kind_of(a, cNArray) != Qtrue)) {
|
388
|
+
rb_raise(rb_eTypeError, "invalid type");
|
389
|
+
} -- no check since obj2c*ary will do that */
|
390
|
+
if (TYPE(b) == T_FLOAT) {
|
391
|
+
b = rb_Array(b);
|
392
|
+
}
|
393
|
+
/* if ((TYPE(b) != T_ARRAY) &&
|
394
|
+
(rb_obj_is_kind_of(b, cNArray) != Qtrue)) {
|
395
|
+
rb_raise(rb_eTypeError, "invalid type");
|
396
|
+
} -- no check since obj2c*ary will do that */
|
397
|
+
if (TYPE(wsave) == T_FLOAT) {
|
398
|
+
wsave = rb_Array(wsave);
|
399
|
+
}
|
400
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
401
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
402
|
+
rb_raise(rb_eTypeError, "invalid type");
|
403
|
+
} -- no check since obj2c*ary will do that */
|
404
|
+
|
405
|
+
i_n = NUM2INT(n);
|
406
|
+
i_azero = (real)NUM2DBL(azero);
|
407
|
+
i_a = dcl_obj2crealary(a);
|
408
|
+
i_b = dcl_obj2crealary(b);
|
409
|
+
i_wsave = dcl_obj2crealary(wsave);
|
410
|
+
|
411
|
+
o_r= ALLOCA_N(real, (i_n));
|
412
|
+
|
413
|
+
ezfftb_(&i_n, o_r, &i_azero, i_a, i_b, i_wsave);
|
414
|
+
|
415
|
+
{int array_shape[1] = {i_n};
|
416
|
+
r = dcl_crealary2obj(o_r, (i_n), 1, array_shape);
|
417
|
+
}
|
418
|
+
|
419
|
+
dcl_freecrealary(i_a);
|
420
|
+
dcl_freecrealary(i_b);
|
421
|
+
dcl_freecrealary(i_wsave);
|
422
|
+
|
423
|
+
return r;
|
424
|
+
|
425
|
+
}
|
426
|
+
|
427
|
+
static VALUE
|
428
|
+
dcl_ezfftf(obj, n, r, wsave)
|
429
|
+
VALUE obj, n, r, wsave;
|
430
|
+
{
|
431
|
+
integer i_n;
|
432
|
+
real *i_r;
|
433
|
+
real o_azero;
|
434
|
+
real *o_a;
|
435
|
+
real *o_b;
|
436
|
+
real *i_wsave;
|
437
|
+
VALUE azero;
|
438
|
+
VALUE a;
|
439
|
+
VALUE b;
|
440
|
+
|
441
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
442
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
443
|
+
}
|
444
|
+
if (TYPE(r) == T_FLOAT) {
|
445
|
+
r = rb_Array(r);
|
446
|
+
}
|
447
|
+
/* if ((TYPE(r) != T_ARRAY) &&
|
448
|
+
(rb_obj_is_kind_of(r, cNArray) != Qtrue)) {
|
449
|
+
rb_raise(rb_eTypeError, "invalid type");
|
450
|
+
} -- no check since obj2c*ary will do that */
|
451
|
+
if (TYPE(wsave) == T_FLOAT) {
|
452
|
+
wsave = rb_Array(wsave);
|
453
|
+
}
|
454
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
455
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
456
|
+
rb_raise(rb_eTypeError, "invalid type");
|
457
|
+
} -- no check since obj2c*ary will do that */
|
458
|
+
|
459
|
+
i_n = NUM2INT(n);
|
460
|
+
i_r = dcl_obj2crealary(r);
|
461
|
+
i_wsave = dcl_obj2crealary(wsave);
|
462
|
+
|
463
|
+
o_a= ALLOCA_N(real, (i_n/2));
|
464
|
+
o_b= ALLOCA_N(real, (i_n/2));
|
465
|
+
|
466
|
+
ezfftf_(&i_n, i_r, &o_azero, o_a, o_b, i_wsave);
|
467
|
+
|
468
|
+
azero = rb_float_new((double)o_azero);
|
469
|
+
{int array_shape[1] = {i_n/2};
|
470
|
+
a = dcl_crealary2obj(o_a, (i_n/2), 1, array_shape);
|
471
|
+
}
|
472
|
+
{int array_shape[1] = {i_n/2};
|
473
|
+
b = dcl_crealary2obj(o_b, (i_n/2), 1, array_shape);
|
474
|
+
}
|
475
|
+
|
476
|
+
dcl_freecrealary(i_r);
|
477
|
+
dcl_freecrealary(i_wsave);
|
478
|
+
|
479
|
+
return rb_ary_new3(3, azero, a, b);
|
480
|
+
|
481
|
+
}
|
482
|
+
|
483
|
+
static VALUE
|
484
|
+
dcl_ezffti(obj, n)
|
485
|
+
VALUE obj, n;
|
486
|
+
{
|
487
|
+
integer i_n;
|
488
|
+
real *o_wsave;
|
489
|
+
VALUE wsave;
|
490
|
+
|
491
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
492
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
493
|
+
}
|
494
|
+
|
495
|
+
i_n = NUM2INT(n);
|
496
|
+
|
497
|
+
o_wsave= ALLOCA_N(real, (3*i_n+15));
|
498
|
+
|
499
|
+
ezffti_(&i_n, o_wsave);
|
500
|
+
|
501
|
+
{int array_shape[1] = {3*i_n+15};
|
502
|
+
wsave = dcl_crealary2obj(o_wsave, (3*i_n+15), 1, array_shape);
|
503
|
+
}
|
504
|
+
|
505
|
+
|
506
|
+
return wsave;
|
507
|
+
|
508
|
+
}
|
509
|
+
|
510
|
+
static VALUE
|
511
|
+
dcl_rfftb(obj, n, r, wsave)
|
512
|
+
VALUE obj, n, r, wsave;
|
513
|
+
{
|
514
|
+
integer i_n;
|
515
|
+
real *io_r;
|
516
|
+
real *i_wsave;
|
517
|
+
|
518
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
519
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
520
|
+
}
|
521
|
+
if (TYPE(r) == T_FLOAT) {
|
522
|
+
r = rb_Array(r);
|
523
|
+
}
|
524
|
+
/* if ((TYPE(r) != T_ARRAY) &&
|
525
|
+
(rb_obj_is_kind_of(r, cNArray) != Qtrue)) {
|
526
|
+
rb_raise(rb_eTypeError, "invalid type");
|
527
|
+
} -- no check since obj2c*ary will do that */
|
528
|
+
if (TYPE(wsave) == T_FLOAT) {
|
529
|
+
wsave = rb_Array(wsave);
|
530
|
+
}
|
531
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
532
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
533
|
+
rb_raise(rb_eTypeError, "invalid type");
|
534
|
+
} -- no check since obj2c*ary will do that */
|
535
|
+
|
536
|
+
i_n = NUM2INT(n);
|
537
|
+
io_r = dcl_obj2crealary(r);
|
538
|
+
i_wsave = dcl_obj2crealary(wsave);
|
539
|
+
|
540
|
+
|
541
|
+
rfftb_(&i_n, io_r, i_wsave);
|
542
|
+
|
543
|
+
{int array_shape[1] = {i_n};
|
544
|
+
r = dcl_crealary2obj(io_r, (i_n), 1, array_shape);
|
545
|
+
}
|
546
|
+
|
547
|
+
dcl_freecrealary(io_r);
|
548
|
+
dcl_freecrealary(i_wsave);
|
549
|
+
|
550
|
+
return r;
|
551
|
+
|
552
|
+
}
|
553
|
+
|
554
|
+
static VALUE
|
555
|
+
dcl_rfftf(obj, n, r, wsave)
|
556
|
+
VALUE obj, n, r, wsave;
|
557
|
+
{
|
558
|
+
integer i_n;
|
559
|
+
real *io_r;
|
560
|
+
real *i_wsave;
|
561
|
+
|
562
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
563
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
564
|
+
}
|
565
|
+
if (TYPE(r) == T_FLOAT) {
|
566
|
+
r = rb_Array(r);
|
567
|
+
}
|
568
|
+
/* if ((TYPE(r) != T_ARRAY) &&
|
569
|
+
(rb_obj_is_kind_of(r, cNArray) != Qtrue)) {
|
570
|
+
rb_raise(rb_eTypeError, "invalid type");
|
571
|
+
} -- no check since obj2c*ary will do that */
|
572
|
+
if (TYPE(wsave) == T_FLOAT) {
|
573
|
+
wsave = rb_Array(wsave);
|
574
|
+
}
|
575
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
576
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
577
|
+
rb_raise(rb_eTypeError, "invalid type");
|
578
|
+
} -- no check since obj2c*ary will do that */
|
579
|
+
|
580
|
+
i_n = NUM2INT(n);
|
581
|
+
io_r = dcl_obj2crealary(r);
|
582
|
+
i_wsave = dcl_obj2crealary(wsave);
|
583
|
+
|
584
|
+
|
585
|
+
rfftf_(&i_n, io_r, i_wsave);
|
586
|
+
|
587
|
+
{int array_shape[1] = {i_n};
|
588
|
+
r = dcl_crealary2obj(io_r, (i_n), 1, array_shape);
|
589
|
+
}
|
590
|
+
|
591
|
+
dcl_freecrealary(io_r);
|
592
|
+
dcl_freecrealary(i_wsave);
|
593
|
+
|
594
|
+
return r;
|
595
|
+
|
596
|
+
}
|
597
|
+
|
598
|
+
static VALUE
|
599
|
+
dcl_rffti(obj, n)
|
600
|
+
VALUE obj, n;
|
601
|
+
{
|
602
|
+
integer i_n;
|
603
|
+
real *o_wsave;
|
604
|
+
VALUE wsave;
|
605
|
+
|
606
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
607
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
608
|
+
}
|
609
|
+
|
610
|
+
i_n = NUM2INT(n);
|
611
|
+
|
612
|
+
o_wsave= ALLOCA_N(real, (2*i_n+15));
|
613
|
+
|
614
|
+
rffti_(&i_n, o_wsave);
|
615
|
+
|
616
|
+
{int array_shape[1] = {2*i_n+15};
|
617
|
+
wsave = dcl_crealary2obj(o_wsave, (2*i_n+15), 1, array_shape);
|
618
|
+
}
|
619
|
+
|
620
|
+
|
621
|
+
return wsave;
|
622
|
+
|
623
|
+
}
|
624
|
+
|
625
|
+
static VALUE
|
626
|
+
dcl_sinqb(obj, n, x, wsave)
|
627
|
+
VALUE obj, n, x, wsave;
|
628
|
+
{
|
629
|
+
integer i_n;
|
630
|
+
real *io_x;
|
631
|
+
real *i_wsave;
|
632
|
+
|
633
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
634
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
635
|
+
}
|
636
|
+
if (TYPE(x) == T_FLOAT) {
|
637
|
+
x = rb_Array(x);
|
638
|
+
}
|
639
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
640
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
641
|
+
rb_raise(rb_eTypeError, "invalid type");
|
642
|
+
} -- no check since obj2c*ary will do that */
|
643
|
+
if (TYPE(wsave) == T_FLOAT) {
|
644
|
+
wsave = rb_Array(wsave);
|
645
|
+
}
|
646
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
647
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
648
|
+
rb_raise(rb_eTypeError, "invalid type");
|
649
|
+
} -- no check since obj2c*ary will do that */
|
650
|
+
|
651
|
+
i_n = NUM2INT(n);
|
652
|
+
io_x = dcl_obj2crealary(x);
|
653
|
+
i_wsave = dcl_obj2crealary(wsave);
|
654
|
+
|
655
|
+
|
656
|
+
sinqb_(&i_n, io_x, i_wsave);
|
657
|
+
|
658
|
+
{int array_shape[1] = {i_n};
|
659
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
660
|
+
}
|
661
|
+
|
662
|
+
dcl_freecrealary(io_x);
|
663
|
+
dcl_freecrealary(i_wsave);
|
664
|
+
|
665
|
+
return x;
|
666
|
+
|
667
|
+
}
|
668
|
+
|
669
|
+
static VALUE
|
670
|
+
dcl_sinqf(obj, n, x, wsave)
|
671
|
+
VALUE obj, n, x, wsave;
|
672
|
+
{
|
673
|
+
integer i_n;
|
674
|
+
real *io_x;
|
675
|
+
real *i_wsave;
|
676
|
+
|
677
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
678
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
679
|
+
}
|
680
|
+
if (TYPE(x) == T_FLOAT) {
|
681
|
+
x = rb_Array(x);
|
682
|
+
}
|
683
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
684
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
685
|
+
rb_raise(rb_eTypeError, "invalid type");
|
686
|
+
} -- no check since obj2c*ary will do that */
|
687
|
+
if (TYPE(wsave) == T_FLOAT) {
|
688
|
+
wsave = rb_Array(wsave);
|
689
|
+
}
|
690
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
691
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
692
|
+
rb_raise(rb_eTypeError, "invalid type");
|
693
|
+
} -- no check since obj2c*ary will do that */
|
694
|
+
|
695
|
+
i_n = NUM2INT(n);
|
696
|
+
io_x = dcl_obj2crealary(x);
|
697
|
+
i_wsave = dcl_obj2crealary(wsave);
|
698
|
+
|
699
|
+
|
700
|
+
sinqf_(&i_n, io_x, i_wsave);
|
701
|
+
|
702
|
+
{int array_shape[1] = {i_n};
|
703
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
704
|
+
}
|
705
|
+
|
706
|
+
dcl_freecrealary(io_x);
|
707
|
+
dcl_freecrealary(i_wsave);
|
708
|
+
|
709
|
+
return x;
|
710
|
+
|
711
|
+
}
|
712
|
+
|
713
|
+
static VALUE
|
714
|
+
dcl_sinqi(obj, n)
|
715
|
+
VALUE obj, n;
|
716
|
+
{
|
717
|
+
integer i_n;
|
718
|
+
real *o_wsave;
|
719
|
+
VALUE wsave;
|
720
|
+
|
721
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
722
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
723
|
+
}
|
724
|
+
|
725
|
+
i_n = NUM2INT(n);
|
726
|
+
|
727
|
+
o_wsave= ALLOCA_N(real, (3*i_n+15));
|
728
|
+
|
729
|
+
sinqi_(&i_n, o_wsave);
|
730
|
+
|
731
|
+
{int array_shape[1] = {3*i_n+15};
|
732
|
+
wsave = dcl_crealary2obj(o_wsave, (3*i_n+15), 1, array_shape);
|
733
|
+
}
|
734
|
+
|
735
|
+
|
736
|
+
return wsave;
|
737
|
+
|
738
|
+
}
|
739
|
+
|
740
|
+
static VALUE
|
741
|
+
dcl_sint(obj, n, x, wsave)
|
742
|
+
VALUE obj, n, x, wsave;
|
743
|
+
{
|
744
|
+
integer i_n;
|
745
|
+
real *io_x;
|
746
|
+
real *i_wsave;
|
747
|
+
|
748
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
749
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
750
|
+
}
|
751
|
+
if (TYPE(x) == T_FLOAT) {
|
752
|
+
x = rb_Array(x);
|
753
|
+
}
|
754
|
+
/* if ((TYPE(x) != T_ARRAY) &&
|
755
|
+
(rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
|
756
|
+
rb_raise(rb_eTypeError, "invalid type");
|
757
|
+
} -- no check since obj2c*ary will do that */
|
758
|
+
if (TYPE(wsave) == T_FLOAT) {
|
759
|
+
wsave = rb_Array(wsave);
|
760
|
+
}
|
761
|
+
/* if ((TYPE(wsave) != T_ARRAY) &&
|
762
|
+
(rb_obj_is_kind_of(wsave, cNArray) != Qtrue)) {
|
763
|
+
rb_raise(rb_eTypeError, "invalid type");
|
764
|
+
} -- no check since obj2c*ary will do that */
|
765
|
+
|
766
|
+
i_n = NUM2INT(n);
|
767
|
+
io_x = dcl_obj2crealary(x);
|
768
|
+
i_wsave = dcl_obj2crealary(wsave);
|
769
|
+
|
770
|
+
|
771
|
+
sint_(&i_n, io_x, i_wsave);
|
772
|
+
|
773
|
+
{int array_shape[1] = {i_n};
|
774
|
+
x = dcl_crealary2obj(io_x, (i_n), 1, array_shape);
|
775
|
+
}
|
776
|
+
|
777
|
+
dcl_freecrealary(io_x);
|
778
|
+
dcl_freecrealary(i_wsave);
|
779
|
+
|
780
|
+
return x;
|
781
|
+
|
782
|
+
}
|
783
|
+
|
784
|
+
static VALUE
|
785
|
+
dcl_sinti(obj, n)
|
786
|
+
VALUE obj, n;
|
787
|
+
{
|
788
|
+
integer i_n;
|
789
|
+
real *o_wsave;
|
790
|
+
VALUE wsave;
|
791
|
+
|
792
|
+
if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) {
|
793
|
+
n = rb_funcall(n, rb_intern("to_i"), 0);
|
794
|
+
}
|
795
|
+
|
796
|
+
i_n = NUM2INT(n);
|
797
|
+
|
798
|
+
o_wsave= ALLOCA_N(real, (2*i_n+i_n/2+15));
|
799
|
+
|
800
|
+
sinti_(&i_n, o_wsave);
|
801
|
+
|
802
|
+
{int array_shape[1] = {2*i_n+i_n/2+15};
|
803
|
+
wsave = dcl_crealary2obj(o_wsave, (2*i_n+i_n/2+15), 1, array_shape);
|
804
|
+
}
|
805
|
+
|
806
|
+
|
807
|
+
return wsave;
|
808
|
+
|
809
|
+
}
|
810
|
+
void
|
811
|
+
init_math2_fftlib(mDCL)
|
812
|
+
VALUE mDCL;
|
813
|
+
{
|
814
|
+
rb_define_module_function(mDCL, "cfftb", dcl_cfftb, 3);
|
815
|
+
rb_define_module_function(mDCL, "cfftf", dcl_cfftf, 3);
|
816
|
+
rb_define_module_function(mDCL, "cffti", dcl_cffti, 1);
|
817
|
+
rb_define_module_function(mDCL, "cosqb", dcl_cosqb, 3);
|
818
|
+
rb_define_module_function(mDCL, "cosqf", dcl_cosqf, 3);
|
819
|
+
rb_define_module_function(mDCL, "cosqi", dcl_cosqi, 1);
|
820
|
+
rb_define_module_function(mDCL, "cost", dcl_cost, 3);
|
821
|
+
rb_define_module_function(mDCL, "costi", dcl_costi, 1);
|
822
|
+
rb_define_module_function(mDCL, "ezfftb", dcl_ezfftb, 5);
|
823
|
+
rb_define_module_function(mDCL, "ezfftf", dcl_ezfftf, 3);
|
824
|
+
rb_define_module_function(mDCL, "ezffti", dcl_ezffti, 1);
|
825
|
+
rb_define_module_function(mDCL, "rfftb", dcl_rfftb, 3);
|
826
|
+
rb_define_module_function(mDCL, "rfftf", dcl_rfftf, 3);
|
827
|
+
rb_define_module_function(mDCL, "rffti", dcl_rffti, 1);
|
828
|
+
rb_define_module_function(mDCL, "sinqb", dcl_sinqb, 3);
|
829
|
+
rb_define_module_function(mDCL, "sinqf", dcl_sinqf, 3);
|
830
|
+
rb_define_module_function(mDCL, "sinqi", dcl_sinqi, 1);
|
831
|
+
rb_define_module_function(mDCL, "sint", dcl_sint, 3);
|
832
|
+
rb_define_module_function(mDCL, "sinti", dcl_sinti, 1);
|
833
|
+
}
|