ruby-lapack 1.6 → 1.7

data/ext/dlasq4.c

@@ -1,107 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dlasq4_(integer* i0, integer* n0, doublereal* z, integer* pp, integer* n0in, doublereal* dmin, doublereal* dmin1, doublereal* dmin2, doublereal* dn, doublereal* dn1, doublereal* dn2, doublereal* tau, integer* ttype, real* g);
-
-
-static VALUE
-rblapack_dlasq4(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_i0;
-  integer i0; 
-  VALUE rblapack_n0;
-  integer n0; 
-  VALUE rblapack_z;
-  doublereal *z; 
-  VALUE rblapack_pp;
-  integer pp; 
-  VALUE rblapack_n0in;
-  integer n0in; 
-  VALUE rblapack_dmin;
-  doublereal dmin; 
-  VALUE rblapack_dmin1;
-  doublereal dmin1; 
-  VALUE rblapack_dmin2;
-  doublereal dmin2; 
-  VALUE rblapack_dn;
-  doublereal dn; 
-  VALUE rblapack_dn1;
-  doublereal dn1; 
-  VALUE rblapack_dn2;
-  doublereal dn2; 
-  VALUE rblapack_g;
-  real g; 
-  VALUE rblapack_tau;
-  doublereal tau; 
-  VALUE rblapack_ttype;
-  integer ttype; 
-
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  tau, ttype, g = NumRu::Lapack.dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, g, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU, TTYPE, G )\n\n*  Purpose\n*  =======\n*\n*  DLASQ4 computes an approximation TAU to the smallest eigenvalue\n*  using values of d from the previous transform.\n*\n\n*  I0    (input) INTEGER\n*        First index.\n*\n*  N0    (input) INTEGER\n*        Last index.\n*\n*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )\n*        Z holds the qd array.\n*\n*  PP    (input) INTEGER\n*        PP=0 for ping, PP=1 for pong.\n*\n*  NOIN  (input) INTEGER\n*        The value of N0 at start of EIGTEST.\n*\n*  DMIN  (input) DOUBLE PRECISION\n*        Minimum value of d.\n*\n*  DMIN1 (input) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ).\n*\n*  DMIN2 (input) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).\n*\n*  DN    (input) DOUBLE PRECISION\n*        d(N)\n*\n*  DN1   (input) DOUBLE PRECISION\n*        d(N-1)\n*\n*  DN2   (input) DOUBLE PRECISION\n*        d(N-2)\n*\n*  TAU   (output) DOUBLE PRECISION\n*        This is the shift.\n*\n*  TTYPE (output) INTEGER\n*        Shift type.\n*\n*  G     (input/output) REAL\n*        G is passed as an argument in order to save its value between\n*        calls to DLASQ4.\n*\n\n*  Further Details\n*  ===============\n*  CNST1 = 9/16\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  tau, ttype, g = NumRu::Lapack.dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, g, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 12 && argc != 12)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 12)", argc);
-  rblapack_i0 = argv[0];
-  rblapack_n0 = argv[1];
-  rblapack_z = argv[2];
-  rblapack_pp = argv[3];
-  rblapack_n0in = argv[4];
-  rblapack_dmin = argv[5];
-  rblapack_dmin1 = argv[6];
-  rblapack_dmin2 = argv[7];
-  rblapack_dn = argv[8];
-  rblapack_dn1 = argv[9];
-  rblapack_dn2 = argv[10];
-  rblapack_g = argv[11];
-  if (argc == 12) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  i0 = NUM2INT(rblapack_i0);
-  pp = NUM2INT(rblapack_pp);
-  dmin = NUM2DBL(rblapack_dmin);
-  dmin2 = NUM2DBL(rblapack_dmin2);
-  dn1 = NUM2DBL(rblapack_dn1);
-  g = (real)NUM2DBL(rblapack_g);
-  n0 = NUM2INT(rblapack_n0);
-  n0in = NUM2INT(rblapack_n0in);
-  dn = NUM2DBL(rblapack_dn);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (3th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (3th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_z) != (4*n0))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 4*n0);
-  if (NA_TYPE(rblapack_z) != NA_DFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, doublereal*);
-  dn2 = NUM2DBL(rblapack_dn2);
-  dmin1 = NUM2DBL(rblapack_dmin1);
-
-  dlasq4_(&i0, &n0, z, &pp, &n0in, &dmin, &dmin1, &dmin2, &dn, &dn1, &dn2, &tau, &ttype, &g);
-
-  rblapack_tau = rb_float_new((double)tau);
-  rblapack_ttype = INT2NUM(ttype);
-  rblapack_g = rb_float_new((double)g);
-  return rb_ary_new3(3, rblapack_tau, rblapack_ttype, rblapack_g);
-}
-
-void
-init_lapack_dlasq4(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dlasq4", rblapack_dlasq4, -1);
-}

