ruby-lapack 1.7 → 1.7.1

data/ext/dlaed3.c

@@ -0,0 +1,161 @@
+#include "rb_lapack.h"
+
+extern VOID dlaed3_(integer* k, integer* n, integer* n1, doublereal* d, doublereal* q, integer* ldq, doublereal* rho, doublereal* dlamda, doublereal* q2, integer* indx, integer* ctot, doublereal* w, doublereal* s, integer* info);
+
+
+static VALUE
+rblapack_dlaed3(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_n1;
+  integer n1; 
+  VALUE rblapack_rho;
+  doublereal rho; 
+  VALUE rblapack_dlamda;
+  doublereal *dlamda; 
+  VALUE rblapack_q2;
+  doublereal *q2; 
+  VALUE rblapack_indx;
+  integer *indx; 
+  VALUE rblapack_ctot;
+  integer *ctot; 
+  VALUE rblapack_w;
+  doublereal *w; 
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_q;
+  doublereal *q; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_dlamda_out__;
+  doublereal *dlamda_out__;
+  VALUE rblapack_w_out__;
+  doublereal *w_out__;
+  doublereal *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.dlaed3( n1, rho, dlamda, q2, indx, ctot, w, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, CTOT, W, S, INFO )\n\n*  Purpose\n*  =======\n*\n*  DLAED3 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 DLAED4 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*          DLAED4.  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) DOUBLE PRECISION array, dimension (N)\n*          D(I) contains the updated eigenvalues for\n*          1 <= I <= K.\n*\n*  Q       (output) DOUBLE PRECISION 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) DOUBLE PRECISION\n*          The value of the parameter in the rank one update equation.\n*          RHO >= 0 required.\n*\n*  DLAMDA  (input/output) DOUBLE PRECISION 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) DOUBLE PRECISION 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 DLAED2).\n*          The rows of the eigenvectors found by DLAED4 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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.dlaed3( 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_DFLOAT)
+    rblapack_dlamda = na_change_type(rblapack_dlamda, NA_DFLOAT);
+  dlamda = NA_PTR_TYPE(rblapack_dlamda, doublereal*);
+  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_DFLOAT)
+    rblapack_w = na_change_type(rblapack_w, NA_DFLOAT);
+  w = NA_PTR_TYPE(rblapack_w, doublereal*);
+  rho = 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_DFLOAT)
+    rblapack_q2 = na_change_type(rblapack_q2, NA_DFLOAT);
+  q2 = NA_PTR_TYPE(rblapack_q2, doublereal*);
+  ldq = MAX(1,n);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_d = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  d = NA_PTR_TYPE(rblapack_d, doublereal*);
+  {
+    na_shape_t shape[2];
+    shape[0] = ldq;
+    shape[1] = n;
+    rblapack_q = na_make_object(NA_DFLOAT, 2, shape, cNArray);
+  }
+  q = NA_PTR_TYPE(rblapack_q, doublereal*);
+  {
+    na_shape_t shape[1];
+    shape[0] = k;
+    rblapack_dlamda_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  dlamda_out__ = NA_PTR_TYPE(rblapack_dlamda_out__, doublereal*);
+  MEMCPY(dlamda_out__, dlamda, doublereal, NA_TOTAL(rblapack_dlamda));
+  rblapack_dlamda = rblapack_dlamda_out__;
+  dlamda = dlamda_out__;
+  {
+    na_shape_t shape[1];
+    shape[0] = k;
+    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__;
+  s = ALLOC_N(doublereal, (MAX(1,k))*((n1 + 1)));
+
+  dlaed3_(&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_dlaed3(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlaed3", rblapack_dlaed3, -1);
+}

data/ext/dlaed4.c

@@ -0,0 +1,90 @@
+#include "rb_lapack.h"
+
+extern VOID dlaed4_(integer* n, integer* i, doublereal* d, doublereal* z, doublereal* delta, doublereal* rho, doublereal* dlam, integer* info);
+
+
+static VALUE
+rblapack_dlaed4(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_i;
+  integer i; 
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_z;
+  doublereal *z; 
+  VALUE rblapack_rho;
+  doublereal rho; 
+  VALUE rblapack_delta;
+  doublereal *delta; 
+  VALUE rblapack_dlam;
+  doublereal 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.dlaed4( i, d, z, rho, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLAED4( 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) DOUBLE PRECISION 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) DOUBLE PRECISION array, dimension (N)\n*         The components of the updating vector.\n*\n*  DELTA  (output) DOUBLE PRECISION 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 DLAED5\n*         for detail. The vector DELTA contains the information necessary\n*         to construct the eigenvectors by DLAED3 and DLAED9.\n*\n*  RHO    (input) DOUBLE PRECISION\n*         The scalar in the symmetric updating formula.\n*\n*  DLAM   (output) DOUBLE PRECISION\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.dlaed4( 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_DFLOAT)
+    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
+  z = NA_PTR_TYPE(rblapack_z, doublereal*);
+  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_DFLOAT)
+    rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
+  d = NA_PTR_TYPE(rblapack_d, doublereal*);
+  rho = NUM2DBL(rblapack_rho);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_delta = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  delta = NA_PTR_TYPE(rblapack_delta, doublereal*);
+
+  dlaed4_(&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_dlaed4(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlaed4", rblapack_dlaed4, -1);
+}

data/ext/dlaed5.c

@@ -0,0 +1,87 @@
+#include "rb_lapack.h"
+
+extern VOID dlaed5_(integer* i, doublereal* d, doublereal* z, doublereal* delta, doublereal* rho, doublereal* dlam);
+
+
+static VALUE
+rblapack_dlaed5(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_i;
+  integer i; 
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_z;
+  doublereal *z; 
+  VALUE rblapack_rho;
+  doublereal rho; 
+  VALUE rblapack_delta;
+  doublereal *delta; 
+  VALUE rblapack_dlam;
+  doublereal 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.dlaed5( i, d, z, rho, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLAED5( 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) DOUBLE PRECISION array, dimension (2)\n*         The original eigenvalues.  We assume D(1) < D(2).\n*\n*  Z      (input) DOUBLE PRECISION array, dimension (2)\n*         The components of the updating vector.\n*\n*  DELTA  (output) DOUBLE PRECISION array, dimension (2)\n*         The vector DELTA contains the information necessary\n*         to construct the eigenvectors.\n*\n*  RHO    (input) DOUBLE PRECISION\n*         The scalar in the symmetric updating formula.\n*\n*  DLAM   (output) DOUBLE PRECISION\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.dlaed5( 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_DFLOAT)
+    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
+  z = NA_PTR_TYPE(rblapack_z, doublereal*);
+  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_DFLOAT)
+    rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
+  d = NA_PTR_TYPE(rblapack_d, doublereal*);
+  rho = NUM2DBL(rblapack_rho);
+  {
+    na_shape_t shape[1];
+    shape[0] = 2;
+    rblapack_delta = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  delta = NA_PTR_TYPE(rblapack_delta, doublereal*);
+
+  dlaed5_(&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_dlaed5(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlaed5", rblapack_dlaed5, -1);
+}

data/ext/dlaed6.c

@@ -0,0 +1,90 @@
+#include "rb_lapack.h"
+
+extern VOID dlaed6_(integer* kniter, logical* orgati, doublereal* rho, doublereal* d, doublereal* z, doublereal* finit, doublereal* tau, integer* info);
+
+
+static VALUE
+rblapack_dlaed6(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_kniter;
+  integer kniter; 
+  VALUE rblapack_orgati;
+  logical orgati; 
+  VALUE rblapack_rho;
+  doublereal rho; 
+  VALUE rblapack_d;
+  doublereal *d; 
+  VALUE rblapack_z;
+  doublereal *z; 
+  VALUE rblapack_finit;
+  doublereal finit; 
+  VALUE rblapack_tau;
+  doublereal 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.dlaed6( kniter, orgati, rho, d, z, finit, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )\n\n*  Purpose\n*  =======\n*\n*  DLAED6 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 DLAED4 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 DLAED4 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*               DLAED4 for further details.\n*\n*  RHO          (input) DOUBLE PRECISION\n*               Refer to the equation f(x) above.\n*\n*  D            (input) DOUBLE PRECISION array, dimension (3)\n*               D satisfies d(1) < d(2) < d(3).\n*\n*  Z            (input) DOUBLE PRECISION array, dimension (3)\n*               Each of the elements in z must be positive.\n*\n*  FINIT        (input) DOUBLE PRECISION\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) DOUBLE PRECISION\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\n*  safety (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.dlaed6( 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 = 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_DFLOAT)
+    rblapack_z = na_change_type(rblapack_z, NA_DFLOAT);
+  z = NA_PTR_TYPE(rblapack_z, doublereal*);
+  orgati = (rblapack_orgati == Qtrue);
+  finit = 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_DFLOAT)
+    rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
+  d = NA_PTR_TYPE(rblapack_d, doublereal*);
+
+  dlaed6_(&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_dlaed6(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlaed6", rblapack_dlaed6, -1);
+}

data/ext/dlaed7.c

@@ -0,0 +1,248 @@
+#include "rb_lapack.h"
+
+extern VOID dlaed7_(integer* icompq, integer* n, integer* qsiz, integer* tlvls, integer* curlvl, integer* curpbm, doublereal* d, doublereal* q, integer* ldq, integer* indxq, doublereal* rho, integer* cutpnt, doublereal* qstore, integer* qptr, integer* prmptr, integer* perm, integer* givptr, integer* givcol, doublereal* givnum, doublereal* work, integer* iwork, integer* info);
+
+
+static VALUE
+rblapack_dlaed7(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;
+  doublereal *d; 
+  VALUE rblapack_q;
+  doublereal *q; 
+  VALUE rblapack_rho;
+  doublereal rho; 
+  VALUE rblapack_cutpnt;
+  integer cutpnt; 
+  VALUE rblapack_qstore;
+  doublereal *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;
+  doublereal *givnum; 
+  VALUE rblapack_indxq;
+  integer *indxq; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_d_out__;
+  doublereal *d_out__;
+  VALUE rblapack_q_out__;
+  doublereal *q_out__;
+  VALUE rblapack_qstore_out__;
+  doublereal *qstore_out__;
+  VALUE rblapack_qptr_out__;
+  integer *qptr_out__;
+  doublereal *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.dlaed7( 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 DLAED7( 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*  DLAED7 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.  DLAED1 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 DLAED8.\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 DLAED4 (as called by DLAED9).\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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION\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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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.dlaed7( 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_DFLOAT)
+    rblapack_q = na_change_type(rblapack_q, NA_DFLOAT);
+  q = NA_PTR_TYPE(rblapack_q, doublereal*);
+  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_DFLOAT)
+    rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
+  d = NA_PTR_TYPE(rblapack_d, doublereal*);
+  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_DFLOAT)
+    rblapack_qstore = na_change_type(rblapack_qstore, NA_DFLOAT);
+  qstore = NA_PTR_TYPE(rblapack_qstore, doublereal*);
+  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_DFLOAT)
+    rblapack_givnum = na_change_type(rblapack_givnum, NA_DFLOAT);
+  givnum = NA_PTR_TYPE(rblapack_givnum, doublereal*);
+  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 = 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*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_indxq = na_make_object(NA_LINT, 1, shape, cNArray);
+  }
+  indxq = NA_PTR_TYPE(rblapack_indxq, integer*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_d_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  d_out__ = NA_PTR_TYPE(rblapack_d_out__, doublereal*);
+  MEMCPY(d_out__, d, doublereal, NA_TOTAL(rblapack_d));
+  rblapack_d = rblapack_d_out__;
+  d = d_out__;
+  {
+    na_shape_t shape[2];
+    shape[0] = ldq;
+    shape[1] = n;
+    rblapack_q_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
+  }
+  q_out__ = NA_PTR_TYPE(rblapack_q_out__, doublereal*);
+  MEMCPY(q_out__, q, doublereal, NA_TOTAL(rblapack_q));
+  rblapack_q = rblapack_q_out__;
+  q = q_out__;
+  {
+    na_shape_t shape[1];
+    shape[0] = pow(n,2)+1;
+    rblapack_qstore_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  qstore_out__ = NA_PTR_TYPE(rblapack_qstore_out__, doublereal*);
+  MEMCPY(qstore_out__, qstore, doublereal, NA_TOTAL(rblapack_qstore));
+  rblapack_qstore = rblapack_qstore_out__;
+  qstore = qstore_out__;
+  {
+    na_shape_t 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(doublereal, (3*n+qsiz*n));
+  iwork = ALLOC_N(integer, (4*n));
+
+  dlaed7_(&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_dlaed7(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "dlaed7", rblapack_dlaed7, -1);
+}