ruby-lapack 1.6 → 1.7

data/ext/chetrf.c

@@ -1,97 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID chetrf_(char* uplo, integer* n, complex* a, integer* lda, integer* ipiv, complex* work, integer* lwork, integer* info);
-
-
-static VALUE
-rblapack_chetrf(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_work;
-  complex *work; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  complex *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  ipiv, work, info, a = NumRu::Lapack.chetrf( uplo, a, lwork, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CHETRF computes the factorization of a complex Hermitian matrix A\n*  using the Bunch-Kaufman diagonal pivoting method.  The form of the\n*  factorization is\n*\n*     A = U*D*U**H  or  A = L*D*L**H\n*\n*  where U (or L) is a product of permutation and unit upper (lower)\n*  triangular matrices, and D is Hermitian and block diagonal with \n*  1-by-1 and 2-by-2 diagonal blocks.\n*\n*  This is the blocked version of the algorithm, calling Level 3 BLAS.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  Upper triangle of A is stored;\n*          = 'L':  Lower triangle of A is stored.\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 Hermitian 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, the block diagonal matrix D and the multipliers used\n*          to obtain the factor U or L (see below for further details).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (output) INTEGER array, dimension (N)\n*          Details of the interchanges and the block structure of D.\n*          If IPIV(k) > 0, then rows and columns k and IPIV(k) were\n*          interchanged and D(k,k) is a 1-by-1 diagonal block.\n*          If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and\n*          columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)\n*          is a 2-by-2 diagonal block.  If UPLO = 'L' and IPIV(k) =\n*          IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were\n*          interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.\n*\n*  WORK    (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))\n*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.\n*\n*  LWORK   (input) INTEGER\n*          The length of WORK.  LWORK >=1.  For best performance\n*          LWORK >= N*NB, where NB is the block size returned by ILAENV.\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) is exactly zero.  The factorization\n*                has been completed, but the block diagonal matrix D is\n*                exactly singular, and division by zero will occur if it\n*                is used to solve a system of equations.\n*\n\n*  Further Details\n*  ===============\n*\n*  If UPLO = 'U', then A = U*D*U', where\n*     U = P(n)*U(n)* ... *P(k)U(k)* ...,\n*  i.e., U is a product of terms P(k)*U(k), where k decreases from n to\n*  1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1\n*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as\n*  defined by IPIV(k), and U(k) is a unit upper triangular matrix, such\n*  that if the diagonal block D(k) is of order s (s = 1 or 2), then\n*\n*             (   I    v    0   )   k-s\n*     U(k) =  (   0    I    0   )   s\n*             (   0    0    I   )   n-k\n*                k-s   s   n-k\n*\n*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).\n*  If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),\n*  and A(k,k), and v overwrites A(1:k-2,k-1:k).\n*\n*  If UPLO = 'L', then A = L*D*L', where\n*     L = P(1)*L(1)* ... *P(k)*L(k)* ...,\n*  i.e., L is a product of terms P(k)*L(k), where k increases from 1 to\n*  n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1\n*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as\n*  defined by IPIV(k), and L(k) is a unit lower triangular matrix, such\n*  that if the diagonal block D(k) is of order s (s = 1 or 2), then\n*\n*             (   I    0     0   )  k-1\n*     L(k) =  (   0    I     0   )  s\n*             (   0    v     I   )  n-k-s+1\n*                k-1   s  n-k-s+1\n*\n*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).\n*  If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),\n*  and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).\n*\n*  =====================================================================\n*\n*     .. Local Scalars ..\n      LOGICAL            LQUERY, UPPER\n      INTEGER            IINFO, IWS, J, K, KB, LDWORK, LWKOPT, NB, NBMIN\n*     ..\n*     .. External Functions ..\n      LOGICAL            LSAME\n      INTEGER            ILAENV\n      EXTERNAL           LSAME, ILAENV\n*     ..\n*     .. External Subroutines ..\n      EXTERNAL           CHETF2, CLAHEF, XERBLA\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          MAX\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ipiv, work, info, a = NumRu::Lapack.chetrf( uplo, a, lwork, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 3 && argc != 3)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 3)", argc);
-  rblapack_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_lwork = argv[2];
-  if (argc == 3) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  lwork = NUM2INT(rblapack_lwork);
-  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);
-  n = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_ipiv = na_make_object(NA_LINT, 1, shape, cNArray);
-  }
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  {
-    int shape[1];
-    shape[0] = MAX(1,lwork);
-    rblapack_work = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  work = NA_PTR_TYPE(rblapack_work, complex*);
-  {
-    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__;
-
-  chetrf_(&uplo, &n, a, &lda, ipiv, work, &lwork, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(4, rblapack_ipiv, rblapack_work, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_chetrf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "chetrf", rblapack_chetrf, -1);
-}

data/ext/chetri.c

@@ -1,92 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID chetri_(char* uplo, integer* n, complex* a, integer* lda, integer* ipiv, complex* work, integer* info);
-
-
-static VALUE
-rblapack_chetri(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  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.chetri( uplo, a, ipiv, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CHETRI computes the inverse of a complex Hermitian indefinite matrix\n*  A using the factorization A = U*D*U**H or A = L*D*L**H computed by\n*  CHETRF.\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**H;\n*          = 'L':  Lower triangular, form is A = L*D*L**H.\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 block diagonal matrix D and the multipliers\n*          used to obtain the factor U or L as computed by CHETRF.\n*\n*          On exit, if INFO = 0, the (Hermitian) 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 block structure of D\n*          as determined by CHETRF.\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*          > 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.chetri( uplo, a, ipiv, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 3 && argc != 3)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 3)", argc);
-  rblapack_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_ipiv = argv[2];
-  if (argc == 3) {
-  } 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*);
-  {
-    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));
-
-  chetri_(&uplo, &n, a, &lda, ipiv, work, &info);
-
-  free(work);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_chetri(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "chetri", rblapack_chetri, -1);
-}

