ruby-lapack 1.6 → 1.7

data/ext/slarrf.c

@@ -1,176 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slarrf_(integer* n, real* d, real* l, real* ld, integer* clstrt, integer* clend, real* w, real* wgap, real* werr, real* spdiam, real* clgapl, real* clgapr, real* pivmin, real* sigma, real* dplus, real* lplus, real* work, integer* info);
-
-
-static VALUE
-rblapack_slarrf(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_l;
-  real *l; 
-  VALUE rblapack_ld;
-  real *ld; 
-  VALUE rblapack_clstrt;
-  integer clstrt; 
-  VALUE rblapack_clend;
-  integer clend; 
-  VALUE rblapack_w;
-  real *w; 
-  VALUE rblapack_wgap;
-  real *wgap; 
-  VALUE rblapack_werr;
-  real *werr; 
-  VALUE rblapack_spdiam;
-  real spdiam; 
-  VALUE rblapack_clgapl;
-  real clgapl; 
-  VALUE rblapack_clgapr;
-  real clgapr; 
-  VALUE rblapack_pivmin;
-  real pivmin; 
-  VALUE rblapack_sigma;
-  real sigma; 
-  VALUE rblapack_dplus;
-  real *dplus; 
-  VALUE rblapack_lplus;
-  real *lplus; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_wgap_out__;
-  real *wgap_out__;
-  real *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.slarrf( d, l, ld, clstrt, clend, w, wgap, werr, spdiam, clgapl, clgapr, pivmin, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLARRF( 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 ), SLARRF 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) REAL array, dimension (N)\n*          The N diagonal elements of the diagonal matrix D.\n*\n*  L       (input) REAL array, dimension (N-1)\n*          The (N-1) subdiagonal elements of the unit bidiagonal\n*          matrix L.\n*\n*  LD      (input) REAL 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) REAL 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) REAL array, dimension\n*          dimension is >=  (CLEND-CLSTRT+1)\n*          The separation from the right neighbor eigenvalue in W.\n*\n*  WERR    (input) REAL 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) REAL\n*          estimate of the spectral diameter obtained from the\n*          Gerschgorin intervals\n*\n*  CLGAPL  (input) REAL\n*\n*  CLGAPR  (input) REAL\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) REAL\n*          The minimum pivot allowed in the Sturm sequence.\n*\n*  SIGMA   (output) REAL            \n*          The shift used to form L(+) D(+) L(+)^T.\n*\n*  DPLUS   (output) REAL             array, dimension (N)\n*          The N diagonal elements of the diagonal matrix D(+).\n*\n*  LPLUS   (output) REAL             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) REAL array, dimension (2*N)\n*          Workspace.\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.slarrf( 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_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  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_SFLOAT)
-    rblapack_ld = na_change_type(rblapack_ld, NA_SFLOAT);
-  ld = NA_PTR_TYPE(rblapack_ld, real*);
-  clend = NUM2INT(rblapack_clend);
-  spdiam = (real)NUM2DBL(rblapack_spdiam);
-  clgapr = (real)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_SFLOAT)
-    rblapack_l = na_change_type(rblapack_l, NA_SFLOAT);
-  l = NA_PTR_TYPE(rblapack_l, real*);
-  clgapl = (real)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_SFLOAT)
-    rblapack_wgap = na_change_type(rblapack_wgap, NA_SFLOAT);
-  wgap = NA_PTR_TYPE(rblapack_wgap, real*);
-  pivmin = (real)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_SFLOAT)
-    rblapack_w = na_change_type(rblapack_w, NA_SFLOAT);
-  w = NA_PTR_TYPE(rblapack_w, real*);
-  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_SFLOAT)
-    rblapack_werr = na_change_type(rblapack_werr, NA_SFLOAT);
-  werr = NA_PTR_TYPE(rblapack_werr, real*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_dplus = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  dplus = NA_PTR_TYPE(rblapack_dplus, real*);
-  {
-    int shape[1];
-    shape[0] = n-1;
-    rblapack_lplus = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  lplus = NA_PTR_TYPE(rblapack_lplus, real*);
-  {
-    int shape[1];
-    shape[0] = clend-clstrt+1;
-    rblapack_wgap_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  wgap_out__ = NA_PTR_TYPE(rblapack_wgap_out__, real*);
-  MEMCPY(wgap_out__, wgap, real, NA_TOTAL(rblapack_wgap));
-  rblapack_wgap = rblapack_wgap_out__;
-  wgap = wgap_out__;
-  work = ALLOC_N(real, (2*n));
-
-  slarrf_(&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_slarrf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slarrf", rblapack_slarrf, -1);
-}

data/ext/slarrj.c

@@ -1,147 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slarrj_(integer* n, real* d, real* e2, integer* ifirst, integer* ilast, real* rtol, integer* offset, real* w, real* werr, real* work, integer* iwork, real* pivmin, real* spdiam, integer* info);
-
-
-static VALUE
-rblapack_slarrj(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_e2;
-  real *e2; 
-  VALUE rblapack_ifirst;
-  integer ifirst; 
-  VALUE rblapack_ilast;
-  integer ilast; 
-  VALUE rblapack_rtol;
-  real rtol; 
-  VALUE rblapack_offset;
-  integer offset; 
-  VALUE rblapack_w;
-  real *w; 
-  VALUE rblapack_werr;
-  real *werr; 
-  VALUE rblapack_pivmin;
-  real pivmin; 
-  VALUE rblapack_spdiam;
-  real spdiam; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_w_out__;
-  real *w_out__;
-  VALUE rblapack_werr_out__;
-  real *werr_out__;
-  real *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.slarrj( d, e2, ifirst, ilast, rtol, offset, w, werr, pivmin, spdiam, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLARRJ( 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, SLARRJ\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) REAL             array, dimension (N)\n*          The N diagonal elements of T.\n*\n*  E2      (input) REAL             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) REAL            \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) REAL             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) REAL             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) REAL             array, dimension (2*N)\n*          Workspace.\n*\n*  IWORK   (workspace) INTEGER array, dimension (2*N)\n*          Workspace.\n*\n*  PIVMIN  (input) REAL\n*          The minimum pivot in the Sturm sequence for T.\n*\n*  SPDIAM  (input) REAL\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.slarrj( 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_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  ifirst = NUM2INT(rblapack_ifirst);
-  rtol = (real)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_SFLOAT)
-    rblapack_w = na_change_type(rblapack_w, NA_SFLOAT);
-  w = NA_PTR_TYPE(rblapack_w, real*);
-  pivmin = (real)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_SFLOAT)
-    rblapack_werr = na_change_type(rblapack_werr, NA_SFLOAT);
-  werr = NA_PTR_TYPE(rblapack_werr, real*);
-  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_SFLOAT)
-    rblapack_e2 = na_change_type(rblapack_e2, NA_SFLOAT);
-  e2 = NA_PTR_TYPE(rblapack_e2, real*);
-  spdiam = (real)NUM2DBL(rblapack_spdiam);
-  offset = NUM2INT(rblapack_offset);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_w_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  w_out__ = NA_PTR_TYPE(rblapack_w_out__, real*);
-  MEMCPY(w_out__, w, real, NA_TOTAL(rblapack_w));
-  rblapack_w = rblapack_w_out__;
-  w = w_out__;
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_werr_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  werr_out__ = NA_PTR_TYPE(rblapack_werr_out__, real*);
-  MEMCPY(werr_out__, werr, real, NA_TOTAL(rblapack_werr));
-  rblapack_werr = rblapack_werr_out__;
-  werr = werr_out__;
-  work = ALLOC_N(real, (2*n));
-  iwork = ALLOC_N(integer, (2*n));
-
-  slarrj_(&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_slarrj(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slarrj", rblapack_slarrj, -1);
-}

data/ext/slarrk.c

@@ -1,97 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slarrk_(integer* n, integer* iw, real* gl, real* gu, real* d, real* e2, real* pivmin, real* reltol, real* w, real* werr, integer* info);
-
-
-static VALUE
-rblapack_slarrk(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_iw;
-  integer iw; 
-  VALUE rblapack_gl;
-  real gl; 
-  VALUE rblapack_gu;
-  real gu; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_e2;
-  real *e2; 
-  VALUE rblapack_pivmin;
-  real pivmin; 
-  VALUE rblapack_reltol;
-  real reltol; 
-  VALUE rblapack_w;
-  real w; 
-  VALUE rblapack_werr;
-  real 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.slarrk( iw, gl, gu, d, e2, pivmin, reltol, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLARRK( N, IW, GL, GU, D, E2, PIVMIN, RELTOL, W, WERR, INFO)\n\n*  Purpose\n*  =======\n*\n*  SLARRK computes one eigenvalue of a symmetric tridiagonal\n*  matrix T to suitable accuracy. This is an auxiliary code to be\n*  called from SSTEMR.\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) REAL            \n*  GU      (input) REAL            \n*          An upper and a lower bound on the eigenvalue.\n*\n*  D       (input) REAL             array, dimension (N)\n*          The n diagonal elements of the tridiagonal matrix T.\n*\n*  E2      (input) REAL             array, dimension (N-1)\n*          The (n-1) squared off-diagonal elements of the tridiagonal matrix T.\n*\n*  PIVMIN  (input) REAL            \n*          The minimum pivot allowed in the Sturm sequence for T.\n*\n*  RELTOL  (input) REAL            \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) REAL            \n*\n*  WERR    (output) REAL            \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   REAL            , 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.slarrk( 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 = (real)NUM2DBL(rblapack_gu);
-  pivmin = (real)NUM2DBL(rblapack_pivmin);
-  gl = (real)NUM2DBL(rblapack_gl);
-  reltol = (real)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_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  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_SFLOAT)
-    rblapack_e2 = na_change_type(rblapack_e2, NA_SFLOAT);
-  e2 = NA_PTR_TYPE(rblapack_e2, real*);
-
-  slarrk_(&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_slarrk(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slarrk", rblapack_slarrk, -1);
-}

data/ext/slarrr.c

@@ -1,82 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slarrr_(integer* n, real* d, real* e, integer* info);
-
-
-static VALUE
-rblapack_slarrr(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_e;
-  real *e; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_e_out__;
-  real *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.slarrr( d, e, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLARRR( 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) REAL             array, dimension (N)\n*          The N diagonal elements of the tridiagonal matrix T.\n*\n*  E       (input/output) REAL 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.slarrr( 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_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  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_SFLOAT)
-    rblapack_e = na_change_type(rblapack_e, NA_SFLOAT);
-  e = NA_PTR_TYPE(rblapack_e, real*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_e_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  e_out__ = NA_PTR_TYPE(rblapack_e_out__, real*);
-  MEMCPY(e_out__, e, real, NA_TOTAL(rblapack_e));
-  rblapack_e = rblapack_e_out__;
-  e = e_out__;
-
-  slarrr_(&n, d, e, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_e);
-}
-
-void
-init_lapack_slarrr(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slarrr", rblapack_slarrr, -1);
-}