TEMPLATE_PLEASE
int map_vecs_Sprimme(HSCALAR *V, int m, int nV, int ldV, HSCALAR *W, int n0,
int n, int ldW, int *p, primme_context ctx) {
int i; /* Loop variable */
/* Compute the norm of the columns V(n0:n-1) */
HREAL *Vnorms = NULL;
CHKERR(Num_malloc_RHprimme(nV, &Vnorms, ctx));
for (i = 0; i < nV; i++) {
Vnorms[i] = sqrt(REAL_PART(
Num_dot_SHprimme(m, &V[ldV * i], 1, &V[ldV * i], 1, ctx)));
}
/* Compute V'*W[n0:n-1] */
HSCALAR *ip = NULL;
CHKERR(Num_malloc_SHprimme(nV * (n - n0), &ip, ctx));
Num_zero_matrix_SHprimme(ip, nV, n - n0, nV, ctx);
CHKERR(Num_gemm_SHprimme("C", "N", nV, n - n0, m, 1.0, V, ldV, &W[ldW * n0],
ldW, 0.0, ip, nV, ctx));
for (i = n0; i < n; i++) {
/* Find the j that maximizes ABS(V[j]'*W[i]/Vnorms[j]) and is not */
/* in p(0:i-1) */
int j, jmax=-1;
HREAL ipmax = -1;
for (j = 0; j < nV; j++) {
HREAL ipij = ABS(ip[nV * (i - n0) + j]);
if (ipij > ipmax * Vnorms[j]) {
/* Check that j is not in p(0:i-1) */
int k;
for (k = 0; k < i && p[k] != j; k++)
;
if (k < i) continue;
/* Update ipmax and jmax */
ipmax = fabs(ipij / Vnorms[j]);
jmax = j;
}
}
if (jmax < 0) {
jmax = i;
}
/* Assign the map */
p[i] = jmax;
}
CHKERR(Num_free_RHprimme(Vnorms, ctx));
CHKERR(Num_free_SHprimme(ip, ctx));
return 0;
}
/** Calculate Gershgorin bounds for a dense matrix.
*
* \ingroup gershgorin_group
*
* \param A The matrix
* returns maxeval Calculated max value
* returns maxminusmin Calculated max-min value
*/
void *TYPED_FUNC(
bml_gershgorin_dense) (
const bml_matrix_dense_t * A)
{
REAL_T radius, dvalue, absham;
int N = A->N;
REAL_T *A_matrix = A->matrix;
double emin = 100000000000.0;
double emax = -100000000000.0;
double *eval = bml_allocate_memory(sizeof(double) * 2);
#pragma omp parallel for default(none) shared(N, A_matrix) private(absham, radius, dvalue) reduction(max:emax) reduction(min:emin)
for (int i = 0; i < N; i++)
{
radius = 0.0;
for (int j = 0; j < N; j++)
{
absham = ABS(A_matrix[ROWMAJOR(i, j, N, N)]);
radius += (double) absham;
}
dvalue = A_matrix[ROWMAJOR(i, i, N, N)];
radius -= ABS(dvalue);
emax =
(emax >
REAL_PART(dvalue + radius) ? emax : REAL_PART(dvalue + radius));
emin =
(emin <
REAL_PART(dvalue - radius) ? emin : REAL_PART(dvalue - radius));
}
eval[0] = emax;
eval[1] = emax - emin;
return eval;
}
/******************************************************************************
* Generates the diagonal of A.
*
* P = Diag(A)
*
* This will be used with solver provided shifts as (P-shift_i)^(-1)
******************************************************************************/
static void getDiagonal(const CSRMatrix *matrix, double *diag) {
int i, j;
/* IA and JA are indexed using C indexing, but their contents */
/* assume Fortran indexing. Thus, the contents of IA and JA */
/* must be decremented before being used in C. */
for (i=0; i < matrix->n; i++) {
diag[i] = 0.;
for (j=matrix->IA[i]; j <= matrix->IA[i+1]-1; j++) {
if (matrix->JA[j-1]-1 == i) {
diag[i] = REAL_PART(matrix->AElts[j-1]);
}
}
}
}
/** Calculate the trace of a matrix.
*
* \ingroup trace_group
*
* \param A The matrix to calculate a trace for
* \return The trace of A
*/
double TYPED_FUNC(
bml_trace_dense) (
const bml_matrix_dense_t * A)
{
int N = A->N;
REAL_T trace = 0.0;
REAL_T *A_matrix = A->matrix;
#pragma omp parallel for default(none) shared(N, A_matrix) reduction(+:trace)
for (int i = 0; i < N; i++)
{
trace += A_matrix[ROWMAJOR(i, i, N, N)];
}
return (double) REAL_PART(trace);
}