data/ext/dlasq5.c

@@ -1,94 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dlasq5_(integer* i0, integer* n0, doublereal* z, integer* pp, doublereal* tau, doublereal* dmin, doublereal* dmin1, doublereal* dmin2, doublereal* dn, doublereal* dnm1, doublereal* dnm2, logical* ieee);
-
-
-static VALUE
-rblapack_dlasq5(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_i0;
-  integer i0; 
-  VALUE rblapack_n0;
-  integer n0; 
-  VALUE rblapack_z;
-  doublereal *z; 
-  VALUE rblapack_pp;
-  integer pp; 
-  VALUE rblapack_tau;
-  doublereal tau; 
-  VALUE rblapack_ieee;
-  logical ieee; 
-  VALUE rblapack_dmin;
-  doublereal dmin; 
-  VALUE rblapack_dmin1;
-  doublereal dmin1; 
-  VALUE rblapack_dmin2;
-  doublereal dmin2; 
-  VALUE rblapack_dn;
-  doublereal dn; 
-  VALUE rblapack_dnm1;
-  doublereal dnm1; 
-  VALUE rblapack_dnm2;
-  doublereal dnm2; 
-
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  dmin, dmin1, dmin2, dn, dnm1, dnm2 = NumRu::Lapack.dlasq5( i0, n0, z, pp, tau, ieee, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, IEEE )\n\n*  Purpose\n*  =======\n*\n*  DLASQ5 computes one dqds transform in ping-pong form, one\n*  version for IEEE machines another for non IEEE machines.\n*\n\n*  Arguments\n*  =========\n*\n*  I0    (input) INTEGER\n*        First index.\n*\n*  N0    (input) INTEGER\n*        Last index.\n*\n*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )\n*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid\n*        an extra argument.\n*\n*  PP    (input) INTEGER\n*        PP=0 for ping, PP=1 for pong.\n*\n*  TAU   (input) DOUBLE PRECISION\n*        This is the shift.\n*\n*  DMIN  (output) DOUBLE PRECISION\n*        Minimum value of d.\n*\n*  DMIN1 (output) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ).\n*\n*  DMIN2 (output) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).\n*\n*  DN    (output) DOUBLE PRECISION\n*        d(N0), the last value of d.\n*\n*  DNM1  (output) DOUBLE PRECISION\n*        d(N0-1).\n*\n*  DNM2  (output) DOUBLE PRECISION\n*        d(N0-2).\n*\n*  IEEE  (input) LOGICAL\n*        Flag for IEEE or non IEEE arithmetic.\n*\n\n*  =====================================================================\n*\n*     .. Parameter ..\n      DOUBLE PRECISION   ZERO\n      PARAMETER          ( ZERO = 0.0D0 )\n*     ..\n*     .. Local Scalars ..\n      INTEGER            J4, J4P2\n      DOUBLE PRECISION   D, EMIN, TEMP\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          MIN\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  dmin, dmin1, dmin2, dn, dnm1, dnm2 = NumRu::Lapack.dlasq5( i0, n0, z, pp, tau, ieee, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 6 && argc != 6)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 6)", argc);
-  rblapack_i0 = argv[0];
-  rblapack_n0 = argv[1];
-  rblapack_z = argv[2];
-  rblapack_pp = argv[3];
-  rblapack_tau = argv[4];
-  rblapack_ieee = argv[5];
-  if (argc == 6) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  i0 = NUM2INT(rblapack_i0);
-  pp = NUM2INT(rblapack_pp);
-  ieee = (rblapack_ieee == Qtrue);
-  n0 = NUM2INT(rblapack_n0);
-  tau = NUM2DBL(rblapack_tau);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (3th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (3th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_z) != (4*n0))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 4*n0);
-  if (NA_TYPE(rblapack_z) != NA_DFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, doublereal*);
-
-  dlasq5_(&i0, &n0, z, &pp, &tau, &dmin, &dmin1, &dmin2, &dn, &dnm1, &dnm2, &ieee);
-
-  rblapack_dmin = rb_float_new((double)dmin);
-  rblapack_dmin1 = rb_float_new((double)dmin1);
-  rblapack_dmin2 = rb_float_new((double)dmin2);
-  rblapack_dn = rb_float_new((double)dn);
-  rblapack_dnm1 = rb_float_new((double)dnm1);
-  rblapack_dnm2 = rb_float_new((double)dnm2);
-  return rb_ary_new3(6, rblapack_dmin, rblapack_dmin1, rblapack_dmin2, rblapack_dn, rblapack_dnm1, rblapack_dnm2);
-}
-
-void
-init_lapack_dlasq5(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dlasq5", rblapack_dlasq5, -1);
-}

