static VALUE rb_gsl_blas_zdscal(int argc, VALUE *argv, VALUE obj)
{
double a;
gsl_vector_complex *x = NULL;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
Need_Float(argv[0]);
CHECK_VECTOR_COMPLEX(argv[1]);
// a = RFLOAT(argv[0])->value;
a = NUM2DBL(argv[0]);
Data_Get_Struct(argv[1], gsl_vector_complex, x);
gsl_blas_zdscal(a, x);
return argv[1];
break;
default:
Data_Get_Struct(obj, gsl_vector_complex, x);
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
Need_Float(argv[0]);
a = NUM2DBL(argv[0]);
gsl_blas_zdscal(a, x);
return obj;
break;
}
}
static VALUE rb_gsl_blas_zdscal2(int argc, VALUE *argv, VALUE obj)
{
double a;
gsl_vector_complex *x = NULL, *xnew = NULL;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
Need_Float(argv[0]);
CHECK_VECTOR_COMPLEX(argv[1]);
a = NUM2DBL(argv[0]);
Data_Get_Struct(argv[1], gsl_vector_complex, x);
break;
default:
Data_Get_Struct(obj, gsl_vector_complex, x);
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
Need_Float(argv[0]);
a = NUM2DBL(argv[0]);
break;
}
xnew = gsl_vector_complex_alloc(x->size);
gsl_vector_complex_memcpy(xnew, x);
gsl_blas_zdscal(a, xnew);
return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, xnew);
}
void
test_eigen_genherm_results (const gsl_matrix_complex * A,
const gsl_matrix_complex * B,
const gsl_vector * eval,
const gsl_matrix_complex * evec,
size_t count,
const char * desc,
const char * desc2)
{
const size_t N = A->size1;
size_t i, j;
gsl_vector_complex * x = gsl_vector_complex_alloc(N);
gsl_vector_complex * y = gsl_vector_complex_alloc(N);
/* check A v = lambda B v */
for (i = 0; i < N; i++)
{
double ei = gsl_vector_get (eval, i);
gsl_vector_complex_const_view vi =
gsl_matrix_complex_const_column(evec, i);
double norm = gsl_blas_dznrm2(&vi.vector);
/* check that eigenvector is normalized */
gsl_test_rel(norm, 1.0, N * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, normalized(%d), %s", N, count,
desc, i, desc2);
/* compute y = A z */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, A, &vi.vector, GSL_COMPLEX_ZERO, y);
/* compute x = B z */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, B, &vi.vector, GSL_COMPLEX_ZERO, x);
/* compute x = lambda B z */
gsl_blas_zdscal(ei, x);
/* now test if y = x */
for (j = 0; j < N; j++)
{
gsl_complex xj = gsl_vector_complex_get (x, j);
gsl_complex yj = gsl_vector_complex_get (y, j);
gsl_test_rel(GSL_REAL(yj), GSL_REAL(xj), 1e9 * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), real, %s", N, count, desc, i, j, desc2);
gsl_test_abs(GSL_IMAG(yj), GSL_IMAG(xj), 1e9 * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), imag, %s", N, count, desc, i, j, desc2);
}
}
gsl_vector_complex_free(x);
gsl_vector_complex_free(y);
}
static void
genhermv_normalize_eigenvectors(gsl_matrix_complex *evec)
{
const size_t N = evec->size1;
size_t i; /* looping */
for (i = 0; i < N; ++i)
{
gsl_vector_complex_view vi = gsl_matrix_complex_column(evec, i);
double scale = 1.0 / gsl_blas_dznrm2(&vi.vector);
gsl_blas_zdscal(scale, &vi.vector);
}
} /* genhermv_normalize_eigenvectors() */
static void
nonsymmv_normalize_eigenvectors(gsl_vector_complex *eval,
gsl_matrix_complex *evec)
{
const size_t N = evec->size1;
size_t i; /* looping */
gsl_complex ei;
gsl_vector_complex_view vi;
gsl_vector_view re, im;
double scale; /* scaling factor */
for (i = 0; i < N; ++i)
{
ei = gsl_vector_complex_get(eval, i);
vi = gsl_matrix_complex_column(evec, i);
re = gsl_vector_complex_real(&vi.vector);
if (GSL_IMAG(ei) == 0.0)
{
scale = 1.0 / gsl_blas_dnrm2(&re.vector);
gsl_blas_dscal(scale, &re.vector);
}
else if (GSL_IMAG(ei) > 0.0)
{
im = gsl_vector_complex_imag(&vi.vector);
scale = 1.0 / gsl_hypot(gsl_blas_dnrm2(&re.vector),
gsl_blas_dnrm2(&im.vector));
gsl_blas_zdscal(scale, &vi.vector);
vi = gsl_matrix_complex_column(evec, i + 1);
gsl_blas_zdscal(scale, &vi.vector);
}
}
} /* nonsymmv_normalize_eigenvectors() */
static void
nonsymmv_get_right_eigenvectors(gsl_matrix *T, gsl_matrix *Z,
gsl_vector_complex *eval,
gsl_matrix_complex *evec,
gsl_eigen_nonsymmv_workspace *w)
{
const size_t N = T->size1;
const double smlnum = GSL_DBL_MIN * N / GSL_DBL_EPSILON;
const double bignum = (1.0 - GSL_DBL_EPSILON) / smlnum;
int i; /* looping */
size_t iu, /* looping */
ju,
ii;
gsl_complex lambda; /* current eigenvalue */
double lambda_re, /* Re(lambda) */
lambda_im; /* Im(lambda) */
gsl_matrix_view Tv, /* temporary views */
Zv;
gsl_vector_view y, /* temporary views */
y2,
ev,
ev2;
double dat[4], /* scratch arrays */
dat_X[4];
double scale; /* scale factor */
double xnorm; /* |X| */
gsl_vector_complex_view ecol, /* column of evec */
ecol2;
int complex_pair; /* complex eigenvalue pair? */
double smin;
/*
* Compute 1-norm of each column of upper triangular part of T
* to control overflow in triangular solver
*/
gsl_vector_set(w->work3, 0, 0.0);
for (ju = 1; ju < N; ++ju)
{
gsl_vector_set(w->work3, ju, 0.0);
for (iu = 0; iu < ju; ++iu)
{
gsl_vector_set(w->work3, ju,
gsl_vector_get(w->work3, ju) +
fabs(gsl_matrix_get(T, iu, ju)));
}
}
for (i = (int) N - 1; i >= 0; --i)
{
iu = (size_t) i;
/* get current eigenvalue and store it in lambda */
lambda_re = gsl_matrix_get(T, iu, iu);
if (iu != 0 && gsl_matrix_get(T, iu, iu - 1) != 0.0)
{
lambda_im = sqrt(fabs(gsl_matrix_get(T, iu, iu - 1))) *
sqrt(fabs(gsl_matrix_get(T, iu - 1, iu)));
}
else
{
lambda_im = 0.0;
}
GSL_SET_COMPLEX(&lambda, lambda_re, lambda_im);
smin = GSL_MAX(GSL_DBL_EPSILON * (fabs(lambda_re) + fabs(lambda_im)),
smlnum);
smin = GSL_MAX(smin, GSL_NONSYMMV_SMLNUM);
if (lambda_im == 0.0)
{
int k, l;
gsl_vector_view bv, xv;
/* real eigenvector */
/*
* The ordering of eigenvalues in 'eval' is arbitrary and
* does not necessarily follow the Schur form T, so store
* lambda in the right slot in eval to ensure it corresponds
* to the eigenvector we are about to compute
*/
gsl_vector_complex_set(eval, iu, lambda);
/*
* We need to solve the system:
*
* (T(1:iu-1, 1:iu-1) - lambda*I)*X = -T(1:iu-1,iu)
*/
/* construct right hand side */
for (k = 0; k < i; ++k)
{
gsl_vector_set(w->work,
(size_t) k,
-gsl_matrix_get(T, (size_t) k, iu));
}
gsl_vector_set(w->work, iu, 1.0);
for (l = i - 1; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
double x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = -T_{l(iu)}
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_view_array(dat, 1);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 1);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale x to avoid overflow */
x = gsl_vector_get(&xv.vector, 0);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
x /= xnorm;
scale /= xnorm;
}
}
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu, x);
if (lu > 0)
{
gsl_vector_view v1, v2;
/* update right hand side */
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-x, &v1.vector, &v2.vector);
} /* if (l > 0) */
} /* if (!complex_pair) */
else
{
double x11, x21;
/*
* 2-by-2 diagonal block
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_view_array(dat, 2);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu - 1));
gsl_vector_set(&bv.vector, 1,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 2);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale X(1,1) and X(2,1) to avoid overflow */
x11 = gsl_vector_get(&xv.vector, 0);
x21 = gsl_vector_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
x11 /= xnorm;
x21 /= xnorm;
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, x11);
gsl_vector_set(w->work, lu, x21);
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
gsl_blas_daxpy(-x11, &v1.vector, &v2.vector);
v1 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
gsl_blas_daxpy(-x21, &v1.vector, &v2.vector);
}
--l;
} /* if (complex_pair) */
} /* for (l = i - 1; l >= 0; --l) */
/*
* At this point, w->work is an eigenvector of the
* Schur form T. To get an eigenvector of the original
* matrix, we multiply on the left by Z, the matrix of
* Schur vectors
*/
ecol = gsl_matrix_complex_column(evec, iu);
y = gsl_matrix_column(Z, iu);
if (iu > 0)
{
gsl_vector_view x;
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu);
x = gsl_vector_subvector(w->work, 0, iu);
/* compute Z * w->work and store it in Z(:,iu) */
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu),
&y.vector);
} /* if (iu > 0) */
/* store eigenvector into evec */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
/* store real part of eigenvector */
gsl_vector_set(&ev.vector, ii, a);
/* set imaginary part to 0 */
gsl_vector_set(&ev2.vector, ii, 0.0);
if (fabs(a) > scale)
scale = fabs(a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by magnitude of largest element */
gsl_blas_dscal(scale, &ev.vector);
} /* if (GSL_IMAG(lambda) == 0.0) */
else
{
gsl_vector_complex_view bv, xv;
size_t k;
int l;
gsl_complex lambda2;
/* complex eigenvector */
/*
* Store the complex conjugate eigenvalues in the right
* slots in eval
*/
GSL_SET_REAL(&lambda2, GSL_REAL(lambda));
GSL_SET_IMAG(&lambda2, -GSL_IMAG(lambda));
gsl_vector_complex_set(eval, iu - 1, lambda);
gsl_vector_complex_set(eval, iu, lambda2);
/*
* First solve:
*
* [ T(i:i+1,i:i+1) - lambda*I ] * X = 0
*/
if (fabs(gsl_matrix_get(T, iu - 1, iu)) >=
fabs(gsl_matrix_get(T, iu, iu - 1)))
{
gsl_vector_set(w->work, iu - 1, 1.0);
gsl_vector_set(w->work2, iu,
lambda_im / gsl_matrix_get(T, iu - 1, iu));
}
else
{
gsl_vector_set(w->work, iu - 1,
-lambda_im / gsl_matrix_get(T, iu, iu - 1));
gsl_vector_set(w->work2, iu, 1.0);
}
gsl_vector_set(w->work, iu, 0.0);
gsl_vector_set(w->work2, iu - 1, 0.0);
/* construct right hand side */
for (k = 0; k < iu - 1; ++k)
{
gsl_vector_set(w->work, k,
-gsl_vector_get(w->work, iu - 1) *
gsl_matrix_get(T, k, iu - 1));
gsl_vector_set(w->work2, k,
-gsl_vector_get(w->work2, iu) *
gsl_matrix_get(T, k, iu));
}
/*
* We must solve the upper quasi-triangular system:
*
* [ T(1:i-2,1:i-2) - lambda*I ] * X = s*(work + i*work2)
*/
for (l = i - 2; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
gsl_complex bval;
gsl_complex x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = work + i*work2
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_complex_view_array(dat, 1);
xv = gsl_vector_complex_view_array(dat_X, 1);
GSL_SET_COMPLEX(&bval,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, bval);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
x = gsl_vector_complex_get(&xv.vector, 0);
gsl_vector_set(w->work, lu, GSL_REAL(x));
gsl_vector_set(w->work2, lu, GSL_IMAG(x));
/* update the right hand side */
if (lu > 0)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-GSL_REAL(x), &v1.vector, &v2.vector);
v2 = gsl_vector_subvector(w->work2, 0, lu);
gsl_blas_daxpy(-GSL_IMAG(x), &v1.vector, &v2.vector);
} /* if (lu > 0) */
} /* if (!complex_pair) */
else
{
gsl_complex b1, b2, x1, x2;
/*
* 2-by-2 diagonal block - solve the system
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_complex_view_array(dat, 2);
xv = gsl_vector_complex_view_array(dat_X, 2);
GSL_SET_COMPLEX(&b1,
gsl_vector_get(w->work, lu - 1),
gsl_vector_get(w->work2, lu - 1));
GSL_SET_COMPLEX(&b2,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, b1);
gsl_vector_complex_set(&bv.vector, 1, b2);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
x1 = gsl_vector_complex_get(&xv.vector, 0);
x2 = gsl_vector_complex_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, GSL_REAL(x1));
gsl_vector_set(w->work, lu, GSL_REAL(x2));
gsl_vector_set(w->work2, lu - 1, GSL_IMAG(x1));
gsl_vector_set(w->work2, lu, GSL_IMAG(x2));
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2, v3, v4;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v4 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
v3 = gsl_vector_subvector(w->work2, 0, lu - 1);
gsl_blas_daxpy(-GSL_REAL(x1), &v1.vector, &v2.vector);
gsl_blas_daxpy(-GSL_REAL(x2), &v4.vector, &v2.vector);
gsl_blas_daxpy(-GSL_IMAG(x1), &v1.vector, &v3.vector);
gsl_blas_daxpy(-GSL_IMAG(x2), &v4.vector, &v3.vector);
} /* if (lu > 1) */
--l;
} /* if (complex_pair) */
} /* for (l = i - 2; l >= 0; --l) */
/*
* At this point, work + i*work2 is an eigenvector
* of T - backtransform to get an eigenvector of the
* original matrix
*/
y = gsl_matrix_column(Z, iu - 1);
y2 = gsl_matrix_column(Z, iu);
if (iu > 1)
{
gsl_vector_view x;
/* compute real part of eigenvectors */
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu - 1);
x = gsl_vector_subvector(w->work, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu - 1),
&y.vector);
/* now compute the imaginary part */
x = gsl_vector_subvector(w->work2, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work2, iu),
&y2.vector);
}
else
{
gsl_blas_dscal(gsl_vector_get(w->work, iu - 1), &y.vector);
gsl_blas_dscal(gsl_vector_get(w->work2, iu), &y2.vector);
}
/*
* Now store the eigenvectors into evec - the real parts
* are Z(:,iu - 1) and the imaginary parts are
* +/- Z(:,iu)
*/
/* get views of the two eigenvector slots */
ecol = gsl_matrix_complex_column(evec, iu - 1);
ecol2 = gsl_matrix_complex_column(evec, iu);
/*
* save imaginary part first as it may get overwritten
* when copying the real part due to our storage scheme
* in Z/evec
*/
ev = gsl_vector_complex_imag(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol2.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y2.vector, ii);
scale = GSL_MAX(scale,
fabs(a) + fabs(gsl_vector_get(&y.vector, ii)));
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, -a);
}
/* now save the real part */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_real(&ecol2.vector);
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by largest element magnitude */
gsl_blas_zdscal(scale, &ecol.vector);
gsl_blas_zdscal(scale, &ecol2.vector);
/*
* decrement i since we took care of two eigenvalues at
* the same time
*/
--i;
} /* if (GSL_IMAG(lambda) != 0.0) */
} /* for (i = (int) N - 1; i >= 0; --i) */
} /* nonsymmv_get_right_eigenvectors() */
/**
* C++ version of gsl_blas_zdscal().
* @param alpha A constant
* @param X A vector
*/
void zdscal( double alpha, vector_complex& X ){ gsl_blas_zdscal( alpha, X.get() ); }
/** Unary minus */
vector<complex> vector<complex>::operator-() const
{
vector<complex> v1(_vector);
gsl_blas_zdscal(-1., v1.as_gsl_type_ptr());
return v1;
}
void
test_eigen_gen_results (const gsl_matrix * A, const gsl_matrix * B,
const gsl_vector_complex * alpha,
const gsl_vector * beta,
const gsl_matrix_complex * evec,
size_t count, const char * desc,
const char * desc2)
{
const size_t N = A->size1;
size_t i, j;
gsl_matrix_complex *ma, *mb;
gsl_vector_complex *x, *y;
gsl_complex z_one, z_zero;
ma = gsl_matrix_complex_alloc(N, N);
mb = gsl_matrix_complex_alloc(N, N);
y = gsl_vector_complex_alloc(N);
x = gsl_vector_complex_alloc(N);
/* ma <- A, mb <- B */
for (i = 0; i < N; ++i)
{
for (j = 0; j < N; ++j)
{
gsl_complex z;
GSL_SET_COMPLEX(&z, gsl_matrix_get(A, i, j), 0.0);
gsl_matrix_complex_set(ma, i, j, z);
GSL_SET_COMPLEX(&z, gsl_matrix_get(B, i, j), 0.0);
gsl_matrix_complex_set(mb, i, j, z);
}
}
GSL_SET_COMPLEX(&z_one, 1.0, 0.0);
GSL_SET_COMPLEX(&z_zero, 0.0, 0.0);
/* check eigenvalues */
for (i = 0; i < N; ++i)
{
gsl_vector_complex_const_view vi =
gsl_matrix_complex_const_column(evec, i);
gsl_complex ai = gsl_vector_complex_get(alpha, i);
double bi = gsl_vector_get(beta, i);
/* compute x = alpha * B * v */
gsl_blas_zgemv(CblasNoTrans, z_one, mb, &vi.vector, z_zero, x);
gsl_blas_zscal(ai, x);
/* compute y = beta * A v */
gsl_blas_zgemv(CblasNoTrans, z_one, ma, &vi.vector, z_zero, y);
gsl_blas_zdscal(bi, y);
/* now test if y = x */
for (j = 0; j < N; ++j)
{
gsl_complex xj = gsl_vector_complex_get(x, j);
gsl_complex yj = gsl_vector_complex_get(y, j);
gsl_test_abs(GSL_REAL(yj), GSL_REAL(xj), 1e8*GSL_DBL_EPSILON,
"gen(N=%u,cnt=%u), %s, eigenvalue(%d,%d), real, %s",
N, count, desc, i, j, desc2);
gsl_test_abs(GSL_IMAG(yj), GSL_IMAG(xj), 1e8*GSL_DBL_EPSILON,
"gen(N=%u,cnt=%u), %s, eigenvalue(%d,%d), real, %s",
N, count, desc, i, j, desc2);
}
}
gsl_matrix_complex_free(ma);
gsl_matrix_complex_free(mb);
gsl_vector_complex_free(y);
gsl_vector_complex_free(x);
} /* test_eigen_gen_results() */
int
gsl_linalg_complex_cholesky_decomp(gsl_matrix_complex *A)
{
const size_t N = A->size1;
if (N != A->size2)
{
GSL_ERROR("cholesky decomposition requires square matrix", GSL_ENOTSQR);
}
else
{
size_t i, j;
gsl_complex z;
double ajj;
for (j = 0; j < N; ++j)
{
z = gsl_matrix_complex_get(A, j, j);
ajj = GSL_REAL(z);
if (j > 0)
{
gsl_vector_complex_const_view aj =
gsl_matrix_complex_const_subrow(A, j, 0, j);
gsl_blas_zdotc(&aj.vector, &aj.vector, &z);
ajj -= GSL_REAL(z);
}
if (ajj <= 0.0)
{
GSL_ERROR("matrix is not positive definite", GSL_EDOM);
}
ajj = sqrt(ajj);
GSL_SET_COMPLEX(&z, ajj, 0.0);
gsl_matrix_complex_set(A, j, j, z);
if (j < N - 1)
{
gsl_vector_complex_view av =
gsl_matrix_complex_subcolumn(A, j, j + 1, N - j - 1);
if (j > 0)
{
gsl_vector_complex_view aj =
gsl_matrix_complex_subrow(A, j, 0, j);
gsl_matrix_complex_view am =
gsl_matrix_complex_submatrix(A, j + 1, 0, N - j - 1, j);
cholesky_complex_conj_vector(&aj.vector);
gsl_blas_zgemv(CblasNoTrans,
GSL_COMPLEX_NEGONE,
&am.matrix,
&aj.vector,
GSL_COMPLEX_ONE,
&av.vector);
cholesky_complex_conj_vector(&aj.vector);
}
gsl_blas_zdscal(1.0 / ajj, &av.vector);
}
}
/* Now store L^H in upper triangle */
for (i = 1; i < N; ++i)
{
for (j = 0; j < i; ++j)
{
z = gsl_matrix_complex_get(A, i, j);
gsl_matrix_complex_set(A, j, i, gsl_complex_conjugate(z));
}
}
return GSL_SUCCESS;
}
} /* gsl_linalg_complex_cholesky_decomp() */
int
gsl_linalg_complex_cholesky_invert(gsl_matrix_complex * LLT)
{
if (LLT->size1 != LLT->size2)
{
GSL_ERROR ("cholesky matrix must be square", GSL_ENOTSQR);
}
else
{
size_t N = LLT->size1;
size_t i, j;
gsl_vector_complex_view v1;
/* invert the lower triangle of LLT */
for (i = 0; i < N; ++i)
{
double ajj;
gsl_complex z;
j = N - i - 1;
{
gsl_complex z0 = gsl_matrix_complex_get(LLT, j, j);
ajj = 1.0 / GSL_REAL(z0);
}
GSL_SET_COMPLEX(&z, ajj, 0.0);
gsl_matrix_complex_set(LLT, j, j, z);
{
gsl_complex z1 = gsl_matrix_complex_get(LLT, j, j);
ajj = -GSL_REAL(z1);
}
if (j < N - 1)
{
gsl_matrix_complex_view m;
m = gsl_matrix_complex_submatrix(LLT, j + 1, j + 1,
N - j - 1, N - j - 1);
v1 = gsl_matrix_complex_subcolumn(LLT, j, j + 1, N - j - 1);
gsl_blas_ztrmv(CblasLower, CblasNoTrans, CblasNonUnit,
&m.matrix, &v1.vector);
gsl_blas_zdscal(ajj, &v1.vector);
}
} /* for (i = 0; i < N; ++i) */
/*
* The lower triangle of LLT now contains L^{-1}. Now compute
* A^{-1} = L^{-H} L^{-1}
*
* The (ij) element of A^{-1} is column i of conj(L^{-1}) dotted into
* column j of L^{-1}
*/
for (i = 0; i < N; ++i)
{
gsl_complex sum;
for (j = i + 1; j < N; ++j)
{
gsl_vector_complex_view v2;
v1 = gsl_matrix_complex_subcolumn(LLT, i, j, N - j);
v2 = gsl_matrix_complex_subcolumn(LLT, j, j, N - j);
/* compute Ainv[i,j] = sum_k{conj(Linv[k,i]) * Linv[k,j]} */
gsl_blas_zdotc(&v1.vector, &v2.vector, &sum);
/* store in upper triangle */
gsl_matrix_complex_set(LLT, i, j, sum);
}
/* now compute the diagonal element */
v1 = gsl_matrix_complex_subcolumn(LLT, i, i, N - i);
gsl_blas_zdotc(&v1.vector, &v1.vector, &sum);
gsl_matrix_complex_set(LLT, i, i, sum);
}
/* copy the Hermitian upper triangle to the lower triangle */
for (j = 1; j < N; j++)
{
for (i = 0; i < j; i++)
{
gsl_complex z = gsl_matrix_complex_get(LLT, i, j);
gsl_matrix_complex_set(LLT, j, i, gsl_complex_conjugate(z));
}
}
return GSL_SUCCESS;
}
} /* gsl_linalg_complex_cholesky_invert() */