data/ext/chetrs.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID chetrs_(char* uplo, integer* n, integer* nrhs, complex* a, integer* lda, integer* ipiv, complex* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_chetrs(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.chetrs( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  CHETRS solves a system of linear equations A*X = B with a complex\n*  Hermitian matrix A using the factorization A = U*D*U**H or\n*  A = L*D*L**H computed by CHETRF.\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**H;\n*          = 'L':  Lower triangular, form is A = L*D*L**H.\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 CHETRF.\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 CHETRF.\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.chetrs( 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__;
-
-  chetrs_(&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_chetrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "chetrs", rblapack_chetrs, -1);
-}

data/ext/chetrs2.c

@@ -1,106 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID chetrs2_(char* uplo, integer* n, integer* nrhs, complex* a, integer* lda, integer* ipiv, complex* b, integer* ldb, complex* work, integer* info);
-
-
-static VALUE
-rblapack_chetrs2(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.chetrs2( uplo, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,  WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CHETRS2 solves a system of linear equations A*X = B with a COMPLEX\n*  Hermitian 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**H;\n*          = 'L':  Lower triangular, form is A = L*D*L**H.\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 CHETRF.\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 CHETRF.\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.chetrs2( 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));
-
-  chetrs2_(&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_chetrs2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "chetrs2", rblapack_chetrs2, -1);
-}

data/ext/chfrk.c

@@ -1,109 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID chfrk_(char* transr, char* uplo, char* trans, integer* n, integer* k, real* alpha, complex* a, integer* lda, real* beta, complex* c);
-
-
-static VALUE
-rblapack_chfrk(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_transr;
-  char transr; 
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_k;
-  integer k; 
-  VALUE rblapack_alpha;
-  real alpha; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_beta;
-  real beta; 
-  VALUE rblapack_c;
-  complex *c; 
-  VALUE rblapack_c_out__;
-  complex *c_out__;
-
-  integer lda;
-  integer ldc;
-  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  c = NumRu::Lapack.chfrk( transr, uplo, trans, k, alpha, a, beta, c, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C )\n\n*  Purpose\n*  =======\n*\n*  Level 3 BLAS like routine for C in RFP Format.\n*\n*  CHFRK performs one of the Hermitian rank--k operations\n*\n*     C := alpha*A*conjg( A' ) + beta*C,\n*\n*  or\n*\n*     C := alpha*conjg( A' )*A + beta*C,\n*\n*  where alpha and beta are real scalars, C is an n--by--n Hermitian\n*  matrix and A is an n--by--k matrix in the first case and a k--by--n\n*  matrix in the second case.\n*\n\n*  Arguments\n*  ==========\n*\n*  TRANSR  (input) CHARACTER*1\n*          = 'N':  The Normal Form of RFP A is stored;\n*          = 'C':  The Conjugate-transpose Form of RFP A is stored.\n*\n*  UPLO    (input) CHARACTER*1\n*           On  entry,   UPLO  specifies  whether  the  upper  or  lower\n*           triangular  part  of the  array  C  is to be  referenced  as\n*           follows:\n*\n*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C\n*                                  is to be referenced.\n*\n*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C\n*                                  is to be referenced.\n*\n*           Unchanged on exit.\n*\n*  TRANS   (input) CHARACTER*1\n*           On entry,  TRANS  specifies the operation to be performed as\n*           follows:\n*\n*              TRANS = 'N' or 'n'   C := alpha*A*conjg( A' ) + beta*C.\n*\n*              TRANS = 'C' or 'c'   C := alpha*conjg( A' )*A + beta*C.\n*\n*           Unchanged on exit.\n*\n*  N       (input) INTEGER\n*           On entry,  N specifies the order of the matrix C.  N must be\n*           at least zero.\n*           Unchanged on exit.\n*\n*  K       (input) INTEGER\n*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number\n*           of  columns   of  the   matrix   A,   and  on   entry   with\n*           TRANS = 'C' or 'c',  K  specifies  the number of rows of the\n*           matrix A.  K must be at least zero.\n*           Unchanged on exit.\n*\n*  ALPHA   (input) REAL\n*           On entry, ALPHA specifies the scalar alpha.\n*           Unchanged on exit.\n*\n*  A       (input) COMPLEX array, dimension (LDA,ka)\n*           where KA\n*           is K  when TRANS = 'N' or 'n', and is N otherwise. Before\n*           entry with TRANS = 'N' or 'n', the leading N--by--K part of\n*           the array A must contain the matrix A, otherwise the leading\n*           K--by--N part of the array A must contain the matrix A.\n*           Unchanged on exit.\n*\n*  LDA     (input) INTEGER\n*           On entry, LDA specifies the first dimension of A as declared\n*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'\n*           then  LDA must be at least  max( 1, n ), otherwise  LDA must\n*           be at least  max( 1, k ).\n*           Unchanged on exit.\n*\n*  BETA    (input) REAL\n*           On entry, BETA specifies the scalar beta.\n*           Unchanged on exit.\n*\n*  C       (input/output) COMPLEX array, dimension (N*(N+1)/2)\n*           On entry, the matrix A in RFP Format. RFP Format is\n*           described by TRANSR, UPLO and N. Note that the imaginary\n*           parts of the diagonal elements need not be set, they are\n*           assumed to be zero, and on exit they are set to zero.\n*\n*  Arguments\n*  ==========\n*\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  c = NumRu::Lapack.chfrk( transr, uplo, trans, k, alpha, a, beta, c, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 8 && argc != 8)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 8)", argc);
-  rblapack_transr = argv[0];
-  rblapack_uplo = argv[1];
-  rblapack_trans = argv[2];
-  rblapack_k = argv[3];
-  rblapack_alpha = argv[4];
-  rblapack_a = argv[5];
-  rblapack_beta = argv[6];
-  rblapack_c = argv[7];
-  if (argc == 8) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  transr = StringValueCStr(rblapack_transr)[0];
-  trans = StringValueCStr(rblapack_trans)[0];
-  alpha = (real)NUM2DBL(rblapack_alpha);
-  beta = (real)NUM2DBL(rblapack_beta);
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_c))
-    rb_raise(rb_eArgError, "c (8th argument) must be NArray");
-  if (NA_RANK(rblapack_c) != 1)
-    rb_raise(rb_eArgError, "rank of c (8th argument) must be %d", 1);
-  ldc = NA_SHAPE0(rblapack_c);
-  if (NA_TYPE(rblapack_c) != NA_SCOMPLEX)
-    rblapack_c = na_change_type(rblapack_c, NA_SCOMPLEX);
-  c = NA_PTR_TYPE(rblapack_c, complex*);
-  n = ((int)sqrtf(ldc*8+1.0f)-1)/2;
-  k = NUM2INT(rblapack_k);
-  lda = lsame_(&trans,"N") ? MAX(1,n) : MAX(1,k);
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (6th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (6th argument) must be %d", 2);
-  if (NA_SHAPE0(rblapack_a) != lda)
-    rb_raise(rb_eRuntimeError, "shape 0 of a must be lsame_(&trans,\"N\") ? MAX(1,n) : MAX(1,k)");
-  if (NA_SHAPE1(rblapack_a) != (lsame_(&trans,"N") ? k : n))
-    rb_raise(rb_eRuntimeError, "shape 1 of a must be %d", lsame_(&trans,"N") ? k : n);
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  {
-    int shape[1];
-    shape[0] = ldc;
-    rblapack_c_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  c_out__ = NA_PTR_TYPE(rblapack_c_out__, complex*);
-  MEMCPY(c_out__, c, complex, NA_TOTAL(rblapack_c));
-  rblapack_c = rblapack_c_out__;
-  c = c_out__;
-
-  chfrk_(&transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta, c);
-
-  return rblapack_c;
-}
-
-void
-init_lapack_chfrk(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "chfrk", rblapack_chfrk, -1);
-}