int lock_vectors_dprimme(double tol, double *aNormEstimate, double *maxConvTol, int *basisSize, int *numLocked, int *numGuesses, int *nextGuess, double *V, double *W, double *H, double *evecsHat, double *M, double *UDU, int *ipivot, double *hVals, double *hVecs, double *evecs, double *evals, int *perm, double machEps, double *resNorms, int *numPrevRitzVals, double *prevRitzVals, int *flag, double *rwork, int rworkSize, int *iwork, int *LockingProblem, primme_params *primme) { int i; /* Loop counter */ int numCandidates; /* Number of targeted Ritz vectors converged before */ /* restart. */ int newStart; /* Index in evecs where the locked vectors were added */ int numNewVectors; /* Number of vectors added to the basis to replace */ /* locked vectors. */ int candidate; /* Index of Ritz vector to be checked for convergence */ int numDeflated; /* The number of vectors actually locked */ int numReplaced; /* The number of locked vectors that were replaced by */ /* initial guesses. */ int numRecentlyLocked; /* Number of vectors locked. */ int evecsSize; /* The number of orthogonalization constraints plus */ /* the number of locked vectors. */ int ret; /* Used to store return values. */ int workinW; /* Flag whether an active W vector is used as tempwork*/ int entireSpace = (*basisSize+*numLocked >= primme->n); /* bool if entire*/ /* space is built, so current ritzvecs are accurate. */ double *norms, *tnorms; /* Array of residual norms, and temp array */ double attainableTol; /* Used to verify a practical convergence problem*/ double *residual; /* Stores residual vector */ double ztmp; /* temp variable */ /* ----------------------------------------*/ /* Assign temporary work space for residual*/ /* ----------------------------------------*/ if (*basisSize < primme->maxBasisSize) { /* compute residuals in the next open slot of W */ residual = &W[*basisSize*primme->nLocal]; workinW = 0; } else { /* This basiSize==maxBasisSize, immediately after restart, can only occur * if the basisSize + numLocked = n (at which case we lock everything) * OR if (numConverged + restartSize + numPrevRetain > basisSize), ie. * too many converged. Since we do not know which evec will be locked * we use the W[LAST] as temporary space, but only after W[LAST] has * been used to compute residual(LAST) -the while loop starts from LAST. * After all lockings, if the LAST evec was not locked, we must * recompute W[LAST]=Av. This matvec event is extremely infrequent */ residual = &W[(*basisSize-1)*primme->nLocal]; workinW = 1; } /* -------------------------------------*/ /* Set the tolerance, and attainableTol */ /* -------------------------------------*/ if (primme->aNorm <= 0.0L) { tol = tol * (*aNormEstimate); } attainableTol=max(tol,sqrt(primme->numOrthoConst+*numLocked)*(*maxConvTol)); /* -------------------------------------------------------- */ /* Determine how many Ritz vectors converged before restart */ /* -------------------------------------------------------- */ i = *basisSize - 1; while ((flag[i] == LOCK_IT ||flag[i] == UNCONDITIONAL_LOCK_IT) && i >= 0) { i--; } numCandidates = *basisSize - i - 1; if (numCandidates == 0) { return 0; } /* --------------------------------- */ /* Compute residuals and their norms */ /* --------------------------------- */ tnorms = (double *) rwork; norms = tnorms + numCandidates; for (i = *basisSize-1, candidate = numCandidates-1; i >= *basisSize-numCandidates; i--, candidate--) { Num_dcopy_dprimme(primme->nLocal, &W[primme->nLocal*i], 1, residual, 1); ztmp = -hVals[i]; Num_axpy_dprimme(primme->nLocal, ztmp, &V[primme->nLocal*i],1,residual,1); tnorms[candidate] = Num_dot_dprimme(primme->nLocal,residual,1,residual,1); } /* Global sum the dot products */ (*primme->globalSumDouble)(tnorms, norms, &numCandidates, primme); numRecentlyLocked = 0; /* ------------------------------------------------------------------- */ /* Check the convergence of each residual norm. If the Ritz vector is */ /* converged, then lock it. */ /* ------------------------------------------------------------------- */ for (i = *basisSize - numCandidates, candidate = 0; i < *basisSize; i++, candidate++) { norms[candidate] = sqrt(norms[candidate]); /* If the vector has become (regularly or practically) unconverged, */ /* then flag it, else lock it and replace it with an initial guess, */ /* if one is available. Exception: If the entire space is spanned, */ /* we can't do better, so lock it. */ if ((flag[i]!=UNCONDITIONAL_LOCK_IT && norms[candidate] >= tol && !entireSpace ) || (flag[i]==UNCONDITIONAL_LOCK_IT && norms[candidate] >= attainableTol && !entireSpace )) { flag[i] = UNCONVERGED; } else { /* If an unconditional lock has become converged, show it and */ /* record the max converged tolerance accordingly */ if (norms[candidate]<tol) { flag[i]=LOCK_IT; *maxConvTol = max(*maxConvTol, tol); } else { *maxConvTol = max(*maxConvTol, norms[candidate]); *LockingProblem = 1; } if (primme->printLevel >= 2 && primme->procID == 0) { fprintf(primme->outputFile, "Lock epair[ %d ]= %e norm %.4e Mvecs %d Time %.4e Flag %d\n", *numLocked+1, hVals[i], norms[candidate], primme->stats.numMatvecs,primme_wTimer(0),flag[i]); fflush(primme->outputFile); } /* Copy the converged Ritz vector to the evecs array and */ /* insert the converged Ritz value in sorted order within */ /* the evals array. */ Num_dcopy_dprimme(primme->nLocal, &V[primme->nLocal*i], 1, &evecs[primme->nLocal*(primme->numOrthoConst + *numLocked)], 1); insertionSort(hVals[i], evals, norms[candidate], resNorms, perm, *numLocked, primme); /* If there are any initial guesses remaining, then copy it */ /* into the basis, else flag the vector as locked so it may */ /* be discarded later. */ if (*numGuesses > 0) { Num_dcopy_dprimme(primme->nLocal, &evecs[primme->nLocal*(*nextGuess)], 1, &V[primme->nLocal*i], 1); flag[i] = INITIAL_GUESS; *numGuesses = *numGuesses - 1; *nextGuess = *nextGuess + 1; } else { flag[i] = LOCKED; } *numLocked = *numLocked + 1; numRecentlyLocked++; } } evecsSize = primme->numOrthoConst + *numLocked; /* -------------------------------------------------------------------- */ /* If a W vector was used as workspace for residual AND its evec has */ /* not been locked out, recompute it, W = A*v. This is rare. */ /* -------------------------------------------------------------------- */ if (workinW && flag[*basisSize-1] != LOCKED) { update_W_dprimme(V, W, *basisSize-1, 1, primme); } /* -------------------------------------------------------------------- */ /* Return IF all target Ritz vectors have been locked, ELSE update the */ /* evecsHat array by applying the preconditioner (if preconditioning is */ /* needed, and JDQMR with right, skew Q projector is applied */ /* -------------------------------------------------------------------- */ if (*numLocked >= primme->numEvals) { return 0; } else if (UDU != NULL) { /* Compute K^{-1}x for all newly locked eigenvectors */ newStart = primme->nLocal*(evecsSize - numRecentlyLocked); (*primme->applyPreconditioner)( &evecs[newStart], &evecsHat[newStart], &numRecentlyLocked, primme); primme->stats.numPreconds += numRecentlyLocked; /* Update the projection evecs'*evecsHat now that evecs and evecsHat */ /* have been expanded by numRecentlyLocked columns. Required */ /* workspace is numLocked*numEvals. The most ever needed would be */ /* maxBasisSize*numEvals. */ update_projection_dprimme(evecs, evecsHat, M, evecsSize-numRecentlyLocked, primme->numOrthoConst+primme->numEvals, numRecentlyLocked, rwork, primme); ret = UDUDecompose_dprimme(M, UDU, ipivot, evecsSize, rwork, rworkSize, primme); if (ret != 0) { primme_PushErrorMessage(Primme_lock_vectors, Primme_ududecompose, ret, __FILE__, __LINE__, primme); return UDUDECOMPOSE_FAILURE; } } /* --------------------------------------------------------------------- */ /* Swap, towards the end of the basis, vectors that were locked but not */ /* replaced by new initial guesses. */ /* --------------------------------------------------------------------- */ numDeflated = swap_flagVecs_toEnd(*basisSize, LOCKED, V, W, H, hVals, flag, primme); /* --------------------------------------------------------------------- */ /* Reduce the basis size by numDeflated and swap the new initial guesses */ /* towards the end of the basis. */ /* --------------------------------------------------------------------- */ numReplaced = swap_flagVecs_toEnd(*basisSize-numDeflated, INITIAL_GUESS, V, W, H, hVals, flag, primme); *basisSize = *basisSize - (numDeflated + numReplaced); if (primme->printLevel >= 5 && primme->procID == 0) { fprintf(primme->outputFile, "numDeflated: %d numReplaced: %d \ basisSize: %d\n", numDeflated, numReplaced, *basisSize); }
int init_basis_dprimme(double *V, double *W, double *evecs, double *evecsHat, double *M, double *UDU, int *ipivot, double machEps, double *rwork, int rworkSize, int *basisSize, int *nextGuess, int *numGuesses, double *timeForMV, primme_params *primme) { int ret; /* Return value */ int currentSize; /*-----------------------------------------------------------------------*/ /* Orthogonalize the orthogonalization constraints provided by the user. */ /* If a preconditioner is given and inner iterations are to be */ /* performed, then initialize M. */ /*-----------------------------------------------------------------------*/ if (primme->numOrthoConst > 0) { ret = ortho_dprimme(evecs, primme->nLocal, 0, primme->numOrthoConst - 1, NULL, 0, 0, primme->nLocal, primme->iseed, machEps, rwork, rworkSize, primme); /* Push an error message onto the stack trace if an error occured */ if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_ortho, ret, __FILE__, __LINE__, primme); return ORTHO_FAILURE; } /* Initialize evecsHat, M, and its factorization UDU,ipivot. This */ /* allows the orthogonalization constraints to be included in the */ /* projector (I-QQ'). Only needed if there is preconditioning, and */ /* JDqmr inner iterations with a right, skew projector. Only in */ /* that case, is UDU not NULL */ if (UDU != NULL) { (*primme->applyPreconditioner) (evecs, evecsHat, &primme->numOrthoConst, primme); primme->stats.numPreconds += primme->numOrthoConst; update_projection_dprimme(evecs, evecsHat, M, 0, primme->numOrthoConst+primme->numEvals, primme->numOrthoConst, rwork, primme); ret = UDUDecompose_dprimme(M, UDU, ipivot, primme->numOrthoConst, rwork, rworkSize, primme); if (ret != 0) { primme_PushErrorMessage(Primme_init_basis, Primme_ududecompose, ret, __FILE__, __LINE__, primme); return UDUDECOMPOSE_FAILURE; } } /* if evecsHat and M=evecs'evecsHat, UDU are needed */ } /* if numOrthoCont >0 */ /*-----------------------------------------------------------------------*/ /* No locking */ /*-----------------------------------------------------------------------*/ if (!primme->locking) { /* Handle case when no initial guesses are provided by the user */ if (primme->initSize == 0) { ret = init_block_krylov(V, W, 0, primme->minRestartSize - 1, evecs, primme->numOrthoConst, machEps, rwork, rworkSize, primme); /* Push an error message onto the stack trace if an error occured */ if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_init_block_krylov, ret, __FILE__, __LINE__, primme); return INIT_BLOCK_KRYLOV_FAILURE; } *basisSize = primme->minRestartSize; } else { /* Handle case when some or all initial guesses are provided by */ /* the user */ /* Copy over the initial guesses provided by the user */ Num_dcopy_dprimme(primme->nLocal*primme->initSize, &evecs[primme->numOrthoConst*primme->nLocal], 1, V, 1); /* Orthonormalize the guesses provided by the user */ ret = ortho_dprimme(V, primme->nLocal, 0, primme->initSize-1, evecs, primme->nLocal, primme->numOrthoConst, primme->nLocal, primme->iseed, machEps, rwork, rworkSize, primme); /* Push an error message onto the stack trace if an error occured */ if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_ortho, ret, __FILE__, __LINE__, primme); return ORTHO_FAILURE; } update_W_dprimme(V, W, 0, primme->initSize, primme); /* An insufficient number of initial guesses were provided by */ /* the user. Generate a block Krylov space to fill the */ /* remaining vacancies. */ if (primme->initSize < primme->minRestartSize) { ret = init_block_krylov(V, W, primme->initSize, primme->minRestartSize - 1, evecs, primme->numOrthoConst, machEps, rwork, rworkSize, primme); /* Push an error message onto the stack trace if an error occured */ if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_init_block_krylov, ret, __FILE__, __LINE__, primme); return INIT_KRYLOV_FAILURE; } *basisSize = primme->minRestartSize; } else { *basisSize = primme->initSize; } } *numGuesses = 0; *nextGuess = 0; } else { /*-----------------------------------------------------------------------*/ /* Locking */ /*-----------------------------------------------------------------------*/ *numGuesses = primme->initSize; *nextGuess = primme->numOrthoConst; /* If some initial guesses are available, copy them to the basis */ /* and orthogonalize them against themselves and the orthogonalization */ /* constraints. */ if (primme->initSize > 0) { currentSize = min(primme->initSize, primme->minRestartSize); Num_dcopy_dprimme(primme->nLocal*currentSize, &evecs[primme->numOrthoConst*primme->nLocal], 1, V, 1); ret = ortho_dprimme(V, primme->nLocal, 0, currentSize-1, evecs, primme->nLocal, primme->numOrthoConst, primme->nLocal, primme->iseed, machEps, rwork, rworkSize, primme); if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_ortho, ret, __FILE__, __LINE__, primme); return ORTHO_FAILURE; } update_W_dprimme(V, W, 0, currentSize, primme); *numGuesses = *numGuesses - currentSize; *nextGuess = *nextGuess + currentSize; } else { currentSize = 0; } /* If an insufficient number of guesses was provided, then fill */ /* the remaining vacancies with a block Krylov space. */ if (currentSize < primme->minRestartSize) { ret = init_block_krylov(V, W, currentSize, primme->minRestartSize - 1, evecs, primme->numOrthoConst, machEps, rwork, rworkSize, primme); if (ret < 0) { primme_PushErrorMessage(Primme_init_basis, Primme_init_block_krylov, ret, __FILE__, __LINE__, primme); return INIT_BLOCK_KRYLOV_FAILURE; } } *basisSize = primme->minRestartSize; } /* ----------------------------------------------------------- */ /* If time measurements are needed, waste one MV + one Precond */ /* Put dummy results in the first open space of W (currentSize)*/ /* ----------------------------------------------------------- */ if (primme->dynamicMethodSwitch) { currentSize = primme->nLocal*(*basisSize); ret = 1; *timeForMV = primme_wTimer(0); (*primme->matrixMatvec)(V, &W[currentSize], &ret, primme); *timeForMV = primme_wTimer(0) - *timeForMV; primme->stats.numMatvecs += 1; } return 0; }