ruby-lapack 1.6 → 1.7

data/ext/csytri2x.c

@@ -1,96 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID csytri2x_(char* uplo, integer* n, complex* a, integer* lda, integer* ipiv, complex* work, integer* nb, integer* info);
-
-
-static VALUE
-rblapack_csytri2x(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_nb;
-  integer nb; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  complex *a_out__;
-  complex *work;
-
-  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  info, a = NumRu::Lapack.csytri2x( uplo, a, ipiv, nb, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )\n\n*  Purpose\n*  =======\n*\n*  CSYTRI2X computes the inverse of a real symmetric indefinite matrix\n*  A using the factorization A = U*D*U**T or A = L*D*L**T computed by\n*  CSYTRF.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the details of the factorization are stored\n*          as an upper or lower triangular matrix.\n*          = 'U':  Upper triangular, form is A = U*D*U**T;\n*          = 'L':  Lower triangular, form is A = L*D*L**T.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) COMPLEX array, dimension (LDA,N)\n*          On entry, the NNB diagonal matrix D and the multipliers\n*          used to obtain the factor U or L as computed by CSYTRF.\n*\n*          On exit, if INFO = 0, the (symmetric) inverse of the original\n*          matrix.  If UPLO = 'U', the upper triangular part of the\n*          inverse is formed and the part of A below the diagonal is not\n*          referenced; if UPLO = 'L' the lower triangular part of the\n*          inverse is formed and the part of A above the diagonal is\n*          not referenced.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          Details of the interchanges and the NNB structure of D\n*          as determined by CSYTRF.\n*\n*  WORK    (workspace) COMPLEX array, dimension (N+NNB+1,NNB+3)\n*\n*  NB      (input) INTEGER\n*          Block size\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 = i, D(i,i) = 0; the matrix is singular and its\n*               inverse could not be computed.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, a = NumRu::Lapack.csytri2x( uplo, a, ipiv, nb, [: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_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_ipiv = argv[2];
-  rblapack_nb = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (3th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_ipiv);
-  if (NA_TYPE(rblapack_ipiv) != NA_LINT)
-    rblapack_ipiv = na_change_type(rblapack_ipiv, NA_LINT);
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  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 ipiv");
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  nb = NUM2INT(rblapack_nb);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, complex*);
-  MEMCPY(a_out__, a, complex, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-  work = ALLOC_N(complex, (n+nb+1)*(nb+3));
-
-  csytri2x_(&uplo, &n, a, &lda, ipiv, work, &nb, &info);
-
-  free(work);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_csytri2x(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "csytri2x", rblapack_csytri2x, -1);
-}

data/ext/csytrs.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID csytrs_(char* uplo, integer* n, integer* nrhs, complex* a, integer* lda, integer* ipiv, complex* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_csytrs(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  complex *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  complex *b_out__;
-
-  integer lda;
-  integer n;
-  integer ldb;
-  integer nrhs;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, b = NumRu::Lapack.csytrs( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  CSYTRS solves a system of linear equations A*X = B with a complex\n*  symmetric matrix A using the factorization A = U*D*U**T or\n*  A = L*D*L**T computed by CSYTRF.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the details of the factorization are stored\n*          as an upper or lower triangular matrix.\n*          = 'U':  Upper triangular, form is A = U*D*U**T;\n*          = 'L':  Lower triangular, form is A = L*D*L**T.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  NRHS    (input) INTEGER\n*          The number of right hand sides, i.e., the number of columns\n*          of the matrix B.  NRHS >= 0.\n*\n*  A       (input) COMPLEX array, dimension (LDA,N)\n*          The block diagonal matrix D and the multipliers used to\n*          obtain the factor U or L as computed by CSYTRF.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          Details of the interchanges and the block structure of D\n*          as determined by CSYTRF.\n*\n*  B       (input/output) COMPLEX array, dimension (LDB,NRHS)\n*          On entry, the right hand side matrix B.\n*          On exit, the solution matrix X.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B.  LDB >= max(1,N).\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, b = NumRu::Lapack.csytrs( uplo, a, ipiv, b, [: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_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_ipiv = argv[2];
-  rblapack_b = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (3th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_ipiv);
-  if (NA_TYPE(rblapack_ipiv) != NA_LINT)
-    rblapack_ipiv = na_change_type(rblapack_ipiv, NA_LINT);
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  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 ipiv");
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (4th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (4th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  nrhs = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_SCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, complex*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, complex*);
-  MEMCPY(b_out__, b, complex, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-
-  csytrs_(&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_b);
-}
-
-void
-init_lapack_csytrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "csytrs", rblapack_csytrs, -1);
-}

data/ext/csytrs2.c

@@ -1,106 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID csytrs2_(char* uplo, integer* n, integer* nrhs, complex* a, integer* lda, integer* ipiv, complex* b, integer* ldb, complex* work, integer* info);
-
-
-static VALUE
-rblapack_csytrs2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  complex *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  complex *b_out__;
-  complex *work;
-
-  integer lda;
-  integer n;
-  integer ldb;
-  integer nrhs;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, b = NumRu::Lapack.csytrs2( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,  WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CSYTRS2 solves a system of linear equations A*X = B with a COMPLEX\n*  symmetric matrix A using the factorization A = U*D*U**T or\n*  A = L*D*L**T computed by CSYTRF and converted by CSYCONV.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the details of the factorization are stored\n*          as an upper or lower triangular matrix.\n*          = 'U':  Upper triangular, form is A = U*D*U**T;\n*          = 'L':  Lower triangular, form is A = L*D*L**T.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  NRHS    (input) INTEGER\n*          The number of right hand sides, i.e., the number of columns\n*          of the matrix B.  NRHS >= 0.\n*\n*  A       (input) COMPLEX array, dimension (LDA,N)\n*          The block diagonal matrix D and the multipliers used to\n*          obtain the factor U or L as computed by CSYTRF.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          Details of the interchanges and the block structure of D\n*          as determined by CSYTRF.\n*\n*  B       (input/output) COMPLEX array, dimension (LDB,NRHS)\n*          On entry, the right hand side matrix B.\n*          On exit, the solution matrix X.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B.  LDB >= max(1,N).\n*\n*  WORK    (workspace) COMPLEX array, dimension (N)\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, b = NumRu::Lapack.csytrs2( uplo, a, ipiv, b, [: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_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_ipiv = argv[2];
-  rblapack_b = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (3th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_ipiv);
-  if (NA_TYPE(rblapack_ipiv) != NA_LINT)
-    rblapack_ipiv = na_change_type(rblapack_ipiv, NA_LINT);
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  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 ipiv");
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (4th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (4th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  nrhs = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_SCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, complex*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, complex*);
-  MEMCPY(b_out__, b, complex, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-  work = ALLOC_N(complex, (n));
-
-  csytrs2_(&uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &info);
-
-  free(work);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_b);
-}
-
-void
-init_lapack_csytrs2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "csytrs2", rblapack_csytrs2, -1);
-}

data/ext/ctbcon.c

@@ -1,86 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ctbcon_(char* norm, char* uplo, char* diag, integer* n, integer* kd, complex* ab, integer* ldab, real* rcond, complex* work, real* rwork, integer* info);
-
-
-static VALUE
-rblapack_ctbcon(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_norm;
-  char norm; 
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_diag;
-  char diag; 
-  VALUE rblapack_kd;
-  integer kd; 
-  VALUE rblapack_ab;
-  complex *ab; 
-  VALUE rblapack_rcond;
-  real rcond; 
-  VALUE rblapack_info;
-  integer info; 
-  complex *work;
-  real *rwork;
-
-  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  rcond, info = NumRu::Lapack.ctbcon( norm, uplo, diag, kd, ab, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTBCON estimates the reciprocal of the condition number of a\n*  triangular band matrix A, in either the 1-norm or the infinity-norm.\n*\n*  The norm of A is computed and an estimate is obtained for\n*  norm(inv(A)), then the reciprocal of the condition number is\n*  computed as\n*     RCOND = 1 / ( norm(A) * norm(inv(A)) ).\n*\n\n*  Arguments\n*  =========\n*\n*  NORM    (input) CHARACTER*1\n*          Specifies whether the 1-norm condition number or the\n*          infinity-norm condition number is required:\n*          = '1' or 'O':  1-norm;\n*          = 'I':         Infinity-norm.\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\n*\n*  DIAG    (input) CHARACTER*1\n*          = 'N':  A is non-unit triangular;\n*          = 'U':  A is unit triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  KD      (input) INTEGER\n*          The number of superdiagonals or subdiagonals of the\n*          triangular band matrix A.  KD >= 0.\n*\n*  AB      (input) COMPLEX array, dimension (LDAB,N)\n*          The upper or lower triangular band matrix A, stored in the\n*          first kd+1 rows of the array. The j-th column of A is stored\n*          in the j-th column of the array AB 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*          If DIAG = 'U', the diagonal elements of A are not referenced\n*          and are assumed to be 1.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= KD+1.\n*\n*  RCOND   (output) REAL\n*          The reciprocal of the condition number of the matrix A,\n*          computed as RCOND = 1/(norm(A) * norm(inv(A))).\n*\n*  WORK    (workspace) COMPLEX array, dimension (2*N)\n*\n*  RWORK   (workspace) REAL array, dimension (N)\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  rcond, info = NumRu::Lapack.ctbcon( norm, uplo, diag, kd, ab, [: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_norm = argv[0];
-  rblapack_uplo = argv[1];
-  rblapack_diag = argv[2];
-  rblapack_kd = argv[3];
-  rblapack_ab = argv[4];
-  if (argc == 5) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  norm = StringValueCStr(rblapack_norm)[0];
-  diag = StringValueCStr(rblapack_diag)[0];
-  if (!NA_IsNArray(rblapack_ab))
-    rb_raise(rb_eArgError, "ab (5th argument) must be NArray");
-  if (NA_RANK(rblapack_ab) != 2)
-    rb_raise(rb_eArgError, "rank of ab (5th argument) must be %d", 2);
-  ldab = NA_SHAPE0(rblapack_ab);
-  n = NA_SHAPE1(rblapack_ab);
-  if (NA_TYPE(rblapack_ab) != NA_SCOMPLEX)
-    rblapack_ab = na_change_type(rblapack_ab, NA_SCOMPLEX);
-  ab = NA_PTR_TYPE(rblapack_ab, complex*);
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  kd = NUM2INT(rblapack_kd);
-  work = ALLOC_N(complex, (2*n));
-  rwork = ALLOC_N(real, (n));
-
-  ctbcon_(&norm, &uplo, &diag, &n, &kd, ab, &ldab, &rcond, work, rwork, &info);
-
-  free(work);
-  free(rwork);
-  rblapack_rcond = rb_float_new((double)rcond);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_rcond, rblapack_info);
-}
-
-void
-init_lapack_ctbcon(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ctbcon", rblapack_ctbcon, -1);
-}

data/ext/ctbrfs.c

@@ -1,127 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ctbrfs_(char* uplo, char* trans, char* diag, integer* n, integer* kd, integer* nrhs, complex* ab, integer* ldab, complex* b, integer* ldb, complex* x, integer* ldx, real* ferr, real* berr, complex* work, real* rwork, integer* info);
-
-
-static VALUE
-rblapack_ctbrfs(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_diag;
-  char diag; 
-  VALUE rblapack_kd;
-  integer kd; 
-  VALUE rblapack_ab;
-  complex *ab; 
-  VALUE rblapack_b;
-  complex *b; 
-  VALUE rblapack_x;
-  complex *x; 
-  VALUE rblapack_ferr;
-  real *ferr; 
-  VALUE rblapack_berr;
-  real *berr; 
-  VALUE rblapack_info;
-  integer info; 
-  complex *work;
-  real *rwork;
-
-  integer ldab;
-  integer n;
-  integer ldb;
-  integer nrhs;
-  integer ldx;
-
-  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  ferr, berr, info = NumRu::Lapack.ctbrfs( uplo, trans, diag, kd, ab, b, x, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTBRFS provides error bounds and backward error estimates for the\n*  solution to a system of linear equations with a triangular band\n*  coefficient matrix.\n*\n*  The solution matrix X must be computed by CTBTRS or some other\n*  means before entering this routine.  CTBRFS does not do iterative\n*  refinement because doing so cannot improve the backward error.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\n*\n*  TRANS   (input) CHARACTER*1\n*          Specifies the form of the system of equations:\n*          = 'N':  A * X = B     (No transpose)\n*          = 'T':  A**T * X = B  (Transpose)\n*          = 'C':  A**H * X = B  (Conjugate transpose)\n*\n*  DIAG    (input) CHARACTER*1\n*          = 'N':  A is non-unit triangular;\n*          = 'U':  A is unit triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  KD      (input) INTEGER\n*          The number of superdiagonals or subdiagonals of the\n*          triangular band matrix A.  KD >= 0.\n*\n*  NRHS    (input) INTEGER\n*          The number of right hand sides, i.e., the number of columns\n*          of the matrices B and X.  NRHS >= 0.\n*\n*  AB      (input) COMPLEX array, dimension (LDAB,N)\n*          The upper or lower triangular band matrix A, stored in the\n*          first kd+1 rows of the array. The j-th column of A is stored\n*          in the j-th column of the array AB 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*          If DIAG = 'U', the diagonal elements of A are not referenced\n*          and are assumed to be 1.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= KD+1.\n*\n*  B       (input) COMPLEX array, dimension (LDB,NRHS)\n*          The right hand side matrix B.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B.  LDB >= max(1,N).\n*\n*  X       (input) COMPLEX array, dimension (LDX,NRHS)\n*          The solution matrix X.\n*\n*  LDX     (input) INTEGER\n*          The leading dimension of the array X.  LDX >= max(1,N).\n*\n*  FERR    (output) REAL array, dimension (NRHS)\n*          The estimated forward error bound for each solution vector\n*          X(j) (the j-th column of the solution matrix X).\n*          If XTRUE is the true solution corresponding to X(j), FERR(j)\n*          is an estimated upper bound for the magnitude of the largest\n*          element in (X(j) - XTRUE) divided by the magnitude of the\n*          largest element in X(j).  The estimate is as reliable as\n*          the estimate for RCOND, and is almost always a slight\n*          overestimate of the true error.\n*\n*  BERR    (output) REAL array, dimension (NRHS)\n*          The componentwise relative backward error of each solution\n*          vector X(j) (i.e., the smallest relative change in\n*          any element of A or B that makes X(j) an exact solution).\n*\n*  WORK    (workspace) COMPLEX array, dimension (2*N)\n*\n*  RWORK   (workspace) REAL array, dimension (N)\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ferr, berr, info = NumRu::Lapack.ctbrfs( uplo, trans, diag, kd, ab, b, x, [: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_uplo = argv[0];
-  rblapack_trans = argv[1];
-  rblapack_diag = argv[2];
-  rblapack_kd = argv[3];
-  rblapack_ab = argv[4];
-  rblapack_b = argv[5];
-  rblapack_x = argv[6];
-  if (argc == 7) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  diag = StringValueCStr(rblapack_diag)[0];
-  if (!NA_IsNArray(rblapack_ab))
-    rb_raise(rb_eArgError, "ab (5th argument) must be NArray");
-  if (NA_RANK(rblapack_ab) != 2)
-    rb_raise(rb_eArgError, "rank of ab (5th argument) must be %d", 2);
-  ldab = NA_SHAPE0(rblapack_ab);
-  n = NA_SHAPE1(rblapack_ab);
-  if (NA_TYPE(rblapack_ab) != NA_SCOMPLEX)
-    rblapack_ab = na_change_type(rblapack_ab, NA_SCOMPLEX);
-  ab = NA_PTR_TYPE(rblapack_ab, complex*);
-  if (!NA_IsNArray(rblapack_x))
-    rb_raise(rb_eArgError, "x (7th argument) must be NArray");
-  if (NA_RANK(rblapack_x) != 2)
-    rb_raise(rb_eArgError, "rank of x (7th argument) must be %d", 2);
-  ldx = NA_SHAPE0(rblapack_x);
-  nrhs = NA_SHAPE1(rblapack_x);
-  if (NA_TYPE(rblapack_x) != NA_SCOMPLEX)
-    rblapack_x = na_change_type(rblapack_x, NA_SCOMPLEX);
-  x = NA_PTR_TYPE(rblapack_x, complex*);
-  trans = StringValueCStr(rblapack_trans)[0];
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (6th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (6th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  if (NA_SHAPE1(rblapack_b) != nrhs)
-    rb_raise(rb_eRuntimeError, "shape 1 of b must be the same as shape 1 of x");
-  if (NA_TYPE(rblapack_b) != NA_SCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, complex*);
-  kd = NUM2INT(rblapack_kd);
-  {
-    int shape[1];
-    shape[0] = nrhs;
-    rblapack_ferr = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  ferr = NA_PTR_TYPE(rblapack_ferr, real*);
-  {
-    int shape[1];
-    shape[0] = nrhs;
-    rblapack_berr = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  berr = NA_PTR_TYPE(rblapack_berr, real*);
-  work = ALLOC_N(complex, (2*n));
-  rwork = ALLOC_N(real, (n));
-
-  ctbrfs_(&uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb, x, &ldx, ferr, berr, work, rwork, &info);
-
-  free(work);
-  free(rwork);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(3, rblapack_ferr, rblapack_berr, rblapack_info);
-}
-
-void
-init_lapack_ctbrfs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ctbrfs", rblapack_ctbrfs, -1);
-}