data/ext/dlasq6.c

@@ -1,86 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dlasq6_(integer* i0, integer* n0, doublereal* z, integer* pp, doublereal* dmin, doublereal* dmin1, doublereal* dmin2, doublereal* dn, doublereal* dnm1, doublereal* dnm2);
-
-
-static VALUE
-rblapack_dlasq6(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_i0;
-  integer i0; 
-  VALUE rblapack_n0;
-  integer n0; 
-  VALUE rblapack_z;
-  doublereal *z; 
-  VALUE rblapack_pp;
-  integer pp; 
-  VALUE rblapack_dmin;
-  doublereal dmin; 
-  VALUE rblapack_dmin1;
-  doublereal dmin1; 
-  VALUE rblapack_dmin2;
-  doublereal dmin2; 
-  VALUE rblapack_dn;
-  doublereal dn; 
-  VALUE rblapack_dnm1;
-  doublereal dnm1; 
-  VALUE rblapack_dnm2;
-  doublereal dnm2; 
-
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  dmin, dmin1, dmin2, dn, dnm1, dnm2 = NumRu::Lapack.dlasq6( i0, n0, z, pp, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2 )\n\n*  Purpose\n*  =======\n*\n*  DLASQ6 computes one dqd (shift equal to zero) transform in\n*  ping-pong form, with protection against underflow and overflow.\n*\n\n*  Arguments\n*  =========\n*\n*  I0    (input) INTEGER\n*        First index.\n*\n*  N0    (input) INTEGER\n*        Last index.\n*\n*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )\n*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid\n*        an extra argument.\n*\n*  PP    (input) INTEGER\n*        PP=0 for ping, PP=1 for pong.\n*\n*  DMIN  (output) DOUBLE PRECISION\n*        Minimum value of d.\n*\n*  DMIN1 (output) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ).\n*\n*  DMIN2 (output) DOUBLE PRECISION\n*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).\n*\n*  DN    (output) DOUBLE PRECISION\n*        d(N0), the last value of d.\n*\n*  DNM1  (output) DOUBLE PRECISION\n*        d(N0-1).\n*\n*  DNM2  (output) DOUBLE PRECISION\n*        d(N0-2).\n*\n\n*  =====================================================================\n*\n*     .. Parameter ..\n      DOUBLE PRECISION   ZERO\n      PARAMETER          ( ZERO = 0.0D0 )\n*     ..\n*     .. Local Scalars ..\n      INTEGER            J4, J4P2\n      DOUBLE PRECISION   D, EMIN, SAFMIN, TEMP\n*     ..\n*     .. External Function ..\n      DOUBLE PRECISION   DLAMCH\n      EXTERNAL           DLAMCH\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          MIN\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  dmin, dmin1, dmin2, dn, dnm1, dnm2 = NumRu::Lapack.dlasq6( i0, n0, z, pp, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 4 && argc != 4)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 4)", argc);
-  rblapack_i0 = argv[0];
-  rblapack_n0 = argv[1];
-  rblapack_z = argv[2];
-  rblapack_pp = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  i0 = NUM2INT(rblapack_i0);
-  pp = NUM2INT(rblapack_pp);
-  n0 = NUM2INT(rblapack_n0);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (3th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (3th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_z) != (4*n0))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 4*n0);
-  if (NA_TYPE(rblapack_z) != NA_DFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, doublereal*);
-
-  dlasq6_(&i0, &n0, z, &pp, &dmin, &dmin1, &dmin2, &dn, &dnm1, &dnm2);
-
-  rblapack_dmin = rb_float_new((double)dmin);
-  rblapack_dmin1 = rb_float_new((double)dmin1);
-  rblapack_dmin2 = rb_float_new((double)dmin2);
-  rblapack_dn = rb_float_new((double)dn);
-  rblapack_dnm1 = rb_float_new((double)dnm1);
-  rblapack_dnm2 = rb_float_new((double)dnm2);
-  return rb_ary_new3(6, rblapack_dmin, rblapack_dmin1, rblapack_dmin2, rblapack_dn, rblapack_dnm1, rblapack_dnm2);
-}
-
-void
-init_lapack_dlasq6(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dlasq6", rblapack_dlasq6, -1);
-}

