int check_convergence_dprimme(double *V, double *W, double *hVecs,
double *hVals, int *flags, int basisSize, int *iev, int *ievMax,
double *blockNorms, int *blockSize, int numConverged, int numLocked,
double *evecs, double tol, double maxConvTol, double aNormEstimate,
double *rwork, primme_params *primme) {
int i; /* Loop variable */
int left, right; /* Range of block vectors to be checked for convergence */
int start; /* starting index in block of converged/tobeProject vecs*/
int numVacancies; /* Number of vacant positions between left and right */
int recentlyConverged; /* The number of Ritz values declared converged */
/* since the last iteration */
int numToProject; /* Number of vectors with potential accuracy problem*/
double attainableTol; /* Used in locking to check near convergence problem*/
/* -------------------------------------------- */
/* Tolerance based on our dynamic norm estimate */
/* -------------------------------------------- */
if (primme->aNorm <= 0.0L) {
tol = tol * aNormEstimate;
}
/* ---------------------------------------------------------------------- */
/* If locking, set tol beyond which we need to check for accuracy problem */
/* ---------------------------------------------------------------------- */
if (primme->locking) {
attainableTol = sqrt(primme->numOrthoConst+numLocked)*maxConvTol;
}
/* --------------------------------------------------------------- */
/* Compute each Ritz vector and its corresponding residual vector. */
/* The Ritz vector and residual are stored temporarily in V and W */
/* respectively. For each Ritz vector, determine if it has */
/* converged. If it has, try to replace it with one that hasn't. */
/* --------------------------------------------------------------- */
recentlyConverged = 0;
left = 0;
right = *blockSize - 1;
numVacancies = 1;
while (numVacancies > 0 &&
(numConverged + recentlyConverged) < primme->numEvals) {
/* Consider the newly added vectors in the block and reset counters */
numVacancies = 0;
numToProject = 0;
/* Copy needed hvecs into the front of the work array. */
for (i=left; i <= right; i++) {
Num_dcopy_dprimme(basisSize, &hVecs[basisSize*iev[i]], 1,
&rwork[basisSize*(i-left)], 1);
}
/* ----------------------------------------------------------------- */
/* Compute the Ritz vectors, residuals, and norms for the next */
/* blockSize unconverged Ritz vectors. The Ritz vectors will be */
/* placed from V(0,lft) to V(0,rgt) and the residual vectors from */
/* W(0,lft) to W(0,rgt). */
/* ----------------------------------------------------------------- */
/* rwork must be maxBasisSize*maxBlockSize + maxBlockSize in size, */
/* maxBasisSize*maxBlockSize holds selected hVecs to facilitate */
/* blocking, and maxBlockSize to hold the residual norms */
/* ----------------------------------------------------------------- */
compute_resnorms(V, W, rwork, hVals, basisSize, blockNorms,
iev, left, right, &rwork[basisSize*(right-left+1)], primme);
print_residuals(hVals, blockNorms, numConverged, numLocked, iev,
left, right, primme);
/* ----------------------------------------------------------------- */
/* Determine which Ritz vectors have converged < tol and flag them. */
/* ----------------------------------------------------------------- */
for (i=left; i <= right; i++) {
/* ------------------------------------*/
/* If the vector is converged, flag it */
/* ------------------------------------*/
if (blockNorms[i] < tol) {
flags[iev[i]] = CONVERGED;
numVacancies++;
if ((!primme->locking && iev[i] < primme->numEvals) ||
(primme->locking && ((numLocked + iev[i]) < primme->numEvals))) {
recentlyConverged++;
if (!primme->locking && primme->procID == 0 &&
primme->printLevel >= 2) { fprintf(primme->outputFile,
"#Converged %d eval[ %d ]= %e norm %e Mvecs %d Time %g\n",
numConverged+recentlyConverged, iev[i], hVals[iev[i]],
blockNorms[i], primme->stats.numMatvecs,primme_wTimer(0));
fflush(primme->outputFile);
} /* printf */
} /*if */
} /*if converged */
/* ---------------------------------------------------------------- */
/* If locking there may be an accuracy problem close to convergence */
/* Check if there is danger and set these Ritz vecs for projection */
/* ---------------------------------------------------------------- */
else if (primme->locking && numLocked > 0 &&
blockNorms[i] < attainableTol ) {
flags[iev[i]] = TO_BE_PROJECTED;
numToProject++;
}
} /* for */
/* ---------------------------------------------------------------- */
/* If some of the Ritz vectors in the block have converged, or need */
/* to be projected against evecs, move those flagged Ritz vectors */
/* and residuals towards the end of the block [left,right]. Also */
/* swap iev, and blockNorms for the targeted block. */
/* ---------------------------------------------------------------- */
if (numVacancies > 0 || numToProject > 0) {
swap_UnconvVecs(V, W, primme->nLocal, basisSize, iev, flags,
blockNorms, primme->numOrthoConst + numLocked, *blockSize, left);
}
/* --------------------------------------------------------------- */
/* Project the TO_BE_PROJECTED residuals and check for practical */
/* convergence among them. Those practically converged evecs are */
/* swapped just before the converged ones at the end of the block. */
/* numVacancies and recentlyConverged are also updated */
/* --------------------------------------------------------------- */
if (numToProject > 0) {
start = *blockSize - numVacancies - numToProject;
check_practical_convergence(V, W, evecs, numLocked, basisSize,
*blockSize, start, numToProject, iev, flags, blockNorms, tol,
&recentlyConverged, &numVacancies, rwork, primme);
}
/* ---------------------------------------------------------------- */
/* Replace the vacancies, with as many unconverged vectors beyond */
/* ievMax as possible. If not enough are available reduce blockSize */
/* ---------------------------------------------------------------- */
if (numVacancies > 0) {
replace_vectors(iev, flags, *blockSize, basisSize, numVacancies,
&left, &right, ievMax);
numVacancies = right - left + 1;
*blockSize = left + numVacancies;
}
} /* while there are vacancies */
return recentlyConverged;
}
/* ardimods_init: Called when ardimods is loaded. */
void ardimods_init(void)
{
replace_vectors();
printf("ARDI mods 1.8 loaded (for NEXTSTEP 3.0 or later)\n");
printf("Fast A-line Traps installed\n");
}
