ruby-lapack 1.6 → 1.7

data/ext/slaed3.c

@@ -1,161 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaed3_(integer* k, integer* n, integer* n1, real* d, real* q, integer* ldq, real* rho, real* dlamda, real* q2, integer* indx, integer* ctot, real* w, real* s, integer* info);
-
-
-static VALUE
-rblapack_slaed3(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_n1;
-  integer n1; 
-  VALUE rblapack_rho;
-  real rho; 
-  VALUE rblapack_dlamda;
-  real *dlamda; 
-  VALUE rblapack_q2;
-  real *q2; 
-  VALUE rblapack_indx;
-  integer *indx; 
-  VALUE rblapack_ctot;
-  integer *ctot; 
-  VALUE rblapack_w;
-  real *w; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_q;
-  real *q; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_dlamda_out__;
-  real *dlamda_out__;
-  VALUE rblapack_w_out__;
-  real *w_out__;
-  real *s;
-
-  integer k;
-  integer n;
-  integer ldq;
-
-  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  d, q, info, dlamda, w = NumRu::Lapack.slaed3( n1, rho, dlamda, q2, indx, ctot, w, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, CTOT, W, S, INFO )\n\n*  Purpose\n*  =======\n*\n*  SLAED3 finds the roots of the secular equation, as defined by the\n*  values in D, W, and RHO, between 1 and K.  It makes the\n*  appropriate calls to SLAED4 and then updates the eigenvectors by\n*  multiplying the matrix of eigenvectors of the pair of eigensystems\n*  being combined by the matrix of eigenvectors of the K-by-K system\n*  which is solved here.\n*\n*  This code makes very mild assumptions about floating point\n*  arithmetic. It will work on machines with a guard digit in\n*  add/subtract, or on those binary machines without guard digits\n*  which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.\n*  It could conceivably fail on hexadecimal or decimal machines\n*  without guard digits, but we know of none.\n*\n\n*  Arguments\n*  =========\n*\n*  K       (input) INTEGER\n*          The number of terms in the rational function to be solved by\n*          SLAED4.  K >= 0.\n*\n*  N       (input) INTEGER\n*          The number of rows and columns in the Q matrix.\n*          N >= K (deflation may result in N>K).\n*\n*  N1      (input) INTEGER\n*          The location of the last eigenvalue in the leading submatrix.\n*          min(1,N) <= N1 <= N/2.\n*\n*  D       (output) REAL array, dimension (N)\n*          D(I) contains the updated eigenvalues for\n*          1 <= I <= K.\n*\n*  Q       (output) REAL array, dimension (LDQ,N)\n*          Initially the first K columns are used as workspace.\n*          On output the columns 1 to K contain\n*          the updated eigenvectors.\n*\n*  LDQ     (input) INTEGER\n*          The leading dimension of the array Q.  LDQ >= max(1,N).\n*\n*  RHO     (input) REAL\n*          The value of the parameter in the rank one update equation.\n*          RHO >= 0 required.\n*\n*  DLAMDA  (input/output) REAL array, dimension (K)\n*          The first K elements of this array contain the old roots\n*          of the deflated updating problem.  These are the poles\n*          of the secular equation. May be changed on output by\n*          having lowest order bit set to zero on Cray X-MP, Cray Y-MP,\n*          Cray-2, or Cray C-90, as described above.\n*\n*  Q2      (input) REAL array, dimension (LDQ2, N)\n*          The first K columns of this matrix contain the non-deflated\n*          eigenvectors for the split problem.\n*\n*  INDX    (input) INTEGER array, dimension (N)\n*          The permutation used to arrange the columns of the deflated\n*          Q matrix into three groups (see SLAED2).\n*          The rows of the eigenvectors found by SLAED4 must be likewise\n*          permuted before the matrix multiply can take place.\n*\n*  CTOT    (input) INTEGER array, dimension (4)\n*          A count of the total number of the various types of columns\n*          in Q, as described in INDX.  The fourth column type is any\n*          column which has been deflated.\n*\n*  W       (input/output) REAL array, dimension (K)\n*          The first K elements of this array contain the components\n*          of the deflation-adjusted updating vector. Destroyed on\n*          output.\n*\n*  S       (workspace) REAL array, dimension (N1 + 1)*K\n*          Will contain the eigenvectors of the repaired matrix which\n*          will be multiplied by the previously accumulated eigenvectors\n*          to update the system.\n*\n*  LDS     (input) INTEGER\n*          The leading dimension of S.  LDS >= max(1,K).\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit.\n*          < 0:  if INFO = -i, the i-th argument had an illegal value.\n*          > 0:  if INFO = 1, an eigenvalue did not converge\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Jeff Rutter, Computer Science Division, University of California\n*     at Berkeley, USA\n*  Modified by Francoise Tisseur, University of Tennessee.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  d, q, info, dlamda, w = NumRu::Lapack.slaed3( n1, rho, dlamda, q2, indx, ctot, w, [: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_n1 = argv[0];
-  rblapack_rho = argv[1];
-  rblapack_dlamda = argv[2];
-  rblapack_q2 = argv[3];
-  rblapack_indx = argv[4];
-  rblapack_ctot = argv[5];
-  rblapack_w = argv[6];
-  if (argc == 7) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  n1 = NUM2INT(rblapack_n1);
-  if (!NA_IsNArray(rblapack_dlamda))
-    rb_raise(rb_eArgError, "dlamda (3th argument) must be NArray");
-  if (NA_RANK(rblapack_dlamda) != 1)
-    rb_raise(rb_eArgError, "rank of dlamda (3th argument) must be %d", 1);
-  k = NA_SHAPE0(rblapack_dlamda);
-  if (NA_TYPE(rblapack_dlamda) != NA_SFLOAT)
-    rblapack_dlamda = na_change_type(rblapack_dlamda, NA_SFLOAT);
-  dlamda = NA_PTR_TYPE(rblapack_dlamda, real*);
-  if (!NA_IsNArray(rblapack_indx))
-    rb_raise(rb_eArgError, "indx (5th argument) must be NArray");
-  if (NA_RANK(rblapack_indx) != 1)
-    rb_raise(rb_eArgError, "rank of indx (5th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_indx);
-  if (NA_TYPE(rblapack_indx) != NA_LINT)
-    rblapack_indx = na_change_type(rblapack_indx, NA_LINT);
-  indx = NA_PTR_TYPE(rblapack_indx, integer*);
-  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) != k)
-    rb_raise(rb_eRuntimeError, "shape 0 of w must be the same as shape 0 of dlamda");
-  if (NA_TYPE(rblapack_w) != NA_SFLOAT)
-    rblapack_w = na_change_type(rblapack_w, NA_SFLOAT);
-  w = NA_PTR_TYPE(rblapack_w, real*);
-  rho = (real)NUM2DBL(rblapack_rho);
-  if (!NA_IsNArray(rblapack_ctot))
-    rb_raise(rb_eArgError, "ctot (6th argument) must be NArray");
-  if (NA_RANK(rblapack_ctot) != 1)
-    rb_raise(rb_eArgError, "rank of ctot (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_ctot) != (4))
-    rb_raise(rb_eRuntimeError, "shape 0 of ctot must be %d", 4);
-  if (NA_TYPE(rblapack_ctot) != NA_LINT)
-    rblapack_ctot = na_change_type(rblapack_ctot, NA_LINT);
-  ctot = NA_PTR_TYPE(rblapack_ctot, integer*);
-  if (!NA_IsNArray(rblapack_q2))
-    rb_raise(rb_eArgError, "q2 (4th argument) must be NArray");
-  if (NA_RANK(rblapack_q2) != 2)
-    rb_raise(rb_eArgError, "rank of q2 (4th argument) must be %d", 2);
-  if (NA_SHAPE0(rblapack_q2) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of q2 must be the same as shape 0 of indx");
-  if (NA_SHAPE1(rblapack_q2) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of q2 must be the same as shape 0 of indx");
-  if (NA_TYPE(rblapack_q2) != NA_SFLOAT)
-    rblapack_q2 = na_change_type(rblapack_q2, NA_SFLOAT);
-  q2 = NA_PTR_TYPE(rblapack_q2, real*);
-  ldq = MAX(1,n);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_d = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  {
-    int shape[2];
-    shape[0] = ldq;
-    shape[1] = n;
-    rblapack_q = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  q = NA_PTR_TYPE(rblapack_q, real*);
-  {
-    int shape[1];
-    shape[0] = k;
-    rblapack_dlamda_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  dlamda_out__ = NA_PTR_TYPE(rblapack_dlamda_out__, real*);
-  MEMCPY(dlamda_out__, dlamda, real, NA_TOTAL(rblapack_dlamda));
-  rblapack_dlamda = rblapack_dlamda_out__;
-  dlamda = dlamda_out__;
-  {
-    int shape[1];
-    shape[0] = k;
-    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__;
-  s = ALLOC_N(real, (MAX(1,k))*(n1 + 1));
-
-  slaed3_(&k, &n, &n1, d, q, &ldq, &rho, dlamda, q2, indx, ctot, w, s, &info);
-
-  free(s);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(5, rblapack_d, rblapack_q, rblapack_info, rblapack_dlamda, rblapack_w);
-}
-
-void
-init_lapack_slaed3(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaed3", rblapack_slaed3, -1);
-}

data/ext/slaed4.c

@@ -1,90 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaed4_(integer* n, integer* i, real* d, real* z, real* delta, real* rho, real* dlam, integer* info);
-
-
-static VALUE
-rblapack_slaed4(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_i;
-  integer i; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_z;
-  real *z; 
-  VALUE rblapack_rho;
-  real rho; 
-  VALUE rblapack_delta;
-  real *delta; 
-  VALUE rblapack_dlam;
-  real dlam; 
-  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  delta, dlam, info = NumRu::Lapack.slaed4( i, d, z, rho, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )\n\n*  Purpose\n*  =======\n*\n*  This subroutine computes the I-th updated eigenvalue of a symmetric\n*  rank-one modification to a diagonal matrix whose elements are\n*  given in the array d, and that\n*\n*             D(i) < D(j)  for  i < j\n*\n*  and that RHO > 0.  This is arranged by the calling routine, and is\n*  no loss in generality.  The rank-one modified system is thus\n*\n*             diag( D )  +  RHO *  Z * Z_transpose.\n*\n*  where we assume the Euclidean norm of Z is 1.\n*\n*  The method consists of approximating the rational functions in the\n*  secular equation by simpler interpolating rational functions.\n*\n\n*  Arguments\n*  =========\n*\n*  N      (input) INTEGER\n*         The length of all arrays.\n*\n*  I      (input) INTEGER\n*         The index of the eigenvalue to be computed.  1 <= I <= N.\n*\n*  D      (input) REAL array, dimension (N)\n*         The original eigenvalues.  It is assumed that they are in\n*         order, D(I) < D(J)  for I < J.\n*\n*  Z      (input) REAL array, dimension (N)\n*         The components of the updating vector.\n*\n*  DELTA  (output) REAL array, dimension (N)\n*         If N .GT. 2, DELTA contains (D(j) - lambda_I) in its  j-th\n*         component.  If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5\n*         for detail. The vector DELTA contains the information necessary\n*         to construct the eigenvectors by SLAED3 and SLAED9.\n*\n*  RHO    (input) REAL\n*         The scalar in the symmetric updating formula.\n*\n*  DLAM   (output) REAL\n*         The computed lambda_I, the I-th updated eigenvalue.\n*\n*  INFO   (output) INTEGER\n*         = 0:  successful exit\n*         > 0:  if INFO = 1, the updating process failed.\n*\n*  Internal Parameters\n*  ===================\n*\n*  Logical variable ORGATI (origin-at-i?) is used for distinguishing\n*  whether D(i) or D(i+1) is treated as the origin.\n*\n*            ORGATI = .true.    origin at i\n*            ORGATI = .false.   origin at i+1\n*\n*   Logical variable SWTCH3 (switch-for-3-poles?) is for noting\n*   if we are working with THREE poles!\n*\n*   MAXIT is the maximum number of iterations allowed for each\n*   eigenvalue.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Ren-Cang Li, Computer Science Division, University of California\n*     at Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  delta, dlam, info = NumRu::Lapack.slaed4( i, d, z, rho, [: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_i = argv[0];
-  rblapack_d = argv[1];
-  rblapack_z = argv[2];
-  rblapack_rho = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  i = NUM2INT(rblapack_i);
-  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);
-  n = NA_SHAPE0(rblapack_z);
-  if (NA_TYPE(rblapack_z) != NA_SFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_SFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, real*);
-  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);
-  if (NA_SHAPE0(rblapack_d) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of d must be the same as shape 0 of z");
-  if (NA_TYPE(rblapack_d) != NA_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  rho = (real)NUM2DBL(rblapack_rho);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_delta = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  delta = NA_PTR_TYPE(rblapack_delta, real*);
-
-  slaed4_(&n, &i, d, z, delta, &rho, &dlam, &info);
-
-  rblapack_dlam = rb_float_new((double)dlam);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(3, rblapack_delta, rblapack_dlam, rblapack_info);
-}
-
-void
-init_lapack_slaed4(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaed4", rblapack_slaed4, -1);
-}

data/ext/slaed5.c

@@ -1,87 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaed5_(integer* i, real* d, real* z, real* delta, real* rho, real* dlam);
-
-
-static VALUE
-rblapack_slaed5(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_i;
-  integer i; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_z;
-  real *z; 
-  VALUE rblapack_rho;
-  real rho; 
-  VALUE rblapack_delta;
-  real *delta; 
-  VALUE rblapack_dlam;
-  real dlam; 
-
-
-  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  delta, dlam = NumRu::Lapack.slaed5( i, d, z, rho, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )\n\n*  Purpose\n*  =======\n*\n*  This subroutine computes the I-th eigenvalue of a symmetric rank-one\n*  modification of a 2-by-2 diagonal matrix\n*\n*             diag( D )  +  RHO *  Z * transpose(Z) .\n*\n*  The diagonal elements in the array D are assumed to satisfy\n*\n*             D(i) < D(j)  for  i < j .\n*\n*  We also assume RHO > 0 and that the Euclidean norm of the vector\n*  Z is one.\n*\n\n*  Arguments\n*  =========\n*\n*  I      (input) INTEGER\n*         The index of the eigenvalue to be computed.  I = 1 or I = 2.\n*\n*  D      (input) REAL array, dimension (2)\n*         The original eigenvalues.  We assume D(1) < D(2).\n*\n*  Z      (input) REAL array, dimension (2)\n*         The components of the updating vector.\n*\n*  DELTA  (output) REAL array, dimension (2)\n*         The vector DELTA contains the information necessary\n*         to construct the eigenvectors.\n*\n*  RHO    (input) REAL\n*         The scalar in the symmetric updating formula.\n*\n*  DLAM   (output) REAL\n*         The computed lambda_I, the I-th updated eigenvalue.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Ren-Cang Li, Computer Science Division, University of California\n*     at Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  delta, dlam = NumRu::Lapack.slaed5( i, d, z, rho, [: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_i = argv[0];
-  rblapack_d = argv[1];
-  rblapack_z = argv[2];
-  rblapack_rho = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  i = NUM2INT(rblapack_i);
-  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) != (2))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 2);
-  if (NA_TYPE(rblapack_z) != NA_SFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_SFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, real*);
-  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);
-  if (NA_SHAPE0(rblapack_d) != (2))
-    rb_raise(rb_eRuntimeError, "shape 0 of d must be %d", 2);
-  if (NA_TYPE(rblapack_d) != NA_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  rho = (real)NUM2DBL(rblapack_rho);
-  {
-    int shape[1];
-    shape[0] = 2;
-    rblapack_delta = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  delta = NA_PTR_TYPE(rblapack_delta, real*);
-
-  slaed5_(&i, d, z, delta, &rho, &dlam);
-
-  rblapack_dlam = rb_float_new((double)dlam);
-  return rb_ary_new3(2, rblapack_delta, rblapack_dlam);
-}
-
-void
-init_lapack_slaed5(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaed5", rblapack_slaed5, -1);
-}

data/ext/slaed6.c

@@ -1,90 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaed6_(integer* kniter, logical* orgati, real* rho, real* d, real* z, real* finit, real* tau, integer* info);
-
-
-static VALUE
-rblapack_slaed6(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_kniter;
-  integer kniter; 
-  VALUE rblapack_orgati;
-  logical orgati; 
-  VALUE rblapack_rho;
-  real rho; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_z;
-  real *z; 
-  VALUE rblapack_finit;
-  real finit; 
-  VALUE rblapack_tau;
-  real tau; 
-  VALUE rblapack_info;
-  integer info; 
-
-
-  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, info = NumRu::Lapack.slaed6( kniter, orgati, rho, d, z, finit, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )\n\n*  Purpose\n*  =======\n*\n*  SLAED6 computes the positive or negative root (closest to the origin)\n*  of\n*                   z(1)        z(2)        z(3)\n*  f(x) =   rho + --------- + ---------- + ---------\n*                  d(1)-x      d(2)-x      d(3)-x\n*\n*  It is assumed that\n*\n*        if ORGATI = .true. the root is between d(2) and d(3);\n*        otherwise it is between d(1) and d(2)\n*\n*  This routine will be called by SLAED4 when necessary. In most cases,\n*  the root sought is the smallest in magnitude, though it might not be\n*  in some extremely rare situations.\n*\n\n*  Arguments\n*  =========\n*\n*  KNITER       (input) INTEGER\n*               Refer to SLAED4 for its significance.\n*\n*  ORGATI       (input) LOGICAL\n*               If ORGATI is true, the needed root is between d(2) and\n*               d(3); otherwise it is between d(1) and d(2).  See\n*               SLAED4 for further details.\n*\n*  RHO          (input) REAL            \n*               Refer to the equation f(x) above.\n*\n*  D            (input) REAL array, dimension (3)\n*               D satisfies d(1) < d(2) < d(3).\n*\n*  Z            (input) REAL array, dimension (3)\n*               Each of the elements in z must be positive.\n*\n*  FINIT        (input) REAL            \n*               The value of f at 0. It is more accurate than the one\n*               evaluated inside this routine (if someone wants to do\n*               so).\n*\n*  TAU          (output) REAL            \n*               The root of the equation f(x).\n*\n*  INFO         (output) INTEGER\n*               = 0: successful exit\n*               > 0: if INFO = 1, failure to converge\n*\n\n*  Further Details\n*  ===============\n*\n*  30/06/99: Based on contributions by\n*     Ren-Cang Li, Computer Science Division, University of California\n*     at Berkeley, USA\n*\n*  10/02/03: This version has a few statements commented out for thread safety\n*     (machine parameters are computed on each entry). SJH.\n*\n*  05/10/06: Modified from a new version of Ren-Cang Li, use\n*     Gragg-Thornton-Warner cubic convergent scheme for better stability.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  tau, info = NumRu::Lapack.slaed6( kniter, orgati, rho, d, z, finit, [: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_kniter = argv[0];
-  rblapack_orgati = argv[1];
-  rblapack_rho = argv[2];
-  rblapack_d = argv[3];
-  rblapack_z = argv[4];
-  rblapack_finit = argv[5];
-  if (argc == 6) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  kniter = NUM2INT(rblapack_kniter);
-  rho = (real)NUM2DBL(rblapack_rho);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (5th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (5th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_z) != (3))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 3);
-  if (NA_TYPE(rblapack_z) != NA_SFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_SFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, real*);
-  orgati = (rblapack_orgati == Qtrue);
-  finit = (real)NUM2DBL(rblapack_finit);
-  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);
-  if (NA_SHAPE0(rblapack_d) != (3))
-    rb_raise(rb_eRuntimeError, "shape 0 of d must be %d", 3);
-  if (NA_TYPE(rblapack_d) != NA_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-
-  slaed6_(&kniter, &orgati, &rho, d, z, &finit, &tau, &info);
-
-  rblapack_tau = rb_float_new((double)tau);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_tau, rblapack_info);
-}
-
-void
-init_lapack_slaed6(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaed6", rblapack_slaed6, -1);
-}

data/ext/slaed7.c

@@ -1,248 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaed7_(integer* icompq, integer* n, integer* qsiz, integer* tlvls, integer* curlvl, integer* curpbm, real* d, real* q, integer* ldq, integer* indxq, real* rho, integer* cutpnt, real* qstore, integer* qptr, integer* prmptr, integer* perm, integer* givptr, integer* givcol, real* givnum, real* work, integer* iwork, integer* info);
-
-
-static VALUE
-rblapack_slaed7(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_icompq;
-  integer icompq; 
-  VALUE rblapack_qsiz;
-  integer qsiz; 
-  VALUE rblapack_tlvls;
-  integer tlvls; 
-  VALUE rblapack_curlvl;
-  integer curlvl; 
-  VALUE rblapack_curpbm;
-  integer curpbm; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_q;
-  real *q; 
-  VALUE rblapack_rho;
-  real rho; 
-  VALUE rblapack_cutpnt;
-  integer cutpnt; 
-  VALUE rblapack_qstore;
-  real *qstore; 
-  VALUE rblapack_qptr;
-  integer *qptr; 
-  VALUE rblapack_prmptr;
-  integer *prmptr; 
-  VALUE rblapack_perm;
-  integer *perm; 
-  VALUE rblapack_givptr;
-  integer *givptr; 
-  VALUE rblapack_givcol;
-  integer *givcol; 
-  VALUE rblapack_givnum;
-  real *givnum; 
-  VALUE rblapack_indxq;
-  integer *indxq; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_d_out__;
-  real *d_out__;
-  VALUE rblapack_q_out__;
-  real *q_out__;
-  VALUE rblapack_qstore_out__;
-  real *qstore_out__;
-  VALUE rblapack_qptr_out__;
-  integer *qptr_out__;
-  real *work;
-  integer *iwork;
-
-  integer n;
-  integer ldq;
-
-  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  indxq, info, d, q, qstore, qptr = NumRu::Lapack.slaed7( icompq, qsiz, tlvls, curlvl, curpbm, d, q, rho, cutpnt, qstore, qptr, prmptr, perm, givptr, givcol, givnum, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  SLAED7 computes the updated eigensystem of a diagonal\n*  matrix after modification by a rank-one symmetric matrix. This\n*  routine is used only for the eigenproblem which requires all\n*  eigenvalues and optionally eigenvectors of a dense symmetric matrix\n*  that has been reduced to tridiagonal form.  SLAED1 handles\n*  the case in which all eigenvalues and eigenvectors of a symmetric\n*  tridiagonal matrix are desired.\n*\n*    T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)\n*\n*     where Z = Q'u, u is a vector of length N with ones in the\n*     CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.\n*\n*     The eigenvectors of the original matrix are stored in Q, and the\n*     eigenvalues are in D.  The algorithm consists of three stages:\n*\n*        The first stage consists of deflating the size of the problem\n*        when there are multiple eigenvalues or if there is a zero in\n*        the Z vector.  For each such occurence the dimension of the\n*        secular equation problem is reduced by one.  This stage is\n*        performed by the routine SLAED8.\n*\n*        The second stage consists of calculating the updated\n*        eigenvalues. This is done by finding the roots of the secular\n*        equation via the routine SLAED4 (as called by SLAED9).\n*        This routine also calculates the eigenvectors of the current\n*        problem.\n*\n*        The final stage consists of computing the updated eigenvectors\n*        directly using the updated eigenvalues.  The eigenvectors for\n*        the current problem are multiplied with the eigenvectors from\n*        the overall problem.\n*\n\n*  Arguments\n*  =========\n*\n*  ICOMPQ  (input) INTEGER\n*          = 0:  Compute eigenvalues only.\n*          = 1:  Compute eigenvectors of original dense symmetric matrix\n*                also.  On entry, Q contains the orthogonal matrix used\n*                to reduce the original matrix to tridiagonal form.\n*\n*  N      (input) INTEGER\n*         The dimension of the symmetric tridiagonal matrix.  N >= 0.\n*\n*  QSIZ   (input) INTEGER\n*         The dimension of the orthogonal matrix used to reduce\n*         the full matrix to tridiagonal form.  QSIZ >= N if ICOMPQ = 1.\n*\n*  TLVLS  (input) INTEGER\n*         The total number of merging levels in the overall divide and\n*         conquer tree.\n*\n*  CURLVL (input) INTEGER\n*         The current level in the overall merge routine,\n*         0 <= CURLVL <= TLVLS.\n*\n*  CURPBM (input) INTEGER\n*         The current problem in the current level in the overall\n*         merge routine (counting from upper left to lower right).\n*\n*  D      (input/output) REAL array, dimension (N)\n*         On entry, the eigenvalues of the rank-1-perturbed matrix.\n*         On exit, the eigenvalues of the repaired matrix.\n*\n*  Q      (input/output) REAL array, dimension (LDQ, N)\n*         On entry, the eigenvectors of the rank-1-perturbed matrix.\n*         On exit, the eigenvectors of the repaired tridiagonal matrix.\n*\n*  LDQ    (input) INTEGER\n*         The leading dimension of the array Q.  LDQ >= max(1,N).\n*\n*  INDXQ  (output) INTEGER array, dimension (N)\n*         The permutation which will reintegrate the subproblem just\n*         solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )\n*         will be in ascending order.\n*\n*  RHO    (input) REAL\n*         The subdiagonal element used to create the rank-1\n*         modification.\n*\n*  CUTPNT (input) INTEGER\n*         Contains the location of the last eigenvalue in the leading\n*         sub-matrix.  min(1,N) <= CUTPNT <= N.\n*\n*  QSTORE (input/output) REAL array, dimension (N**2+1)\n*         Stores eigenvectors of submatrices encountered during\n*         divide and conquer, packed together. QPTR points to\n*         beginning of the submatrices.\n*\n*  QPTR   (input/output) INTEGER array, dimension (N+2)\n*         List of indices pointing to beginning of submatrices stored\n*         in QSTORE. The submatrices are numbered starting at the\n*         bottom left of the divide and conquer tree, from left to\n*         right and bottom to top.\n*\n*  PRMPTR (input) INTEGER array, dimension (N lg N)\n*         Contains a list of pointers which indicate where in PERM a\n*         level's permutation is stored.  PRMPTR(i+1) - PRMPTR(i)\n*         indicates the size of the permutation and also the size of\n*         the full, non-deflated problem.\n*\n*  PERM   (input) INTEGER array, dimension (N lg N)\n*         Contains the permutations (from deflation and sorting) to be\n*         applied to each eigenblock.\n*\n*  GIVPTR (input) INTEGER array, dimension (N lg N)\n*         Contains a list of pointers which indicate where in GIVCOL a\n*         level's Givens rotations are stored.  GIVPTR(i+1) - GIVPTR(i)\n*         indicates the number of Givens rotations.\n*\n*  GIVCOL (input) INTEGER array, dimension (2, N lg N)\n*         Each pair of numbers indicates a pair of columns to take place\n*         in a Givens rotation.\n*\n*  GIVNUM (input) REAL array, dimension (2, N lg N)\n*         Each number indicates the S value to be used in the\n*         corresponding Givens rotation.\n*\n*  WORK   (workspace) REAL array, dimension (3*N+QSIZ*N)\n*\n*  IWORK  (workspace) INTEGER array, dimension (4*N)\n*\n*  INFO   (output) INTEGER\n*          = 0:  successful exit.\n*          < 0:  if INFO = -i, the i-th argument had an illegal value.\n*          > 0:  if INFO = 1, an eigenvalue did not converge\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Jeff Rutter, Computer Science Division, University of California\n*     at Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  indxq, info, d, q, qstore, qptr = NumRu::Lapack.slaed7( icompq, qsiz, tlvls, curlvl, curpbm, d, q, rho, cutpnt, qstore, qptr, prmptr, perm, givptr, givcol, givnum, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 16 && argc != 16)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 16)", argc);
-  rblapack_icompq = argv[0];
-  rblapack_qsiz = argv[1];
-  rblapack_tlvls = argv[2];
-  rblapack_curlvl = argv[3];
-  rblapack_curpbm = argv[4];
-  rblapack_d = argv[5];
-  rblapack_q = argv[6];
-  rblapack_rho = argv[7];
-  rblapack_cutpnt = argv[8];
-  rblapack_qstore = argv[9];
-  rblapack_qptr = argv[10];
-  rblapack_prmptr = argv[11];
-  rblapack_perm = argv[12];
-  rblapack_givptr = argv[13];
-  rblapack_givcol = argv[14];
-  rblapack_givnum = argv[15];
-  if (argc == 16) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  icompq = NUM2INT(rblapack_icompq);
-  tlvls = NUM2INT(rblapack_tlvls);
-  curpbm = NUM2INT(rblapack_curpbm);
-  if (!NA_IsNArray(rblapack_q))
-    rb_raise(rb_eArgError, "q (7th argument) must be NArray");
-  if (NA_RANK(rblapack_q) != 2)
-    rb_raise(rb_eArgError, "rank of q (7th argument) must be %d", 2);
-  ldq = NA_SHAPE0(rblapack_q);
-  n = NA_SHAPE1(rblapack_q);
-  if (NA_TYPE(rblapack_q) != NA_SFLOAT)
-    rblapack_q = na_change_type(rblapack_q, NA_SFLOAT);
-  q = NA_PTR_TYPE(rblapack_q, real*);
-  cutpnt = NUM2INT(rblapack_cutpnt);
-  qsiz = NUM2INT(rblapack_qsiz);
-  if (!NA_IsNArray(rblapack_d))
-    rb_raise(rb_eArgError, "d (6th argument) must be NArray");
-  if (NA_RANK(rblapack_d) != 1)
-    rb_raise(rb_eArgError, "rank of d (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_d) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of d must be the same as shape 1 of q");
-  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_qstore))
-    rb_raise(rb_eArgError, "qstore (10th argument) must be NArray");
-  if (NA_RANK(rblapack_qstore) != 1)
-    rb_raise(rb_eArgError, "rank of qstore (10th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_qstore) != (pow(n,2)+1))
-    rb_raise(rb_eRuntimeError, "shape 0 of qstore must be %d", pow(n,2)+1);
-  if (NA_TYPE(rblapack_qstore) != NA_SFLOAT)
-    rblapack_qstore = na_change_type(rblapack_qstore, NA_SFLOAT);
-  qstore = NA_PTR_TYPE(rblapack_qstore, real*);
-  if (!NA_IsNArray(rblapack_prmptr))
-    rb_raise(rb_eArgError, "prmptr (12th argument) must be NArray");
-  if (NA_RANK(rblapack_prmptr) != 1)
-    rb_raise(rb_eArgError, "rank of prmptr (12th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_prmptr) != (n*LG(n)))
-    rb_raise(rb_eRuntimeError, "shape 0 of prmptr must be %d", n*LG(n));
-  if (NA_TYPE(rblapack_prmptr) != NA_LINT)
-    rblapack_prmptr = na_change_type(rblapack_prmptr, NA_LINT);
-  prmptr = NA_PTR_TYPE(rblapack_prmptr, integer*);
-  if (!NA_IsNArray(rblapack_givptr))
-    rb_raise(rb_eArgError, "givptr (14th argument) must be NArray");
-  if (NA_RANK(rblapack_givptr) != 1)
-    rb_raise(rb_eArgError, "rank of givptr (14th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_givptr) != (n*LG(n)))
-    rb_raise(rb_eRuntimeError, "shape 0 of givptr must be %d", n*LG(n));
-  if (NA_TYPE(rblapack_givptr) != NA_LINT)
-    rblapack_givptr = na_change_type(rblapack_givptr, NA_LINT);
-  givptr = NA_PTR_TYPE(rblapack_givptr, integer*);
-  if (!NA_IsNArray(rblapack_givnum))
-    rb_raise(rb_eArgError, "givnum (16th argument) must be NArray");
-  if (NA_RANK(rblapack_givnum) != 2)
-    rb_raise(rb_eArgError, "rank of givnum (16th argument) must be %d", 2);
-  if (NA_SHAPE0(rblapack_givnum) != (2))
-    rb_raise(rb_eRuntimeError, "shape 0 of givnum must be %d", 2);
-  if (NA_SHAPE1(rblapack_givnum) != (n*LG(n)))
-    rb_raise(rb_eRuntimeError, "shape 1 of givnum must be %d", n*LG(n));
-  if (NA_TYPE(rblapack_givnum) != NA_SFLOAT)
-    rblapack_givnum = na_change_type(rblapack_givnum, NA_SFLOAT);
-  givnum = NA_PTR_TYPE(rblapack_givnum, real*);
-  curlvl = NUM2INT(rblapack_curlvl);
-  if (!NA_IsNArray(rblapack_qptr))
-    rb_raise(rb_eArgError, "qptr (11th argument) must be NArray");
-  if (NA_RANK(rblapack_qptr) != 1)
-    rb_raise(rb_eArgError, "rank of qptr (11th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_qptr) != (n+2))
-    rb_raise(rb_eRuntimeError, "shape 0 of qptr must be %d", n+2);
-  if (NA_TYPE(rblapack_qptr) != NA_LINT)
-    rblapack_qptr = na_change_type(rblapack_qptr, NA_LINT);
-  qptr = NA_PTR_TYPE(rblapack_qptr, integer*);
-  if (!NA_IsNArray(rblapack_givcol))
-    rb_raise(rb_eArgError, "givcol (15th argument) must be NArray");
-  if (NA_RANK(rblapack_givcol) != 2)
-    rb_raise(rb_eArgError, "rank of givcol (15th argument) must be %d", 2);
-  if (NA_SHAPE0(rblapack_givcol) != (2))
-    rb_raise(rb_eRuntimeError, "shape 0 of givcol must be %d", 2);
-  if (NA_SHAPE1(rblapack_givcol) != (n*LG(n)))
-    rb_raise(rb_eRuntimeError, "shape 1 of givcol must be %d", n*LG(n));
-  if (NA_TYPE(rblapack_givcol) != NA_LINT)
-    rblapack_givcol = na_change_type(rblapack_givcol, NA_LINT);
-  givcol = NA_PTR_TYPE(rblapack_givcol, integer*);
-  rho = (real)NUM2DBL(rblapack_rho);
-  if (!NA_IsNArray(rblapack_perm))
-    rb_raise(rb_eArgError, "perm (13th argument) must be NArray");
-  if (NA_RANK(rblapack_perm) != 1)
-    rb_raise(rb_eArgError, "rank of perm (13th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_perm) != (n*LG(n)))
-    rb_raise(rb_eRuntimeError, "shape 0 of perm must be %d", n*LG(n));
-  if (NA_TYPE(rblapack_perm) != NA_LINT)
-    rblapack_perm = na_change_type(rblapack_perm, NA_LINT);
-  perm = NA_PTR_TYPE(rblapack_perm, integer*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_indxq = na_make_object(NA_LINT, 1, shape, cNArray);
-  }
-  indxq = NA_PTR_TYPE(rblapack_indxq, integer*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_d_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  d_out__ = NA_PTR_TYPE(rblapack_d_out__, real*);
-  MEMCPY(d_out__, d, real, NA_TOTAL(rblapack_d));
-  rblapack_d = rblapack_d_out__;
-  d = d_out__;
-  {
-    int shape[2];
-    shape[0] = ldq;
-    shape[1] = n;
-    rblapack_q_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  q_out__ = NA_PTR_TYPE(rblapack_q_out__, real*);
-  MEMCPY(q_out__, q, real, NA_TOTAL(rblapack_q));
-  rblapack_q = rblapack_q_out__;
-  q = q_out__;
-  {
-    int shape[1];
-    shape[0] = pow(n,2)+1;
-    rblapack_qstore_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  qstore_out__ = NA_PTR_TYPE(rblapack_qstore_out__, real*);
-  MEMCPY(qstore_out__, qstore, real, NA_TOTAL(rblapack_qstore));
-  rblapack_qstore = rblapack_qstore_out__;
-  qstore = qstore_out__;
-  {
-    int shape[1];
-    shape[0] = n+2;
-    rblapack_qptr_out__ = na_make_object(NA_LINT, 1, shape, cNArray);
-  }
-  qptr_out__ = NA_PTR_TYPE(rblapack_qptr_out__, integer*);
-  MEMCPY(qptr_out__, qptr, integer, NA_TOTAL(rblapack_qptr));
-  rblapack_qptr = rblapack_qptr_out__;
-  qptr = qptr_out__;
-  work = ALLOC_N(real, (3*n+qsiz*n));
-  iwork = ALLOC_N(integer, (4*n));
-
-  slaed7_(&icompq, &n, &qsiz, &tlvls, &curlvl, &curpbm, d, q, &ldq, indxq, &rho, &cutpnt, qstore, qptr, prmptr, perm, givptr, givcol, givnum, work, iwork, &info);
-
-  free(work);
-  free(iwork);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(6, rblapack_indxq, rblapack_info, rblapack_d, rblapack_q, rblapack_qstore, rblapack_qptr);
-}
-
-void
-init_lapack_slaed7(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaed7", rblapack_slaed7, -1);
-}