ruby-lapack 1.6 → 1.7

data/ext/zsytri2x.c

@@ -1,96 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID zsytri2x_(char* uplo, integer* n, doublecomplex* a, integer* lda, integer* ipiv, doublecomplex* work, integer* nb, integer* info);
-
-
-static VALUE
-rblapack_zsytri2x(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_nb;
-  integer nb; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublecomplex *a_out__;
-  doublecomplex *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.zsytri2x( uplo, a, ipiv, nb, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZSYTRI2X computes the inverse of a complex symmetric indefinite matrix\n*  A using the factorization A = U*D*U**T or A = L*D*L**T computed by\n*  ZSYTRF.\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) DOUBLE 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 ZSYTRF.\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 ZSYTRF.\n*\n*  WORK    (workspace) DOUBLE 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.zsytri2x( 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_DCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_DCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, doublecomplex*);
-  nb = NUM2INT(rblapack_nb);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublecomplex*);
-  MEMCPY(a_out__, a, doublecomplex, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-  work = ALLOC_N(doublecomplex, (n+nb+1)*(nb+3));
-
-  zsytri2x_(&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_zsytri2x(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "zsytri2x", rblapack_zsytri2x, -1);
-}

data/ext/zsytrs.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID zsytrs_(char* uplo, integer* n, integer* nrhs, doublecomplex* a, integer* lda, integer* ipiv, doublecomplex* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_zsytrs(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  doublecomplex *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.zsytrs( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZSYTRS 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 ZSYTRF.\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*16 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 ZSYTRF.\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 ZSYTRF.\n*\n*  B       (input/output) COMPLEX*16 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.zsytrs( 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_DCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_DCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, doublecomplex*);
-  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_DCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_DCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, doublecomplex*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, doublecomplex*);
-  MEMCPY(b_out__, b, doublecomplex, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-
-  zsytrs_(&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_zsytrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "zsytrs", rblapack_zsytrs, -1);
-}

data/ext/zsytrs2.c

@@ -1,106 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID zsytrs2_(char* uplo, integer* n, integer* nrhs, doublecomplex* a, integer* lda, integer* ipiv, doublecomplex* b, integer* ldb, real* work, integer* info);
-
-
-static VALUE
-rblapack_zsytrs2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  doublecomplex *b_out__;
-  real *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.zsytrs2( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,  WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZSYTRS2 solves a system of linear equations A*X = B with a real\n*  symmetric matrix A using the factorization A = U*D*U**T or\n*  A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV.\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) DOUBLE 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 ZSYTRF.\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 ZSYTRF.\n*\n*  B       (input/output) DOUBLE 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) 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  info, b = NumRu::Lapack.zsytrs2( 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_DCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_DCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, doublecomplex*);
-  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_DCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_DCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, doublecomplex*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, doublecomplex*);
-  MEMCPY(b_out__, b, doublecomplex, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-  work = ALLOC_N(real, (n));
-
-  zsytrs2_(&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_zsytrs2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "zsytrs2", rblapack_zsytrs2, -1);
-}

data/ext/ztbcon.c

@@ -1,86 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ztbcon_(char* norm, char* uplo, char* diag, integer* n, integer* kd, doublecomplex* ab, integer* ldab, doublereal* rcond, doublecomplex* work, doublereal* rwork, integer* info);
-
-
-static VALUE
-rblapack_ztbcon(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;
-  doublecomplex *ab; 
-  VALUE rblapack_rcond;
-  doublereal rcond; 
-  VALUE rblapack_info;
-  integer info; 
-  doublecomplex *work;
-  doublereal *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.ztbcon( norm, uplo, diag, kd, ab, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZTBCON 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*16 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) DOUBLE PRECISION\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*16 array, dimension (2*N)\n*\n*  RWORK   (workspace) DOUBLE PRECISION 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.ztbcon( 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_DCOMPLEX)
-    rblapack_ab = na_change_type(rblapack_ab, NA_DCOMPLEX);
-  ab = NA_PTR_TYPE(rblapack_ab, doublecomplex*);
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  kd = NUM2INT(rblapack_kd);
-  work = ALLOC_N(doublecomplex, (2*n));
-  rwork = ALLOC_N(doublereal, (n));
-
-  ztbcon_(&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_ztbcon(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ztbcon", rblapack_ztbcon, -1);
-}

data/ext/ztbrfs.c

@@ -1,127 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ztbrfs_(char* uplo, char* trans, char* diag, integer* n, integer* kd, integer* nrhs, doublecomplex* ab, integer* ldab, doublecomplex* b, integer* ldb, doublecomplex* x, integer* ldx, doublereal* ferr, doublereal* berr, doublecomplex* work, doublereal* rwork, integer* info);
-
-
-static VALUE
-rblapack_ztbrfs(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;
-  doublecomplex *ab; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_x;
-  doublecomplex *x; 
-  VALUE rblapack_ferr;
-  doublereal *ferr; 
-  VALUE rblapack_berr;
-  doublereal *berr; 
-  VALUE rblapack_info;
-  integer info; 
-  doublecomplex *work;
-  doublereal *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.ztbrfs( uplo, trans, diag, kd, ab, b, x, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZTBRFS 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 ZTBTRS or some other\n*  means before entering this routine.  ZTBRFS 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*16 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*16 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*16 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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*16 array, dimension (2*N)\n*\n*  RWORK   (workspace) DOUBLE PRECISION 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.ztbrfs( 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_DCOMPLEX)
-    rblapack_ab = na_change_type(rblapack_ab, NA_DCOMPLEX);
-  ab = NA_PTR_TYPE(rblapack_ab, doublecomplex*);
-  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_DCOMPLEX)
-    rblapack_x = na_change_type(rblapack_x, NA_DCOMPLEX);
-  x = NA_PTR_TYPE(rblapack_x, doublecomplex*);
-  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_DCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_DCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, doublecomplex*);
-  kd = NUM2INT(rblapack_kd);
-  {
-    int shape[1];
-    shape[0] = nrhs;
-    rblapack_ferr = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  ferr = NA_PTR_TYPE(rblapack_ferr, doublereal*);
-  {
-    int shape[1];
-    shape[0] = nrhs;
-    rblapack_berr = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  berr = NA_PTR_TYPE(rblapack_berr, doublereal*);
-  work = ALLOC_N(doublecomplex, (2*n));
-  rwork = ALLOC_N(doublereal, (n));
-
-  ztbrfs_(&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_ztbrfs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ztbrfs", rblapack_ztbrfs, -1);
-}