ruby-lapack 1.6 → 1.7

data/ext/slaqr5.c

@@ -1,200 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaqr5_(logical* wantt, logical* wantz, integer* kacc22, integer* n, integer* ktop, integer* kbot, integer* nshfts, real* sr, real* si, real* h, integer* ldh, integer* iloz, integer* ihiz, real* z, integer* ldz, real* v, integer* ldv, real* u, integer* ldu, integer* nv, real* wv, integer* ldwv, integer* nh, real* wh, integer* ldwh);
-
-
-static VALUE
-rblapack_slaqr5(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_wantt;
-  logical wantt; 
-  VALUE rblapack_wantz;
-  logical wantz; 
-  VALUE rblapack_kacc22;
-  integer kacc22; 
-  VALUE rblapack_ktop;
-  integer ktop; 
-  VALUE rblapack_kbot;
-  integer kbot; 
-  VALUE rblapack_sr;
-  real *sr; 
-  VALUE rblapack_si;
-  real *si; 
-  VALUE rblapack_h;
-  real *h; 
-  VALUE rblapack_iloz;
-  integer iloz; 
-  VALUE rblapack_ihiz;
-  integer ihiz; 
-  VALUE rblapack_z;
-  real *z; 
-  VALUE rblapack_nv;
-  integer nv; 
-  VALUE rblapack_nh;
-  integer nh; 
-  VALUE rblapack_sr_out__;
-  real *sr_out__;
-  VALUE rblapack_si_out__;
-  real *si_out__;
-  VALUE rblapack_h_out__;
-  real *h_out__;
-  VALUE rblapack_z_out__;
-  real *z_out__;
-  real *v;
-  real *u;
-  real *wv;
-  real *wh;
-
-  integer nshfts;
-  integer ldh;
-  integer n;
-  integer ldv;
-  integer ldu;
-  integer ldwv;
-  integer ldwh;
-  integer ldz;
-
-  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  sr, si, h, z = NumRu::Lapack.slaqr5( wantt, wantz, kacc22, ktop, kbot, sr, si, h, iloz, ihiz, z, nv, nh, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, WV, LDWV, NH, WH, LDWH )\n\n*     This auxiliary subroutine called by SLAQR0 performs a\n*     single small-bulge multi-shift QR sweep.\n*\n\n*      WANTT  (input) logical scalar\n*             WANTT = .true. if the quasi-triangular Schur factor\n*             is being computed.  WANTT is set to .false. otherwise.\n*\n*      WANTZ  (input) logical scalar\n*             WANTZ = .true. if the orthogonal Schur factor is being\n*             computed.  WANTZ is set to .false. otherwise.\n*\n*      KACC22 (input) integer with value 0, 1, or 2.\n*             Specifies the computation mode of far-from-diagonal\n*             orthogonal updates.\n*        = 0: SLAQR5 does not accumulate reflections and does not\n*             use matrix-matrix multiply to update far-from-diagonal\n*             matrix entries.\n*        = 1: SLAQR5 accumulates reflections and uses matrix-matrix\n*             multiply to update the far-from-diagonal matrix entries.\n*        = 2: SLAQR5 accumulates reflections, uses matrix-matrix\n*             multiply to update the far-from-diagonal matrix entries,\n*             and takes advantage of 2-by-2 block structure during\n*             matrix multiplies.\n*\n*      N      (input) integer scalar\n*             N is the order of the Hessenberg matrix H upon which this\n*             subroutine operates.\n*\n*      KTOP   (input) integer scalar\n*      KBOT   (input) integer scalar\n*             These are the first and last rows and columns of an\n*             isolated diagonal block upon which the QR sweep is to be\n*             applied. It is assumed without a check that\n*                       either KTOP = 1  or   H(KTOP,KTOP-1) = 0\n*             and\n*                       either KBOT = N  or   H(KBOT+1,KBOT) = 0.\n*\n*      NSHFTS (input) integer scalar\n*             NSHFTS gives the number of simultaneous shifts.  NSHFTS\n*             must be positive and even.\n*\n*      SR     (input/output) REAL array of size (NSHFTS)\n*      SI     (input/output) REAL array of size (NSHFTS)\n*             SR contains the real parts and SI contains the imaginary\n*             parts of the NSHFTS shifts of origin that define the\n*             multi-shift QR sweep.  On output SR and SI may be\n*             reordered.\n*\n*      H      (input/output) REAL array of size (LDH,N)\n*             On input H contains a Hessenberg matrix.  On output a\n*             multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied\n*             to the isolated diagonal block in rows and columns KTOP\n*             through KBOT.\n*\n*      LDH    (input) integer scalar\n*             LDH is the leading dimension of H just as declared in the\n*             calling procedure.  LDH.GE.MAX(1,N).\n*\n*      ILOZ   (input) INTEGER\n*      IHIZ   (input) INTEGER\n*             Specify the rows of Z to which transformations must be\n*             applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N\n*\n*      Z      (input/output) REAL array of size (LDZ,IHI)\n*             If WANTZ = .TRUE., then the QR Sweep orthogonal\n*             similarity transformation is accumulated into\n*             Z(ILOZ:IHIZ,ILO:IHI) from the right.\n*             If WANTZ = .FALSE., then Z is unreferenced.\n*\n*      LDZ    (input) integer scalar\n*             LDA is the leading dimension of Z just as declared in\n*             the calling procedure. LDZ.GE.N.\n*\n*      V      (workspace) REAL array of size (LDV,NSHFTS/2)\n*\n*      LDV    (input) integer scalar\n*             LDV is the leading dimension of V as declared in the\n*             calling procedure.  LDV.GE.3.\n*\n*      U      (workspace) REAL array of size\n*             (LDU,3*NSHFTS-3)\n*\n*      LDU    (input) integer scalar\n*             LDU is the leading dimension of U just as declared in the\n*             in the calling subroutine.  LDU.GE.3*NSHFTS-3.\n*\n*      NH     (input) integer scalar\n*             NH is the number of columns in array WH available for\n*             workspace. NH.GE.1.\n*\n*      WH     (workspace) REAL array of size (LDWH,NH)\n*\n*      LDWH   (input) integer scalar\n*             Leading dimension of WH just as declared in the\n*             calling procedure.  LDWH.GE.3*NSHFTS-3.\n*\n*      NV     (input) integer scalar\n*             NV is the number of rows in WV agailable for workspace.\n*             NV.GE.1.\n*\n*      WV     (workspace) REAL array of size\n*             (LDWV,3*NSHFTS-3)\n*\n*      LDWV   (input) integer scalar\n*             LDWV is the leading dimension of WV as declared in the\n*             in the calling subroutine.  LDWV.GE.NV.\n*\n\n*     ================================================================\n*     Based on contributions by\n*        Karen Braman and Ralph Byers, Department of Mathematics,\n*        University of Kansas, USA\n*\n*     ================================================================\n*     Reference:\n*\n*     K. Braman, R. Byers and R. Mathias, The Multi-Shift QR\n*     Algorithm Part I: Maintaining Well Focused Shifts, and\n*     Level 3 Performance, SIAM Journal of Matrix Analysis,\n*     volume 23, pages 929--947, 2002.\n*\n*     ================================================================\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  sr, si, h, z = NumRu::Lapack.slaqr5( wantt, wantz, kacc22, ktop, kbot, sr, si, h, iloz, ihiz, z, nv, nh, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 13 && argc != 13)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 13)", argc);
-  rblapack_wantt = argv[0];
-  rblapack_wantz = argv[1];
-  rblapack_kacc22 = argv[2];
-  rblapack_ktop = argv[3];
-  rblapack_kbot = argv[4];
-  rblapack_sr = argv[5];
-  rblapack_si = argv[6];
-  rblapack_h = argv[7];
-  rblapack_iloz = argv[8];
-  rblapack_ihiz = argv[9];
-  rblapack_z = argv[10];
-  rblapack_nv = argv[11];
-  rblapack_nh = argv[12];
-  if (argc == 13) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  wantt = (rblapack_wantt == Qtrue);
-  kacc22 = NUM2INT(rblapack_kacc22);
-  kbot = NUM2INT(rblapack_kbot);
-  if (!NA_IsNArray(rblapack_si))
-    rb_raise(rb_eArgError, "si (7th argument) must be NArray");
-  if (NA_RANK(rblapack_si) != 1)
-    rb_raise(rb_eArgError, "rank of si (7th argument) must be %d", 1);
-  nshfts = NA_SHAPE0(rblapack_si);
-  if (NA_TYPE(rblapack_si) != NA_SFLOAT)
-    rblapack_si = na_change_type(rblapack_si, NA_SFLOAT);
-  si = NA_PTR_TYPE(rblapack_si, real*);
-  iloz = NUM2INT(rblapack_iloz);
-  nv = NUM2INT(rblapack_nv);
-  ldwv = nv;
-  ldv = 3;
-  wantz = (rblapack_wantz == Qtrue);
-  if (!NA_IsNArray(rblapack_sr))
-    rb_raise(rb_eArgError, "sr (6th argument) must be NArray");
-  if (NA_RANK(rblapack_sr) != 1)
-    rb_raise(rb_eArgError, "rank of sr (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_sr) != nshfts)
-    rb_raise(rb_eRuntimeError, "shape 0 of sr must be the same as shape 0 of si");
-  if (NA_TYPE(rblapack_sr) != NA_SFLOAT)
-    rblapack_sr = na_change_type(rblapack_sr, NA_SFLOAT);
-  sr = NA_PTR_TYPE(rblapack_sr, real*);
-  ihiz = NUM2INT(rblapack_ihiz);
-  nh = NUM2INT(rblapack_nh);
-  ldu = 3*nshfts-3;
-  ktop = NUM2INT(rblapack_ktop);
-  ldwh = 3*nshfts-3;
-  if (!NA_IsNArray(rblapack_h))
-    rb_raise(rb_eArgError, "h (8th argument) must be NArray");
-  if (NA_RANK(rblapack_h) != 2)
-    rb_raise(rb_eArgError, "rank of h (8th argument) must be %d", 2);
-  ldh = NA_SHAPE0(rblapack_h);
-  n = NA_SHAPE1(rblapack_h);
-  if (NA_TYPE(rblapack_h) != NA_SFLOAT)
-    rblapack_h = na_change_type(rblapack_h, NA_SFLOAT);
-  h = NA_PTR_TYPE(rblapack_h, real*);
-  ldz = n;
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (11th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 2)
-    rb_raise(rb_eArgError, "rank of z (11th argument) must be %d", 2);
-  if (NA_SHAPE0(rblapack_z) != (wantz ? ldz : 0))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", wantz ? ldz : 0);
-  if (NA_SHAPE1(rblapack_z) != (wantz ? ihiz : 0))
-    rb_raise(rb_eRuntimeError, "shape 1 of z must be %d", wantz ? ihiz : 0);
-  if (NA_TYPE(rblapack_z) != NA_SFLOAT)
-    rblapack_z = na_change_type(rblapack_z, NA_SFLOAT);
-  z = NA_PTR_TYPE(rblapack_z, real*);
-  {
-    int shape[1];
-    shape[0] = nshfts;
-    rblapack_sr_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  sr_out__ = NA_PTR_TYPE(rblapack_sr_out__, real*);
-  MEMCPY(sr_out__, sr, real, NA_TOTAL(rblapack_sr));
-  rblapack_sr = rblapack_sr_out__;
-  sr = sr_out__;
-  {
-    int shape[1];
-    shape[0] = nshfts;
-    rblapack_si_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  si_out__ = NA_PTR_TYPE(rblapack_si_out__, real*);
-  MEMCPY(si_out__, si, real, NA_TOTAL(rblapack_si));
-  rblapack_si = rblapack_si_out__;
-  si = si_out__;
-  {
-    int shape[2];
-    shape[0] = ldh;
-    shape[1] = n;
-    rblapack_h_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  h_out__ = NA_PTR_TYPE(rblapack_h_out__, real*);
-  MEMCPY(h_out__, h, real, NA_TOTAL(rblapack_h));
-  rblapack_h = rblapack_h_out__;
-  h = h_out__;
-  {
-    int shape[2];
-    shape[0] = wantz ? ldz : 0;
-    shape[1] = wantz ? ihiz : 0;
-    rblapack_z_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  z_out__ = NA_PTR_TYPE(rblapack_z_out__, real*);
-  MEMCPY(z_out__, z, real, NA_TOTAL(rblapack_z));
-  rblapack_z = rblapack_z_out__;
-  z = z_out__;
-  v = ALLOC_N(real, (ldv)*(nshfts/2));
-  u = ALLOC_N(real, (ldu)*(3*nshfts-3));
-  wv = ALLOC_N(real, (ldwv)*(3*nshfts-3));
-  wh = ALLOC_N(real, (ldwh)*(MAX(1,nh)));
-
-  slaqr5_(&wantt, &wantz, &kacc22, &n, &ktop, &kbot, &nshfts, sr, si, h, &ldh, &iloz, &ihiz, z, &ldz, v, &ldv, u, &ldu, &nv, wv, &ldwv, &nh, wh, &ldwh);
-
-  free(v);
-  free(u);
-  free(wv);
-  free(wh);
-  return rb_ary_new3(4, rblapack_sr, rblapack_si, rblapack_h, rblapack_z);
-}
-
-void
-init_lapack_slaqr5(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaqr5", rblapack_slaqr5, -1);
-}

data/ext/slaqsb.c

@@ -1,101 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaqsb_(char* uplo, integer* n, integer* kd, real* ab, integer* ldab, real* s, real* scond, real* amax, char* equed);
-
-
-static VALUE
-rblapack_slaqsb(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_kd;
-  integer kd; 
-  VALUE rblapack_ab;
-  real *ab; 
-  VALUE rblapack_s;
-  real *s; 
-  VALUE rblapack_scond;
-  real scond; 
-  VALUE rblapack_amax;
-  real amax; 
-  VALUE rblapack_equed;
-  char equed; 
-  VALUE rblapack_ab_out__;
-  real *ab_out__;
-
-  integer ldab;
-  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  equed, ab = NumRu::Lapack.slaqsb( uplo, kd, ab, s, scond, amax, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED )\n\n*  Purpose\n*  =======\n*\n*  SLAQSB equilibrates a symmetric band matrix A using the scaling\n*  factors in the vector S.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the upper or lower triangular part of the\n*          symmetric matrix A is stored.\n*          = 'U':  Upper triangular\n*          = 'L':  Lower triangular\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  KD      (input) INTEGER\n*          The number of super-diagonals of the matrix A if UPLO = 'U',\n*          or the number of sub-diagonals if UPLO = 'L'.  KD >= 0.\n*\n*  AB      (input/output) REAL array, dimension (LDAB,N)\n*          On entry, the upper or lower triangle of the symmetric band\n*          matrix A, stored in the first KD+1 rows of the array.  The\n*          j-th column of A is stored in the j-th column of the array AB\n*          as follows:\n*          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;\n*          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).\n*\n*          On exit, if INFO = 0, the triangular factor U or L from the\n*          Cholesky factorization A = U'*U or A = L*L' of the band\n*          matrix A, in the same storage format as A.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= KD+1.\n*\n*  S       (input) REAL array, dimension (N)\n*          The scale factors for A.\n*\n*  SCOND   (input) REAL\n*          Ratio of the smallest S(i) to the largest S(i).\n*\n*  AMAX    (input) REAL\n*          Absolute value of largest matrix entry.\n*\n*  EQUED   (output) CHARACTER*1\n*          Specifies whether or not equilibration was done.\n*          = 'N':  No equilibration.\n*          = 'Y':  Equilibration was done, i.e., A has been replaced by\n*                  diag(S) * A * diag(S).\n*\n*  Internal Parameters\n*  ===================\n*\n*  THRESH is a threshold value used to decide if scaling should be done\n*  based on the ratio of the scaling factors.  If SCOND < THRESH,\n*  scaling is done.\n*\n*  LARGE and SMALL are threshold values used to decide if scaling should\n*  be done based on the absolute size of the largest matrix element.\n*  If AMAX > LARGE or AMAX < SMALL, scaling is done.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, ab = NumRu::Lapack.slaqsb( uplo, kd, ab, s, scond, amax, [: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_uplo = argv[0];
-  rblapack_kd = argv[1];
-  rblapack_ab = argv[2];
-  rblapack_s = argv[3];
-  rblapack_scond = argv[4];
-  rblapack_amax = argv[5];
-  if (argc == 6) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_ab))
-    rb_raise(rb_eArgError, "ab (3th argument) must be NArray");
-  if (NA_RANK(rblapack_ab) != 2)
-    rb_raise(rb_eArgError, "rank of ab (3th argument) must be %d", 2);
-  ldab = NA_SHAPE0(rblapack_ab);
-  n = NA_SHAPE1(rblapack_ab);
-  if (NA_TYPE(rblapack_ab) != NA_SFLOAT)
-    rblapack_ab = na_change_type(rblapack_ab, NA_SFLOAT);
-  ab = NA_PTR_TYPE(rblapack_ab, real*);
-  scond = (real)NUM2DBL(rblapack_scond);
-  kd = NUM2INT(rblapack_kd);
-  amax = (real)NUM2DBL(rblapack_amax);
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (4th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (4th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_s) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of s must be the same as shape 1 of ab");
-  if (NA_TYPE(rblapack_s) != NA_SFLOAT)
-    rblapack_s = na_change_type(rblapack_s, NA_SFLOAT);
-  s = NA_PTR_TYPE(rblapack_s, real*);
-  {
-    int shape[2];
-    shape[0] = ldab;
-    shape[1] = n;
-    rblapack_ab_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  ab_out__ = NA_PTR_TYPE(rblapack_ab_out__, real*);
-  MEMCPY(ab_out__, ab, real, NA_TOTAL(rblapack_ab));
-  rblapack_ab = rblapack_ab_out__;
-  ab = ab_out__;
-
-  slaqsb_(&uplo, &n, &kd, ab, &ldab, s, &scond, &amax, &equed);
-
-  rblapack_equed = rb_str_new(&equed,1);
-  return rb_ary_new3(2, rblapack_equed, rblapack_ab);
-}
-
-void
-init_lapack_slaqsb(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaqsb", rblapack_slaqsb, -1);
-}

data/ext/slaqsp.c

@@ -1,94 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaqsp_(char* uplo, integer* n, real* ap, real* s, real* scond, real* amax, char* equed);
-
-
-static VALUE
-rblapack_slaqsp(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_ap;
-  real *ap; 
-  VALUE rblapack_s;
-  real *s; 
-  VALUE rblapack_scond;
-  real scond; 
-  VALUE rblapack_amax;
-  real amax; 
-  VALUE rblapack_equed;
-  char equed; 
-  VALUE rblapack_ap_out__;
-  real *ap_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  equed, ap = NumRu::Lapack.slaqsp( uplo, ap, s, scond, amax, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )\n\n*  Purpose\n*  =======\n*\n*  SLAQSP equilibrates a symmetric matrix A using the scaling factors\n*  in the vector S.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the upper or lower triangular part of the\n*          symmetric matrix A is stored.\n*          = 'U':  Upper triangular\n*          = 'L':  Lower triangular\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  AP      (input/output) REAL array, dimension (N*(N+1)/2)\n*          On entry, the upper or lower triangle of the symmetric matrix\n*          A, packed columnwise in a linear array.  The j-th column of A\n*          is stored in the array AP as follows:\n*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;\n*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.\n*\n*          On exit, the equilibrated matrix:  diag(S) * A * diag(S), in\n*          the same storage format as A.\n*\n*  S       (input) REAL array, dimension (N)\n*          The scale factors for A.\n*\n*  SCOND   (input) REAL\n*          Ratio of the smallest S(i) to the largest S(i).\n*\n*  AMAX    (input) REAL\n*          Absolute value of largest matrix entry.\n*\n*  EQUED   (output) CHARACTER*1\n*          Specifies whether or not equilibration was done.\n*          = 'N':  No equilibration.\n*          = 'Y':  Equilibration was done, i.e., A has been replaced by\n*                  diag(S) * A * diag(S).\n*\n*  Internal Parameters\n*  ===================\n*\n*  THRESH is a threshold value used to decide if scaling should be done\n*  based on the ratio of the scaling factors.  If SCOND < THRESH,\n*  scaling is done.\n*\n*  LARGE and SMALL are threshold values used to decide if scaling should\n*  be done based on the absolute size of the largest matrix element.\n*  If AMAX > LARGE or AMAX < SMALL, scaling is done.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, ap = NumRu::Lapack.slaqsp( uplo, ap, s, scond, amax, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 5 && argc != 5)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 5)", argc);
-  rblapack_uplo = argv[0];
-  rblapack_ap = argv[1];
-  rblapack_s = argv[2];
-  rblapack_scond = argv[3];
-  rblapack_amax = argv[4];
-  if (argc == 5) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (3th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_s);
-  if (NA_TYPE(rblapack_s) != NA_SFLOAT)
-    rblapack_s = na_change_type(rblapack_s, NA_SFLOAT);
-  s = NA_PTR_TYPE(rblapack_s, real*);
-  amax = (real)NUM2DBL(rblapack_amax);
-  if (!NA_IsNArray(rblapack_ap))
-    rb_raise(rb_eArgError, "ap (2th argument) must be NArray");
-  if (NA_RANK(rblapack_ap) != 1)
-    rb_raise(rb_eArgError, "rank of ap (2th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_ap) != (n*(n+1)/2))
-    rb_raise(rb_eRuntimeError, "shape 0 of ap must be %d", n*(n+1)/2);
-  if (NA_TYPE(rblapack_ap) != NA_SFLOAT)
-    rblapack_ap = na_change_type(rblapack_ap, NA_SFLOAT);
-  ap = NA_PTR_TYPE(rblapack_ap, real*);
-  scond = (real)NUM2DBL(rblapack_scond);
-  {
-    int shape[1];
-    shape[0] = n*(n+1)/2;
-    rblapack_ap_out__ = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  ap_out__ = NA_PTR_TYPE(rblapack_ap_out__, real*);
-  MEMCPY(ap_out__, ap, real, NA_TOTAL(rblapack_ap));
-  rblapack_ap = rblapack_ap_out__;
-  ap = ap_out__;
-
-  slaqsp_(&uplo, &n, ap, s, &scond, &amax, &equed);
-
-  rblapack_equed = rb_str_new(&equed,1);
-  return rb_ary_new3(2, rblapack_equed, rblapack_ap);
-}
-
-void
-init_lapack_slaqsp(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaqsp", rblapack_slaqsp, -1);
-}

data/ext/slaqsy.c

@@ -1,97 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID slaqsy_(char* uplo, integer* n, real* a, integer* lda, real* s, real* scond, real* amax, char* equed);
-
-
-static VALUE
-rblapack_slaqsy(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_s;
-  real *s; 
-  VALUE rblapack_scond;
-  real scond; 
-  VALUE rblapack_amax;
-  real amax; 
-  VALUE rblapack_equed;
-  char equed; 
-  VALUE rblapack_a_out__;
-  real *a_out__;
-
-  integer lda;
-  integer n;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, a = NumRu::Lapack.slaqsy( uplo, a, s, scond, amax, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )\n\n*  Purpose\n*  =======\n*\n*  SLAQSY equilibrates a symmetric matrix A using the scaling factors\n*  in the vector S.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the upper or lower triangular part of the\n*          symmetric matrix A is stored.\n*          = 'U':  Upper triangular\n*          = 'L':  Lower triangular\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) REAL array, dimension (LDA,N)\n*          On entry, the symmetric matrix A.  If UPLO = 'U', the leading\n*          n by n upper triangular part of A contains the upper\n*          triangular part of the matrix A, and the strictly lower\n*          triangular part of A is not referenced.  If UPLO = 'L', the\n*          leading n by n lower triangular part of A contains the lower\n*          triangular part of the matrix A, and the strictly upper\n*          triangular part of A is not referenced.\n*\n*          On exit, if EQUED = 'Y', the equilibrated matrix:\n*          diag(S) * A * diag(S).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(N,1).\n*\n*  S       (input) REAL array, dimension (N)\n*          The scale factors for A.\n*\n*  SCOND   (input) REAL\n*          Ratio of the smallest S(i) to the largest S(i).\n*\n*  AMAX    (input) REAL\n*          Absolute value of largest matrix entry.\n*\n*  EQUED   (output) CHARACTER*1\n*          Specifies whether or not equilibration was done.\n*          = 'N':  No equilibration.\n*          = 'Y':  Equilibration was done, i.e., A has been replaced by\n*                  diag(S) * A * diag(S).\n*\n*  Internal Parameters\n*  ===================\n*\n*  THRESH is a threshold value used to decide if scaling should be done\n*  based on the ratio of the scaling factors.  If SCOND < THRESH,\n*  scaling is done.\n*\n*  LARGE and SMALL are threshold values used to decide if scaling should\n*  be done based on the absolute size of the largest matrix element.\n*  If AMAX > LARGE or AMAX < SMALL, scaling is done.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, a = NumRu::Lapack.slaqsy( uplo, a, s, scond, amax, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 5 && argc != 5)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 5)", argc);
-  rblapack_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_s = argv[2];
-  rblapack_scond = argv[3];
-  rblapack_amax = argv[4];
-  if (argc == 5) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (3th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_s);
-  if (NA_TYPE(rblapack_s) != NA_SFLOAT)
-    rblapack_s = na_change_type(rblapack_s, NA_SFLOAT);
-  s = NA_PTR_TYPE(rblapack_s, real*);
-  amax = (real)NUM2DBL(rblapack_amax);
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (2th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (2th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  if (NA_SHAPE1(rblapack_a) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of a must be the same as shape 0 of s");
-  if (NA_TYPE(rblapack_a) != NA_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  scond = (real)NUM2DBL(rblapack_scond);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, real*);
-  MEMCPY(a_out__, a, real, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  slaqsy_(&uplo, &n, a, &lda, s, &scond, &amax, &equed);
-
-  rblapack_equed = rb_str_new(&equed,1);
-  return rb_ary_new3(2, rblapack_equed, rblapack_a);
-}
-
-void
-init_lapack_slaqsy(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "slaqsy", rblapack_slaqsy, -1);
-}