static int pack_converged_coefficients(int *restartSize, int basisSize,
int *numPrevRetained, int numLocked, int numGuesses, Complex_Z *hVecs,
double *hVals, int *flag, primme_params *primme) {
int i; /* Loop variable */
int left, right; /* Search indices */
int itemp; /* Temporary variable used for swapping */
int numFlagged; /* Number of target converged Ritz vectors that have */
/* converged since the last time this function was */
/* called. */
double dtemp; /* Temporary variable used for swapping */
/* ---------------------------------------------- */
/* Only converged target vectors should be locked */
/* ---------------------------------------------- */
for (i = 0, numFlagged = 0; i < basisSize; i++) {
/* Make sure the vector is converged and it's a target Ritz vector */
if (flag[i] == CONVERGED && (numLocked + i < primme->numEvals)) {
flag[i] = LOCK_IT;
numFlagged++;
}
else if (flag[i] == PRACTICALLY_CONVERGED &&
(numLocked + i < primme->numEvals)) {
flag[i] = UNCONDITIONAL_LOCK_IT;
numFlagged++;
}
}
/* ----------------------------------------------------------- */
/* Special case: If (basisSize+numLocked) is the entire space, */
/* then everything should be converged. Do not test, just flag */
/* everything as converged to be locked. */
/* ----------------------------------------------------------- */
if (basisSize + numLocked + primme->numOrthoConst == primme->n) {
for (numFlagged = 0;
numFlagged < min(primme->numEvals-numLocked, basisSize);
numFlagged++) {
flag[numFlagged] = LOCK_IT;
}
}
/* ------------------------------------------------------------------- */
/* Redefine restartSize so that we have at least restartSize in the */
/* basis when we restart and after initial guesses are substituted in */
/* If more than primme.restartSize have converged we need to keep them */
/* If necessary do not throw any vectors (ie., if the above>basisSize) */
/* In that case, there is no need to keep any previous Ritz vectors. */
/* ------------------------------------------------------------------- */
itemp = min(numFlagged, numGuesses);
if (itemp >= *restartSize)
*restartSize = numFlagged;
else
*restartSize = *restartSize + numFlagged - itemp;
if (*restartSize + *numPrevRetained >= basisSize) {
*restartSize = basisSize;
*numPrevRetained = 0;
}
/* ------------------------------------------------------------------ */
/* The right index starts at the end of the flags[0..restartSize-1] */
/* subarray and stops decreasing when it finds a vector that is not */
/* to be locked. The left index is then used to find a replacement */
/* to swap with. This replacement must be a vector targeted for */
/* locking. If no replacement can be found, the packing is finished. */
/* ------------------------------------------------------------------ */
right = *restartSize - 1;
while (right >= 0) {
/* Find a vector that is not to be locked */
while (right >= 0 && (flag[right] == LOCK_IT ||
flag[right] == UNCONDITIONAL_LOCK_IT) ) {
right--;
}
left = right - 1;
/* Find a vector that is to be locked */
while (left >= 0 && flag[left] != LOCK_IT &&
flag[left] != UNCONDITIONAL_LOCK_IT) {
left--;
}
/* If no such vector could be found, packing is complete */
if (left < 0) {
return numFlagged;
}
/* Swap the coefficient vectors corresponding to left and right. */
Num_swap_zprimme(basisSize, &hVecs[basisSize*left], 1,
&hVecs[basisSize*right], 1);
/* Swap the Ritz values */
dtemp = hVals[left];
hVals[left] = hVals[right];
hVals[right] = dtemp;
/* Swap the flag values */
itemp = flag[left];
flag[left] = flag[right];
flag[right] = itemp;
}
return numFlagged;
}
static void swap_UnconvVecs(Complex_Z *V, Complex_Z *W, int nLocal,
int basisSize, int *iev, int *flags, double *blockNorms, int dimEvecs,
int blockSize, int left) {
int right; /* holds the right swapping position */
int temp; /* used to swap integers */
double dtemp; /* used to swap doubles */
/* Search from left to right within the block looking for flagged */
/* Ritz vectors. If a flagged one is found, find also an unconverged */
/* Ritz vector from the right side of the block. If the flagged was */
/* converged, replace it with the unconverged, otherwise if it was */
/* was flagged TO_BE_PROJECTED, swap it with the unconverged vector. */
while (left < blockSize) {
/* If block vector left is unconverged, move left one vector. */
if (flags[iev[left]] == UNCONVERGED) {
left++;
}
else {
/* If block vector left is converged, find an unconverged */
/* vector somewhere between left+1 and blockSize. */
right = left + 1;
/* If the end of the block has been reached, there are */
/* no more unconverged vectors left. If not, keep */
/* searching right for another unconverged vector to */
/* perform the replacement. */
while (right < blockSize && flags[iev[right]] != UNCONVERGED) {
right++;
}
/* No unconverged block vector could be found */
if (right == blockSize) {
return;
}
/* An unconverged Ritz vector was found and should */
/* replace or be swapped with block vector left. */
if (flags[iev[left]] != TO_BE_PROJECTED) {
/* replace */
Num_zcopy_zprimme(nLocal, &V[nLocal*(basisSize+right)], 1,
&V[nLocal*(basisSize+left)], 1);
Num_zcopy_zprimme(nLocal, &W[nLocal*(basisSize+right)], 1,
&W[nLocal*(basisSize+left)], 1);
temp = iev[left];
iev[left] = iev[right];
iev[right] = temp;
blockNorms[left] = blockNorms[right];
}
else { /* swap */
Num_swap_zprimme(nLocal, &V[nLocal*(basisSize+left)], 1,
&V[nLocal*(basisSize+right)], 1);
Num_swap_zprimme(nLocal, &W[nLocal*(basisSize+left)], 1,
&W[nLocal*(basisSize+right)], 1);
temp = iev[left];
iev[left] = iev[right];
iev[right] = temp;
dtemp = blockNorms[left];
blockNorms[left] = blockNorms[right];
blockNorms[right] = dtemp;
} /* end of swaps */
left++;
} // looking for replacement
} //while left < blockSize
}
