1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
#include "rb_lapack.h"
extern VOID zptts2_(integer* iuplo, integer* n, integer* nrhs, doublereal* d, doublecomplex* e, doublecomplex* b, integer* ldb);
static VALUE
rblapack_zptts2(int argc, VALUE *argv, VALUE self){
VALUE rblapack_iuplo;
integer iuplo;
VALUE rblapack_d;
doublereal *d;
VALUE rblapack_e;
doublecomplex *e;
VALUE rblapack_b;
doublecomplex *b;
VALUE rblapack_b_out__;
doublecomplex *b_out__;
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 b = NumRu::Lapack.zptts2( iuplo, d, e, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n SUBROUTINE ZPTTS2( IUPLO, N, NRHS, D, E, B, LDB )\n\n* Purpose\n* =======\n*\n* ZPTTS2 solves a tridiagonal system of the form\n* A * X = B\n* using the factorization A = U'*D*U or A = L*D*L' computed by ZPTTRF.\n* D is a diagonal matrix specified in the vector D, U (or L) is a unit\n* bidiagonal matrix whose superdiagonal (subdiagonal) is specified in\n* the vector E, and X and B are N by NRHS matrices.\n*\n\n* Arguments\n* =========\n*\n* IUPLO (input) INTEGER\n* Specifies the form of the factorization and whether the\n* vector E is the superdiagonal of the upper bidiagonal factor\n* U or the subdiagonal of the lower bidiagonal factor L.\n* = 1: A = U'*D*U, E is the superdiagonal of U\n* = 0: A = L*D*L', E is the subdiagonal of L\n*\n* N (input) INTEGER\n* The order of the tridiagonal 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* D (input) DOUBLE PRECISION array, dimension (N)\n* The n diagonal elements of the diagonal matrix D from the\n* factorization A = U'*D*U or A = L*D*L'.\n*\n* E (input) COMPLEX*16 array, dimension (N-1)\n* If IUPLO = 1, the (n-1) superdiagonal elements of the unit\n* bidiagonal factor U from the factorization A = U'*D*U.\n* If IUPLO = 0, the (n-1) subdiagonal elements of the unit\n* bidiagonal factor L from the factorization A = L*D*L'.\n*\n* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)\n* On entry, the right hand side vectors B for the system of\n* linear equations.\n* On exit, the solution vectors, X.\n*\n* LDB (input) INTEGER\n* The leading dimension of the array B. LDB >= max(1,N).\n*\n\n* =====================================================================\n*\n* .. Local Scalars ..\n INTEGER I, J\n* ..\n* .. External Subroutines ..\n EXTERNAL ZDSCAL\n* ..\n* .. Intrinsic Functions ..\n INTRINSIC DCONJG\n* ..\n\n");
return Qnil;
}
if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
printf("%s\n", "USAGE:\n b = NumRu::Lapack.zptts2( iuplo, d, e, 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_iuplo = argv[0];
rblapack_d = argv[1];
rblapack_e = argv[2];
rblapack_b = argv[3];
if (argc == 4) {
} else if (rblapack_options != Qnil) {
} else {
}
iuplo = NUM2INT(rblapack_iuplo);
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*);
if (!NA_IsNArray(rblapack_d))
rb_raise(rb_eArgError, "d (2th argument) must be NArray");
if (NA_RANK(rblapack_d) != 1)
rb_raise(rb_eArgError, "rank of d (2th argument) must be %d", 1);
n = NA_SHAPE0(rblapack_d);
if (NA_TYPE(rblapack_d) != NA_DFLOAT)
rblapack_d = na_change_type(rblapack_d, NA_DFLOAT);
d = NA_PTR_TYPE(rblapack_d, doublereal*);
if (!NA_IsNArray(rblapack_e))
rb_raise(rb_eArgError, "e (3th argument) must be NArray");
if (NA_RANK(rblapack_e) != 1)
rb_raise(rb_eArgError, "rank of e (3th argument) must be %d", 1);
if (NA_SHAPE0(rblapack_e) != (n-1))
rb_raise(rb_eRuntimeError, "shape 0 of e must be %d", n-1);
if (NA_TYPE(rblapack_e) != NA_DCOMPLEX)
rblapack_e = na_change_type(rblapack_e, NA_DCOMPLEX);
e = NA_PTR_TYPE(rblapack_e, doublecomplex*);
{
na_shape_t 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__;
zptts2_(&iuplo, &n, &nrhs, d, e, b, &ldb);
return rblapack_b;
}
void
init_lapack_zptts2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
sHelp = sH;
sUsage = sU;
rblapack_ZERO = zero;
rb_define_module_function(mLapack, "zptts2", rblapack_zptts2, -1);
}
|
