static VALUE rb_gsl_blas_zherk(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
VALUE b, VALUE cc)
{
gsl_matrix_complex *A = NULL, *C = NULL;
double alpha, beta;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t Trans;
CHECK_FIXNUM(u); CHECK_FIXNUM(t);
Need_Float(a); Need_Float(b);
CHECK_MATRIX_COMPLEX(aa);
CHECK_MATRIX_COMPLEX(cc);
Uplo = FIX2INT(u);
Trans = FIX2INT(t);
alpha = NUM2DBL(a);
beta = NUM2DBL(b);
Data_Get_Struct(aa, gsl_matrix_complex, A);
Data_Get_Struct(cc, gsl_matrix_complex, C);
gsl_blas_zherk(Uplo, Trans, alpha, A, beta, C);
return cc;
}
static VALUE rb_gsl_blas_zherk2(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
VALUE b, VALUE cc)
{
gsl_matrix_complex *A = NULL, *C = NULL, *Cnew = NULL;
double alpha, beta;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t Trans;
CHECK_FIXNUM(u); CHECK_FIXNUM(t);
Need_Float(a); Need_Float(b);
CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(cc);
Uplo = FIX2INT(u);
Trans = FIX2INT(t);
alpha = NUM2DBL(a);
beta = NUM2DBL(b);
Data_Get_Struct(aa, gsl_matrix_complex, A);
Data_Get_Struct(cc, gsl_matrix_complex, C);
Cnew = gsl_matrix_complex_alloc(C->size1, C->size2);
gsl_matrix_complex_memcpy(Cnew, C);
gsl_blas_zherk(Uplo, Trans, alpha, A, beta, Cnew);
return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Cnew);
}
/**
* C++ version of gsl_blas_zherk().
* @param Uplo Upper or lower triangular
* @param Trans Transpose type
* @param alpha A constant
* @param A A matrix
* @param beta Another constant
* @param C Another matrix
* @return Error code on failure
*/
int zherk( CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha,
matrix_complex const& A, double beta, matrix_complex& C ){
return gsl_blas_zherk( Uplo, Trans, alpha, A.get(), beta, C.get() ); }
int
lls_complex_fold(const gsl_matrix_complex *A, const gsl_vector_complex *b,
lls_complex_workspace *w)
{
const size_t n = A->size1;
if (A->size2 != w->p)
{
fprintf(stderr, "lls_complex_fold: A has wrong size2\n");
return GSL_EBADLEN;
}
else if (n != b->size)
{
fprintf(stderr, "lls_complex_fold: b has wrong size\n");
return GSL_EBADLEN;
}
else
{
int s = 0;
double bnorm;
#if 0
size_t i;
gsl_vector_view wv = gsl_vector_subvector(w->w_robust, 0, n);
if (w->niter > 0)
{
gsl_vector_complex_view rc = gsl_vector_complex_subvector(w->r_complex, 0, n);
gsl_vector_view rv = gsl_vector_subvector(w->r, 0, n);
/* calculate residuals with previously computed coefficients: r = b - A c */
gsl_vector_complex_memcpy(&rc.vector, b);
gsl_blas_zgemv(CblasNoTrans, GSL_COMPLEX_NEGONE, A, w->c, GSL_COMPLEX_ONE, &rc.vector);
/* compute Re(r) */
for (i = 0; i < n; ++i)
{
gsl_complex ri = gsl_vector_complex_get(&rc.vector, i);
gsl_vector_set(&rv.vector, i, GSL_REAL(ri));
}
/* calculate weights with robust weighting function */
gsl_multifit_robust_weights(&rv.vector, &wv.vector, w->robust_workspace_p);
}
else
gsl_vector_set_all(&wv.vector, 1.0);
/* compute final weights as product of input and robust weights */
gsl_vector_mul(wts, &wv.vector);
#endif
/* AHA += A^H A, using only the upper half of the matrix */
s = gsl_blas_zherk(CblasUpper, CblasConjTrans, 1.0, A, 1.0, w->AHA);
if (s)
return s;
/* AHb += A^H b */
s = gsl_blas_zgemv(CblasConjTrans, GSL_COMPLEX_ONE, A, b, GSL_COMPLEX_ONE, w->AHb);
if (s)
return s;
/* bHb += b^H b */
bnorm = gsl_blas_dznrm2(b);
w->bHb += bnorm * bnorm;
fprintf(stderr, "norm(AHb) = %.12e, bHb = %.12e\n",
gsl_blas_dznrm2(w->AHb), w->bHb);
if (!gsl_finite(w->bHb))
{
fprintf(stderr, "bHb is NAN\n");
exit(1);
}
return s;
}
} /* lls_complex_fold() */
