ruby-lapack 1.7 → 1.7.1

data/ext/dlarrf.c

@@ -0,0 +1,176 @@
+#include "rb_lapack.h"
+
+extern VOID dlarrf_(integer* n, doublereal* d, doublereal* l, doublereal* ld, integer* clstrt, integer* clend, doublereal* w, doublereal* wgap, doublereal* werr, doublereal* spdiam, doublereal* clgapl, doublereal* clgapr, doublereal* pivmin, doublereal* sigma, doublereal* dplus, doublereal* lplus, doublereal* work, integer* info);
+
+
+static VALUE
+rblapack_dlarrf(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_l;
+  doublereal *l; 
+  VALUE rblapack_ld;
+  doublereal *ld; 
+  VALUE rblapack_clstrt;
+  integer clstrt; 
+  VALUE rblapack_clend;
+  integer clend; 
+  VALUE rblapack_w;
+  doublereal *w; 
+  VALUE rblapack_wgap;
+  doublereal *wgap; 
+  VALUE rblapack_werr;
+  doublereal *werr; 
+  VALUE rblapack_spdiam;
+  doublereal spdiam; 
+  VALUE rblapack_clgapl;
+  doublereal clgapl; 
+  VALUE rblapack_clgapr;
+  doublereal clgapr; 
+  VALUE rblapack_pivmin;
+  doublereal pivmin; 
+  VALUE rblapack_sigma;
+  doublereal sigma; 
+  VALUE rblapack_dplus;
+  doublereal *dplus; 
+  VALUE rblapack_lplus;
+  doublereal *lplus; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_wgap_out__;
+  doublereal *wgap_out__;
+  doublereal *work;
+
+  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  sigma, dplus, lplus, info, wgap = NumRu::Lapack.dlarrf( d, l, ld, clstrt, clend, w, wgap, werr, spdiam, clgapl, clgapr, pivmin, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLARRF( N, D, L, LD, CLSTRT, CLEND, W, WGAP, WERR, SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, DPLUS, LPLUS, WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  Given the initial representation L D L^T and its cluster of close\n*  eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...\n*  W( CLEND ), DLARRF finds a new relatively robust representation\n*  L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the\n*  eigenvalues of L(+) D(+) L(+)^T is relatively isolated.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the matrix (subblock, if the matrix splitted).\n*\n*  D       (input) DOUBLE PRECISION array, dimension (N)\n*          The N diagonal elements of the diagonal matrix D.\n*\n*  L       (input) DOUBLE PRECISION array, dimension (N-1)\n*          The (N-1) subdiagonal elements of the unit bidiagonal\n*          matrix L.\n*\n*  LD      (input) DOUBLE PRECISION array, dimension (N-1)\n*          The (N-1) elements L(i)*D(i).\n*\n*  CLSTRT  (input) INTEGER\n*          The index of the first eigenvalue in the cluster.\n*\n*  CLEND   (input) INTEGER\n*          The index of the last eigenvalue in the cluster.\n*\n*  W       (input) DOUBLE PRECISION array, dimension\n*          dimension is >=  (CLEND-CLSTRT+1)\n*          The eigenvalue APPROXIMATIONS of L D L^T in ascending order.\n*          W( CLSTRT ) through W( CLEND ) form the cluster of relatively\n*          close eigenalues.\n*\n*  WGAP    (input/output) DOUBLE PRECISION array, dimension\n*          dimension is >=  (CLEND-CLSTRT+1)\n*          The separation from the right neighbor eigenvalue in W.\n*\n*  WERR    (input) DOUBLE PRECISION array, dimension\n*          dimension is  >=  (CLEND-CLSTRT+1)\n*          WERR contain the semiwidth of the uncertainty\n*          interval of the corresponding eigenvalue APPROXIMATION in W\n*\n*  SPDIAM  (input) DOUBLE PRECISION\n*          estimate of the spectral diameter obtained from the\n*          Gerschgorin intervals\n*\n*  CLGAPL  (input) DOUBLE PRECISION\n*\n*  CLGAPR  (input) DOUBLE PRECISION\n*          absolute gap on each end of the cluster.\n*          Set by the calling routine to protect against shifts too close\n*          to eigenvalues outside the cluster.\n*\n*  PIVMIN  (input) DOUBLE PRECISION\n*          The minimum pivot allowed in the Sturm sequence.\n*\n*  SIGMA   (output) DOUBLE PRECISION\n*          The shift used to form L(+) D(+) L(+)^T.\n*\n*  DPLUS   (output) DOUBLE PRECISION array, dimension (N)\n*          The N diagonal elements of the diagonal matrix D(+).\n*\n*  LPLUS   (output) DOUBLE PRECISION array, dimension (N-1)\n*          The first (N-1) elements of LPLUS contain the subdiagonal\n*          elements of the unit bidiagonal matrix L(+).\n*\n*  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)\n*          Workspace.\n*\n*  INFO    (output) INTEGER\n*          Signals processing OK (=0) or failure (=1)\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Beresford Parlett, University of California, Berkeley, USA\n*     Jim Demmel, University of California, Berkeley, USA\n*     Inderjit Dhillon, University of Texas, Austin, USA\n*     Osni Marques, LBNL/NERSC, USA\n*     Christof Voemel, University of California, Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  sigma, dplus, lplus, info, wgap = NumRu::Lapack.dlarrf( d, l, ld, clstrt, clend, w, wgap, werr, spdiam, clgapl, clgapr, pivmin, [: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_d = argv[0];
+  rblapack_l = argv[1];
+  rblapack_ld = argv[2];
+  rblapack_clstrt = argv[3];
+  rblapack_clend = argv[4];
+  rblapack_w = argv[5];
+  rblapack_wgap = argv[6];
+  rblapack_werr = argv[7];
+  rblapack_spdiam = argv[8];
+  rblapack_clgapl = argv[9];
+  rblapack_clgapr = argv[10];
+  rblapack_pivmin = argv[11];
+  if (argc == 12) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_d))
+    rb_raise(rb_eArgError, "d (1th argument) must be NArray");
+  if (NA_RANK(rblapack_d) != 1)
+    rb_raise(rb_eArgError, "rank of d (1th 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*);
+  if (!NA_IsNArray(rblapack_ld))
+    rb_raise(rb_eArgError, "ld (3th argument) must be NArray");
+  if (NA_RANK(rblapack_ld) != 1)
+    rb_raise(rb_eArgError, "rank of ld (3th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_ld) != (n-1))
+    rb_raise(rb_eRuntimeError, "shape 0 of ld must be %d", n-1);
+  if (NA_TYPE(rblapack_ld) != NA_DFLOAT)
+    rblapack_ld = na_change_type(rblapack_ld, NA_DFLOAT);
+  ld = NA_PTR_TYPE(rblapack_ld, doublereal*);
+  clend = NUM2INT(rblapack_clend);
+  spdiam = NUM2DBL(rblapack_spdiam);
+  clgapr = NUM2DBL(rblapack_clgapr);
+  if (!NA_IsNArray(rblapack_l))
+    rb_raise(rb_eArgError, "l (2th argument) must be NArray");
+  if (NA_RANK(rblapack_l) != 1)
+    rb_raise(rb_eArgError, "rank of l (2th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_l) != (n-1))
+    rb_raise(rb_eRuntimeError, "shape 0 of l must be %d", n-1);
+  if (NA_TYPE(rblapack_l) != NA_DFLOAT)
+    rblapack_l = na_change_type(rblapack_l, NA_DFLOAT);
+  l = NA_PTR_TYPE(rblapack_l, doublereal*);
+  clgapl = NUM2DBL(rblapack_clgapl);
+  clstrt = NUM2INT(rblapack_clstrt);
+  if (!NA_IsNArray(rblapack_wgap))
+    rb_raise(rb_eArgError, "wgap (7th argument) must be NArray");
+  if (NA_RANK(rblapack_wgap) != 1)
+    rb_raise(rb_eArgError, "rank of wgap (7th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_wgap) != (clend-clstrt+1))
+    rb_raise(rb_eRuntimeError, "shape 0 of wgap must be %d", clend-clstrt+1);
+  if (NA_TYPE(rblapack_wgap) != NA_DFLOAT)
+    rblapack_wgap = na_change_type(rblapack_wgap, NA_DFLOAT);
+  wgap = NA_PTR_TYPE(rblapack_wgap, doublereal*);
+  pivmin = NUM2DBL(rblapack_pivmin);
+  if (!NA_IsNArray(rblapack_w))
+    rb_raise(rb_eArgError, "w (6th argument) must be NArray");
+  if (NA_RANK(rblapack_w) != 1)
+    rb_raise(rb_eArgError, "rank of w (6th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_w) != (clend-clstrt+1))
+    rb_raise(rb_eRuntimeError, "shape 0 of w must be %d", clend-clstrt+1);
+  if (NA_TYPE(rblapack_w) != NA_DFLOAT)
+    rblapack_w = na_change_type(rblapack_w, NA_DFLOAT);
+  w = NA_PTR_TYPE(rblapack_w, doublereal*);
+  if (!NA_IsNArray(rblapack_werr))
+    rb_raise(rb_eArgError, "werr (8th argument) must be NArray");
+  if (NA_RANK(rblapack_werr) != 1)
+    rb_raise(rb_eArgError, "rank of werr (8th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_werr) != (clend-clstrt+1))
+    rb_raise(rb_eRuntimeError, "shape 0 of werr must be %d", clend-clstrt+1);
+  if (NA_TYPE(rblapack_werr) != NA_DFLOAT)
+    rblapack_werr = na_change_type(rblapack_werr, NA_DFLOAT);
+  werr = NA_PTR_TYPE(rblapack_werr, doublereal*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_dplus = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  dplus = NA_PTR_TYPE(rblapack_dplus, doublereal*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n-1;
+    rblapack_lplus = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  lplus = NA_PTR_TYPE(rblapack_lplus, doublereal*);
+  {
+    na_shape_t shape[1];
+    shape[0] = clend-clstrt+1;
+    rblapack_wgap_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  wgap_out__ = NA_PTR_TYPE(rblapack_wgap_out__, doublereal*);
+  MEMCPY(wgap_out__, wgap, doublereal, NA_TOTAL(rblapack_wgap));
+  rblapack_wgap = rblapack_wgap_out__;
+  wgap = wgap_out__;
+  work = ALLOC_N(doublereal, (2*n));
+
+  dlarrf_(&n, d, l, ld, &clstrt, &clend, w, wgap, werr, &spdiam, &clgapl, &clgapr, &pivmin, &sigma, dplus, lplus, work, &info);
+
+  free(work);
+  rblapack_sigma = rb_float_new((double)sigma);
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(5, rblapack_sigma, rblapack_dplus, rblapack_lplus, rblapack_info, rblapack_wgap);
+}
+
+void
+init_lapack_dlarrf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlarrf", rblapack_dlarrf, -1);
+}

data/ext/dlarrj.c

@@ -0,0 +1,147 @@
+#include "rb_lapack.h"
+
+extern VOID dlarrj_(integer* n, doublereal* d, doublereal* e2, integer* ifirst, integer* ilast, doublereal* rtol, integer* offset, doublereal* w, doublereal* werr, doublereal* work, integer* iwork, doublereal* pivmin, doublereal* spdiam, integer* info);
+
+
+static VALUE
+rblapack_dlarrj(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_e2;
+  doublereal *e2; 
+  VALUE rblapack_ifirst;
+  integer ifirst; 
+  VALUE rblapack_ilast;
+  integer ilast; 
+  VALUE rblapack_rtol;
+  doublereal rtol; 
+  VALUE rblapack_offset;
+  integer offset; 
+  VALUE rblapack_w;
+  doublereal *w; 
+  VALUE rblapack_werr;
+  doublereal *werr; 
+  VALUE rblapack_pivmin;
+  doublereal pivmin; 
+  VALUE rblapack_spdiam;
+  doublereal spdiam; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_w_out__;
+  doublereal *w_out__;
+  VALUE rblapack_werr_out__;
+  doublereal *werr_out__;
+  doublereal *work;
+  integer *iwork;
+
+  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, w, werr = NumRu::Lapack.dlarrj( d, e2, ifirst, ilast, rtol, offset, w, werr, pivmin, spdiam, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO )\n\n*  Purpose\n*  =======\n*\n*  Given the initial eigenvalue approximations of T, DLARRJ\n*  does  bisection to refine the eigenvalues of T,\n*  W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial\n*  guesses for these eigenvalues are input in W, the corresponding estimate\n*  of the error in these guesses in WERR. During bisection, intervals\n*  [left, right] are maintained by storing their mid-points and\n*  semi-widths in the arrays W and WERR respectively.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the matrix.\n*\n*  D       (input) DOUBLE PRECISION array, dimension (N)\n*          The N diagonal elements of T.\n*\n*  E2      (input) DOUBLE PRECISION array, dimension (N-1)\n*          The Squares of the (N-1) subdiagonal elements of T.\n*\n*  IFIRST  (input) INTEGER\n*          The index of the first eigenvalue to be computed.\n*\n*  ILAST   (input) INTEGER\n*          The index of the last eigenvalue to be computed.\n*\n*  RTOL    (input) DOUBLE PRECISION\n*          Tolerance for the convergence of the bisection intervals.\n*          An interval [LEFT,RIGHT] has converged if\n*          RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|).\n*\n*  OFFSET  (input) INTEGER\n*          Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET\n*          through ILAST-OFFSET elements of these arrays are to be used.\n*\n*  W       (input/output) DOUBLE PRECISION array, dimension (N)\n*          On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are\n*          estimates of the eigenvalues of L D L^T indexed IFIRST through\n*          ILAST.\n*          On output, these estimates are refined.\n*\n*  WERR    (input/output) DOUBLE PRECISION array, dimension (N)\n*          On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are\n*          the errors in the estimates of the corresponding elements in W.\n*          On output, these errors are refined.\n*\n*  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)\n*          Workspace.\n*\n*  IWORK   (workspace) INTEGER array, dimension (2*N)\n*          Workspace.\n*\n*  PIVMIN  (input) DOUBLE PRECISION\n*          The minimum pivot in the Sturm sequence for T.\n*\n*  SPDIAM  (input) DOUBLE PRECISION\n*          The spectral diameter of T.\n*\n*  INFO    (output) INTEGER\n*          Error flag.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Beresford Parlett, University of California, Berkeley, USA\n*     Jim Demmel, University of California, Berkeley, USA\n*     Inderjit Dhillon, University of Texas, Austin, USA\n*     Osni Marques, LBNL/NERSC, USA\n*     Christof Voemel, University of California, Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  info, w, werr = NumRu::Lapack.dlarrj( d, e2, ifirst, ilast, rtol, offset, w, werr, pivmin, spdiam, [:usage => usage, :help => help])\n");
+      return Qnil;
+    } 
+  } else
+    rblapack_options = Qnil;
+  if (argc != 10 && argc != 10)
+    rb_raise(rb_eArgError,"wrong number of arguments (%d for 10)", argc);
+  rblapack_d = argv[0];
+  rblapack_e2 = argv[1];
+  rblapack_ifirst = argv[2];
+  rblapack_ilast = argv[3];
+  rblapack_rtol = argv[4];
+  rblapack_offset = argv[5];
+  rblapack_w = argv[6];
+  rblapack_werr = argv[7];
+  rblapack_pivmin = argv[8];
+  rblapack_spdiam = argv[9];
+  if (argc == 10) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_d))
+    rb_raise(rb_eArgError, "d (1th argument) must be NArray");
+  if (NA_RANK(rblapack_d) != 1)
+    rb_raise(rb_eArgError, "rank of d (1th 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*);
+  ifirst = NUM2INT(rblapack_ifirst);
+  rtol = NUM2DBL(rblapack_rtol);
+  if (!NA_IsNArray(rblapack_w))
+    rb_raise(rb_eArgError, "w (7th argument) must be NArray");
+  if (NA_RANK(rblapack_w) != 1)
+    rb_raise(rb_eArgError, "rank of w (7th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_w) != n)
+    rb_raise(rb_eRuntimeError, "shape 0 of w must be the same as shape 0 of d");
+  if (NA_TYPE(rblapack_w) != NA_DFLOAT)
+    rblapack_w = na_change_type(rblapack_w, NA_DFLOAT);
+  w = NA_PTR_TYPE(rblapack_w, doublereal*);
+  pivmin = NUM2DBL(rblapack_pivmin);
+  ilast = NUM2INT(rblapack_ilast);
+  if (!NA_IsNArray(rblapack_werr))
+    rb_raise(rb_eArgError, "werr (8th argument) must be NArray");
+  if (NA_RANK(rblapack_werr) != 1)
+    rb_raise(rb_eArgError, "rank of werr (8th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_werr) != n)
+    rb_raise(rb_eRuntimeError, "shape 0 of werr must be the same as shape 0 of d");
+  if (NA_TYPE(rblapack_werr) != NA_DFLOAT)
+    rblapack_werr = na_change_type(rblapack_werr, NA_DFLOAT);
+  werr = NA_PTR_TYPE(rblapack_werr, doublereal*);
+  if (!NA_IsNArray(rblapack_e2))
+    rb_raise(rb_eArgError, "e2 (2th argument) must be NArray");
+  if (NA_RANK(rblapack_e2) != 1)
+    rb_raise(rb_eArgError, "rank of e2 (2th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_e2) != (n-1))
+    rb_raise(rb_eRuntimeError, "shape 0 of e2 must be %d", n-1);
+  if (NA_TYPE(rblapack_e2) != NA_DFLOAT)
+    rblapack_e2 = na_change_type(rblapack_e2, NA_DFLOAT);
+  e2 = NA_PTR_TYPE(rblapack_e2, doublereal*);
+  spdiam = NUM2DBL(rblapack_spdiam);
+  offset = NUM2INT(rblapack_offset);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_w_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  w_out__ = NA_PTR_TYPE(rblapack_w_out__, doublereal*);
+  MEMCPY(w_out__, w, doublereal, NA_TOTAL(rblapack_w));
+  rblapack_w = rblapack_w_out__;
+  w = w_out__;
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_werr_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  werr_out__ = NA_PTR_TYPE(rblapack_werr_out__, doublereal*);
+  MEMCPY(werr_out__, werr, doublereal, NA_TOTAL(rblapack_werr));
+  rblapack_werr = rblapack_werr_out__;
+  werr = werr_out__;
+  work = ALLOC_N(doublereal, (2*n));
+  iwork = ALLOC_N(integer, (2*n));
+
+  dlarrj_(&n, d, e2, &ifirst, &ilast, &rtol, &offset, w, werr, work, iwork, &pivmin, &spdiam, &info);
+
+  free(work);
+  free(iwork);
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(3, rblapack_info, rblapack_w, rblapack_werr);
+}
+
+void
+init_lapack_dlarrj(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlarrj", rblapack_dlarrj, -1);
+}

data/ext/dlarrk.c

@@ -0,0 +1,97 @@
+#include "rb_lapack.h"
+
+extern VOID dlarrk_(integer* n, integer* iw, doublereal* gl, doublereal* gu, doublereal* d, doublereal* e2, doublereal* pivmin, doublereal* reltol, doublereal* w, doublereal* werr, integer* info);
+
+
+static VALUE
+rblapack_dlarrk(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_iw;
+  integer iw; 
+  VALUE rblapack_gl;
+  doublereal gl; 
+  VALUE rblapack_gu;
+  doublereal gu; 
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_e2;
+  doublereal *e2; 
+  VALUE rblapack_pivmin;
+  doublereal pivmin; 
+  VALUE rblapack_reltol;
+  doublereal reltol; 
+  VALUE rblapack_w;
+  doublereal w; 
+  VALUE rblapack_werr;
+  doublereal werr; 
+  VALUE rblapack_info;
+  integer info; 
+
+  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  w, werr, info = NumRu::Lapack.dlarrk( iw, gl, gu, d, e2, pivmin, reltol, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLARRK( N, IW, GL, GU, D, E2, PIVMIN, RELTOL, W, WERR, INFO)\n\n*  Purpose\n*  =======\n*\n*  DLARRK computes one eigenvalue of a symmetric tridiagonal\n*  matrix T to suitable accuracy. This is an auxiliary code to be\n*  called from DSTEMR.\n*\n*  To avoid overflow, the matrix must be scaled so that its\n*  largest element is no greater than overflow**(1/2) *\n*  underflow**(1/4) in absolute value, and for greatest\n*  accuracy, it should not be much smaller than that.\n*\n*  See W. Kahan \"Accurate Eigenvalues of a Symmetric Tridiagonal\n*  Matrix\", Report CS41, Computer Science Dept., Stanford\n*  University, July 21, 1966.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the tridiagonal matrix T.  N >= 0.\n*\n*  IW      (input) INTEGER\n*          The index of the eigenvalues to be returned.\n*\n*  GL      (input) DOUBLE PRECISION\n*  GU      (input) DOUBLE PRECISION\n*          An upper and a lower bound on the eigenvalue.\n*\n*  D       (input) DOUBLE PRECISION array, dimension (N)\n*          The n diagonal elements of the tridiagonal matrix T.\n*\n*  E2      (input) DOUBLE PRECISION array, dimension (N-1)\n*          The (n-1) squared off-diagonal elements of the tridiagonal matrix T.\n*\n*  PIVMIN  (input) DOUBLE PRECISION\n*          The minimum pivot allowed in the Sturm sequence for T.\n*\n*  RELTOL  (input) DOUBLE PRECISION\n*          The minimum relative width of an interval.  When an interval\n*          is narrower than RELTOL times the larger (in\n*          magnitude) endpoint, then it is considered to be\n*          sufficiently small, i.e., converged.  Note: this should\n*          always be at least radix*machine epsilon.\n*\n*  W       (output) DOUBLE PRECISION\n*\n*  WERR    (output) DOUBLE PRECISION\n*          The error bound on the corresponding eigenvalue approximation\n*          in W.\n*\n*  INFO    (output) INTEGER\n*          = 0:       Eigenvalue converged\n*          = -1:      Eigenvalue did NOT converge\n*\n*  Internal Parameters\n*  ===================\n*\n*  FUDGE   DOUBLE PRECISION, default = 2\n*          A \"fudge factor\" to widen the Gershgorin intervals.\n*\n\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  w, werr, info = NumRu::Lapack.dlarrk( iw, gl, gu, d, e2, pivmin, reltol, [: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_iw = argv[0];
+  rblapack_gl = argv[1];
+  rblapack_gu = argv[2];
+  rblapack_d = argv[3];
+  rblapack_e2 = argv[4];
+  rblapack_pivmin = argv[5];
+  rblapack_reltol = argv[6];
+  if (argc == 7) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  iw = NUM2INT(rblapack_iw);
+  gu = NUM2DBL(rblapack_gu);
+  pivmin = NUM2DBL(rblapack_pivmin);
+  gl = NUM2DBL(rblapack_gl);
+  reltol = NUM2DBL(rblapack_reltol);
+  if (!NA_IsNArray(rblapack_d))
+    rb_raise(rb_eArgError, "d (4th argument) must be NArray");
+  if (NA_RANK(rblapack_d) != 1)
+    rb_raise(rb_eArgError, "rank of d (4th 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*);
+  if (!NA_IsNArray(rblapack_e2))
+    rb_raise(rb_eArgError, "e2 (5th argument) must be NArray");
+  if (NA_RANK(rblapack_e2) != 1)
+    rb_raise(rb_eArgError, "rank of e2 (5th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_e2) != (n-1))
+    rb_raise(rb_eRuntimeError, "shape 0 of e2 must be %d", n-1);
+  if (NA_TYPE(rblapack_e2) != NA_DFLOAT)
+    rblapack_e2 = na_change_type(rblapack_e2, NA_DFLOAT);
+  e2 = NA_PTR_TYPE(rblapack_e2, doublereal*);
+
+  dlarrk_(&n, &iw, &gl, &gu, d, e2, &pivmin, &reltol, &w, &werr, &info);
+
+  rblapack_w = rb_float_new((double)w);
+  rblapack_werr = rb_float_new((double)werr);
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(3, rblapack_w, rblapack_werr, rblapack_info);
+}
+
+void
+init_lapack_dlarrk(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlarrk", rblapack_dlarrk, -1);
+}

data/ext/dlarrr.c

@@ -0,0 +1,82 @@
+#include "rb_lapack.h"
+
+extern VOID dlarrr_(integer* n, doublereal* d, doublereal* e, integer* info);
+
+
+static VALUE
+rblapack_dlarrr(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_e;
+  doublereal *e; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_e_out__;
+  doublereal *e_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, e = NumRu::Lapack.dlarrr( d, e, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLARRR( N, D, E, INFO )\n\n*  Purpose\n*  =======\n*\n*  Perform tests to decide whether the symmetric tridiagonal matrix T\n*  warrants expensive computations which guarantee high relative accuracy\n*  in the eigenvalues.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the matrix. N > 0.\n*\n*  D       (input) DOUBLE PRECISION array, dimension (N)\n*          The N diagonal elements of the tridiagonal matrix T.\n*\n*  E       (input/output) DOUBLE PRECISION array, dimension (N)\n*          On entry, the first (N-1) entries contain the subdiagonal\n*          elements of the tridiagonal matrix T; E(N) is set to ZERO.\n*\n*  INFO    (output) INTEGER\n*          INFO = 0(default) : the matrix warrants computations preserving\n*                              relative accuracy.\n*          INFO = 1          : the matrix warrants computations guaranteeing\n*                              only absolute accuracy.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Beresford Parlett, University of California, Berkeley, USA\n*     Jim Demmel, University of California, Berkeley, USA\n*     Inderjit Dhillon, University of Texas, Austin, USA\n*     Osni Marques, LBNL/NERSC, USA\n*     Christof Voemel, University of California, Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  info, e = NumRu::Lapack.dlarrr( d, e, [: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_d = argv[0];
+  rblapack_e = argv[1];
+  if (argc == 2) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_d))
+    rb_raise(rb_eArgError, "d (1th argument) must be NArray");
+  if (NA_RANK(rblapack_d) != 1)
+    rb_raise(rb_eArgError, "rank of d (1th 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*);
+  if (!NA_IsNArray(rblapack_e))
+    rb_raise(rb_eArgError, "e (2th argument) must be NArray");
+  if (NA_RANK(rblapack_e) != 1)
+    rb_raise(rb_eArgError, "rank of e (2th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_e) != n)
+    rb_raise(rb_eRuntimeError, "shape 0 of e must be the same as shape 0 of d");
+  if (NA_TYPE(rblapack_e) != NA_DFLOAT)
+    rblapack_e = na_change_type(rblapack_e, NA_DFLOAT);
+  e = NA_PTR_TYPE(rblapack_e, doublereal*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_e_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  e_out__ = NA_PTR_TYPE(rblapack_e_out__, doublereal*);
+  MEMCPY(e_out__, e, doublereal, NA_TOTAL(rblapack_e));
+  rblapack_e = rblapack_e_out__;
+  e = e_out__;
+
+  dlarrr_(&n, d, e, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(2, rblapack_info, rblapack_e);
+}
+
+void
+init_lapack_dlarrr(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlarrr", rblapack_dlarrr, -1);
+}