data/ext/dlasr.c

@@ -1,110 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dlasr_(char* side, char* pivot, char* direct, integer* m, integer* n, doublereal* c, doublereal* s, doublereal* a, integer* lda);
-
-
-static VALUE
-rblapack_dlasr(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_side;
-  char side; 
-  VALUE rblapack_pivot;
-  char pivot; 
-  VALUE rblapack_direct;
-  char direct; 
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_c;
-  doublereal *c; 
-  VALUE rblapack_s;
-  doublereal *s; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_a_out__;
-  doublereal *a_out__;
-
-  integer lda;
-  integer n;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  a = NumRu::Lapack.dlasr( side, pivot, direct, m, c, s, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )\n\n*  Purpose\n*  =======\n*\n*  DLASR applies a sequence of plane rotations to a real matrix A,\n*  from either the left or the right.\n*  \n*  When SIDE = 'L', the transformation takes the form\n*  \n*     A := P*A\n*  \n*  and when SIDE = 'R', the transformation takes the form\n*  \n*     A := A*P**T\n*  \n*  where P is an orthogonal matrix consisting of a sequence of z plane\n*  rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',\n*  and P**T is the transpose of P.\n*  \n*  When DIRECT = 'F' (Forward sequence), then\n*  \n*     P = P(z-1) * ... * P(2) * P(1)\n*  \n*  and when DIRECT = 'B' (Backward sequence), then\n*  \n*     P = P(1) * P(2) * ... * P(z-1)\n*  \n*  where P(k) is a plane rotation matrix defined by the 2-by-2 rotation\n*  \n*     R(k) = (  c(k)  s(k) )\n*          = ( -s(k)  c(k) ).\n*  \n*  When PIVOT = 'V' (Variable pivot), the rotation is performed\n*  for the plane (k,k+1), i.e., P(k) has the form\n*  \n*     P(k) = (  1                                            )\n*            (       ...                                     )\n*            (              1                                )\n*            (                   c(k)  s(k)                  )\n*            (                  -s(k)  c(k)                  )\n*            (                                1              )\n*            (                                     ...       )\n*            (                                            1  )\n*  \n*  where R(k) appears as a rank-2 modification to the identity matrix in\n*  rows and columns k and k+1.\n*  \n*  When PIVOT = 'T' (Top pivot), the rotation is performed for the\n*  plane (1,k+1), so P(k) has the form\n*  \n*     P(k) = (  c(k)                    s(k)                 )\n*            (         1                                     )\n*            (              ...                              )\n*            (                     1                         )\n*            ( -s(k)                    c(k)                 )\n*            (                                 1             )\n*            (                                      ...      )\n*            (                                             1 )\n*  \n*  where R(k) appears in rows and columns 1 and k+1.\n*  \n*  Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is\n*  performed for the plane (k,z), giving P(k) the form\n*  \n*     P(k) = ( 1                                             )\n*            (      ...                                      )\n*            (             1                                 )\n*            (                  c(k)                    s(k) )\n*            (                         1                     )\n*            (                              ...              )\n*            (                                     1         )\n*            (                 -s(k)                    c(k) )\n*  \n*  where R(k) appears in rows and columns k and z.  The rotations are\n*  performed without ever forming P(k) explicitly.\n*\n\n*  Arguments\n*  =========\n*\n*  SIDE    (input) CHARACTER*1\n*          Specifies whether the plane rotation matrix P is applied to\n*          A on the left or the right.\n*          = 'L':  Left, compute A := P*A\n*          = 'R':  Right, compute A:= A*P**T\n*\n*  PIVOT   (input) CHARACTER*1\n*          Specifies the plane for which P(k) is a plane rotation\n*          matrix.\n*          = 'V':  Variable pivot, the plane (k,k+1)\n*          = 'T':  Top pivot, the plane (1,k+1)\n*          = 'B':  Bottom pivot, the plane (k,z)\n*\n*  DIRECT  (input) CHARACTER*1\n*          Specifies whether P is a forward or backward sequence of\n*          plane rotations.\n*          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1)\n*          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1)\n*\n*  M       (input) INTEGER\n*          The number of rows of the matrix A.  If m <= 1, an immediate\n*          return is effected.\n*\n*  N       (input) INTEGER\n*          The number of columns of the matrix A.  If n <= 1, an\n*          immediate return is effected.\n*\n*  C       (input) DOUBLE PRECISION array, dimension\n*                  (M-1) if SIDE = 'L'\n*                  (N-1) if SIDE = 'R'\n*          The cosines c(k) of the plane rotations.\n*\n*  S       (input) DOUBLE PRECISION array, dimension\n*                  (M-1) if SIDE = 'L'\n*                  (N-1) if SIDE = 'R'\n*          The sines s(k) of the plane rotations.  The 2-by-2 plane\n*          rotation part of the matrix P(k), R(k), has the form\n*          R(k) = (  c(k)  s(k) )\n*                 ( -s(k)  c(k) ).\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          The M-by-N matrix A.  On exit, A is overwritten by P*A if\n*          SIDE = 'R' or by A*P**T if SIDE = 'L'.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  a = NumRu::Lapack.dlasr( side, pivot, direct, m, c, s, a, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 7 && argc != 7)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 7)", argc);
-  rblapack_side = argv[0];
-  rblapack_pivot = argv[1];
-  rblapack_direct = argv[2];
-  rblapack_m = argv[3];
-  rblapack_c = argv[4];
-  rblapack_s = argv[5];
-  rblapack_a = argv[6];
-  if (argc == 7) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  side = StringValueCStr(rblapack_side)[0];
-  direct = StringValueCStr(rblapack_direct)[0];
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (7th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (7th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  n = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_DFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_DFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, doublereal*);
-  pivot = StringValueCStr(rblapack_pivot)[0];
-  m = NUM2INT(rblapack_m);
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (6th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_s) != (m-1))
-    rb_raise(rb_eRuntimeError, "shape 0 of s must be %d", m-1);
-  if (NA_TYPE(rblapack_s) != NA_DFLOAT)
-    rblapack_s = na_change_type(rblapack_s, NA_DFLOAT);
-  s = NA_PTR_TYPE(rblapack_s, doublereal*);
-  if (!NA_IsNArray(rblapack_c))
-    rb_raise(rb_eArgError, "c (5th argument) must be NArray");
-  if (NA_RANK(rblapack_c) != 1)
-    rb_raise(rb_eArgError, "rank of c (5th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_c) != (m-1))
-    rb_raise(rb_eRuntimeError, "shape 0 of c must be %d", m-1);
-  if (NA_TYPE(rblapack_c) != NA_DFLOAT)
-    rblapack_c = na_change_type(rblapack_c, NA_DFLOAT);
-  c = NA_PTR_TYPE(rblapack_c, doublereal*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublereal*);
-  MEMCPY(a_out__, a, doublereal, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  dlasr_(&side, &pivot, &direct, &m, &n, c, s, a, &lda);
-
-  return rblapack_a;
-}
-
-void
-init_lapack_dlasr(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dlasr", rblapack_dlasr, -1);
-}

data/ext/dlasrt.c

@@ -1,74 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dlasrt_(char* id, integer* n, doublereal* d, integer* info);
-
-
-static VALUE
-rblapack_dlasrt(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_id;
-  char id; 
-  VALUE rblapack_d;
-  doublereal *d; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_d_out__;
-  doublereal *d_out__;
-
-  integer n;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, d = NumRu::Lapack.dlasrt( id, d, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASRT( ID, N, D, INFO )\n\n*  Purpose\n*  =======\n*\n*  Sort the numbers in D in increasing order (if ID = 'I') or\n*  in decreasing order (if ID = 'D' ).\n*\n*  Use Quick Sort, reverting to Insertion sort on arrays of\n*  size <= 20. Dimension of STACK limits N to about 2**32.\n*\n\n*  Arguments\n*  =========\n*\n*  ID      (input) CHARACTER*1\n*          = 'I': sort D in increasing order;\n*          = 'D': sort D in decreasing order.\n*\n*  N       (input) INTEGER\n*          The length of the array D.\n*\n*  D       (input/output) DOUBLE PRECISION array, dimension (N)\n*          On entry, the array to be sorted.\n*          On exit, D has been sorted into increasing order\n*          (D(1) <= ... <= D(N) ) or into decreasing order\n*          (D(1) >= ... >= D(N) ), depending on ID.\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, d = NumRu::Lapack.dlasrt( id, d, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 2 && argc != 2)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 2)", argc);
-  rblapack_id = argv[0];
-  rblapack_d = argv[1];
-  if (argc == 2) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  id = StringValueCStr(rblapack_id)[0];
-  if (!NA_IsNArray(rblapack_d))
-    rb_raise(rb_eArgError, "d (2th argument) must be NArray");
-  if (NA_RANK(rblapack_d) != 1)
-    rb_raise(rb_eArgError, "rank of d (2th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_d);
-  if (NA_TYPE(rblapack_d) != NA_DFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, doublereal*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_d_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  d_out__ = NA_PTR_TYPE(rblapack_d_out__, doublereal*);
-  MEMCPY(d_out__, d, doublereal, NA_TOTAL(rblapack_d));
-  rblapack_d = rblapack_d_out__;
-  d = d_out__;
-
-  dlasrt_(&id, &n, d, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_d);
-}
-
-void
-init_lapack_dlasrt(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dlasrt", rblapack_dlasrt, -1);
-}