static void convTestFunAbsolute(double *eval, void *evec, double *rNorm, int *isConv,
primme_params *primme) {
const double machEps = Num_dlamch_primme("E");
*isConv = *rNorm < max(
primme->eps * (
primme->aNorm > 0.0 ? primme->aNorm : primme->stats.estimateLargestSVal),
machEps * 3.16 * primme->stats.estimateLargestSVal);
}
/******************************************************************************
*
* static int check_input(double *evals, Complex_Z *evecs, double *resNorms,
* primme_params *primme)
*
* INPUT
* -----
* evals, evecs, resNorms Output arrays for primme
* primme the main structure of parameters
*
* return value - 0 If input parameters in primme are appropriate
* -4..-32 Inappropriate input parameters were found
*
******************************************************************************/
static int check_input(double *evals, Complex_Z *evecs, double *resNorms,
primme_params *primme) {
int ret;
ret = 0;
if (primme == NULL)
ret = -4;
else if (primme->n <= 0 || primme->nLocal <= 0)
ret = -5;
else if (primme->numProcs < 1)
ret = -6;
else if (primme->matrixMatvec == NULL)
ret = -7;
else if (primme->applyPreconditioner == NULL &&
primme->correctionParams.precondition )
ret = -8;
else if (primme->globalSumDouble == NULL)
ret = -9;
else if (primme->numEvals > primme->n)
ret = -10;
else if (primme->numEvals < 0)
ret = -11;
else if (primme->eps > 0.0L && primme->eps < Num_dlamch_primme("E") )
ret = -12;
else if ( primme->target != primme_smallest &&
primme->target != primme_largest &&
primme->target != primme_closest_geq &&
primme->target != primme_closest_leq &&
primme->target != primme_closest_abs )
ret = -13;
else if ( primme->target == primme_closest_geq ||
primme->target == primme_closest_leq ||
primme->target == primme_closest_abs ) {
if (primme->numTargetShifts <= 0) {
ret = -14;
}
else if (primme->targetShifts == NULL ) {
ret = -15;
}
}
else if (primme->numOrthoConst < 0 || primme->numOrthoConst >=primme->n)
ret = -16;
else if (primme->maxBasisSize < 2 && primme->maxBasisSize != primme->n)
ret = -17;
else if (primme->minRestartSize <= 0 && primme->n > 2)
ret = -18;
else if (primme->maxBlockSize <= 0)
ret = -19;
else if (primme->restartingParams.maxPrevRetain < 0)
ret = -20;
else if (primme->restartingParams.scheme != primme_thick &&
primme->restartingParams.scheme != primme_dtr)
ret = -21;
else if (primme->initSize < 0)
ret = -22;
else if (!primme->locking && primme->initSize > primme->maxBasisSize)
ret = -23;
else if (primme->locking && primme->initSize > primme->numEvals)
ret = -24;
else if (primme->minRestartSize + primme->restartingParams.maxPrevRetain
>= primme->maxBasisSize && primme->n > 2)
ret = -25;
else if (primme->minRestartSize >= primme->n)
ret = -26;
else if (primme->printLevel < 0 || primme->printLevel > 5)
ret = -27;
else if (primme->correctionParams.convTest != primme_full_LTolerance &&
primme->correctionParams.convTest != primme_decreasing_LTolerance &&
primme->correctionParams.convTest != primme_adaptive_ETolerance &&
primme->correctionParams.convTest != primme_adaptive )
ret = -28;
else if (primme->correctionParams.convTest == primme_decreasing_LTolerance &&
primme->correctionParams.relTolBase <= 1.0L )
ret = -29;
else if (evals == NULL)
ret = -30;
else if (evecs == NULL)
ret = -31;
else if (resNorms == NULL)
ret = -32;
else if (!primme->locking && primme->minRestartSize < primme->numEvals &&
primme->n > 2)
ret = -33;
return ret;
/***************************************************************************/
} /* end of check_input
int dprimme(double *evals, double *evecs, double *resNorms,
primme_params *primme) {
int ret;
int *perm;
double machEps;
/* ------------------ */
/* zero out the timer */
/* ------------------ */
primme_wTimer(1);
/* ---------------------------- */
/* Clear previous error reports */
/* ---------------------------- */
primme_DeleteStackTrace(primme);
/* ----------------------- */
/* Find machine precision */
/* ----------------------- */
machEps = Num_dlamch_primme("E");
/* ----------------------------------------- */
/* Set some defaults for sequential programs */
/* ----------------------------------------- */
if (primme->numProcs == 1) {
primme->nLocal = primme->n;
primme->procID = 0;
if (primme->globalSumDouble == NULL)
primme->globalSumDouble = primme_seq_globalSumDouble;
}
/* --------------------------------------------------------------------- */
/* Decide on whether to use locking (hard locking), or not (soft locking)*/
/* --------------------------------------------------------------------- */
if (primme->target != primme_smallest &&
primme->target != primme_largest ) {
/* Locking is necessary as interior Ritz values can cross shifts */
primme->locking = 1;
}
else {
if (primme->locking == 0) {
/* use locking when not enough vectors to restart with */
primme->locking = (primme->numEvals > primme->minRestartSize);
}
}
/* -------------------------------------------------------------- */
/* If needed, we are ready to estimate required memory and return */
/* -------------------------------------------------------------- */
if (evals == NULL && evecs == NULL && resNorms == NULL)
return allocate_workspace(primme, FALSE);
/* ----------------------------------------------------- */
/* Reset random number seed if inappropriate for DLARENV */
/* Yields unique quadruples per proc if procID < 4096^3 */
/* ----------------------------------------------------- */
if (primme->iseed[0]<0 || primme->iseed[0]>4095) primme->iseed[0] =
primme->procID % 4096;
if (primme->iseed[1]<0 || primme->iseed[1]>4095) primme->iseed[1] =
(int)(primme->procID/4096+1) % 4096;
if (primme->iseed[2]<0 || primme->iseed[2]>4095) primme->iseed[2] =
(int)((primme->procID/4096)/4096+2) % 4096;
if (primme->iseed[3]<0 || primme->iseed[3]>4095) primme->iseed[3] =
(2*(int)(((primme->procID/4096)/4096)/4096)+1) % 4096;
/* ------------------------------------------------------- */
/* Check primme input data for bounds, correct values etc. */
/* ------------------------------------------------------- */
ret = check_input(evals, evecs, resNorms, primme);
if (ret != 0) {
primme_PushErrorMessage(Primme_dprimme, Primme_check_input, ret,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return ret;
}
/* ----------------------------------------------------------------------- */
/* Compute AND allocate memory requirements for main_iter and subordinates */
/* ----------------------------------------------------------------------- */
ret = allocate_workspace(primme, TRUE);
if (ret != 0) {
primme_PushErrorMessage(Primme_dprimme, Primme_allocate_workspace, ret,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return ALLOCATE_WORKSPACE_FAILURE;
}
/* --------------------------------------------------------- */
/* Allocate workspace that will be needed locally by dprimme */
/* --------------------------------------------------------- */
perm = (int *)primme_calloc((primme->numEvals), sizeof(int), "Perm array");
if (perm == NULL) {
primme_PushErrorMessage(Primme_dprimme, Primme_malloc, 0,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return MALLOC_FAILURE;
}
/*----------------------------------------------------------------------*/
/* Call the solver */
/*----------------------------------------------------------------------*/
ret = main_iter_dprimme(evals, perm, evecs, resNorms, machEps,
primme->intWork, primme->realWork, primme);
if (ret < 0) {
primme_PushErrorMessage(Primme_dprimme, Primme_main_iter,
ret, __FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return MAIN_ITER_FAILURE;
}
/*----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*/
/* If locking is engaged, the converged Ritz vectors are stored in the */
/* order they converged. They must then be permuted so that they */
/* correspond to the sorted Ritz values in evals. */
/*----------------------------------------------------------------------*/
permute_evecs_dprimme(&evecs[primme->numOrthoConst], perm,
(double *) primme->realWork, primme->numEvals, primme->nLocal);
free(perm);
primme->stats.elapsedTime = primme_wTimer(0);
return(0);
}
int zprimme(double *evals, Complex_Z *evecs, double *resNorms,
primme_params *primme) {
int ret;
int *perm;
double machEps;
/* ------------------ */
/* zero out the timer */
/* ------------------ */
primme_wTimer(1);
/* ---------------------------- */
/* Clear previous error reports */
/* ---------------------------- */
primme_DeleteStackTrace(primme);
/* ----------------------- */
/* Find machine precision */
/* ----------------------- */
machEps = Num_dlamch_primme("E");
/* ------------------ */
/* Set some defaults */
/* ------------------ */
primme_set_defaults(primme);
/* -------------------------------------------------------------- */
/* If needed, we are ready to estimate required memory and return */
/* -------------------------------------------------------------- */
if (evals == NULL && evecs == NULL && resNorms == NULL)
return allocate_workspace(primme, FALSE);
/* ----------------------------------------------------- */
/* Reset random number seed if inappropriate for DLARENV */
/* Yields unique quadruples per proc if procID < 4096^3 */
/* ----------------------------------------------------- */
if (primme->iseed[0]<0 || primme->iseed[0]>4095) primme->iseed[0] =
primme->procID % 4096;
if (primme->iseed[1]<0 || primme->iseed[1]>4095) primme->iseed[1] =
(int)(primme->procID/4096+1) % 4096;
if (primme->iseed[2]<0 || primme->iseed[2]>4095) primme->iseed[2] =
(int)((primme->procID/4096)/4096+2) % 4096;
if (primme->iseed[3]<0 || primme->iseed[3]>4095) primme->iseed[3] =
(2*(int)(((primme->procID/4096)/4096)/4096)+1) % 4096;
/* ----------------------- */
/* Set default convTetFun */
/* ----------------------- */
if (!primme->convTestFun) {
primme->convTestFun = convTestFunAbsolute;
}
/* ------------------------------------------------------- */
/* Check primme input data for bounds, correct values etc. */
/* ------------------------------------------------------- */
ret = check_input(evals, evecs, resNorms, primme);
if (ret != 0) {
primme_PushErrorMessage(Primme_zprimme, Primme_check_input, ret,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return ret;
}
/* ----------------------------------------------------------------------- */
/* Compute AND allocate memory requirements for main_iter and subordinates */
/* ----------------------------------------------------------------------- */
ret = allocate_workspace(primme, TRUE);
if (ret != 0) {
primme_PushErrorMessage(Primme_zprimme, Primme_allocate_workspace, ret,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return ALLOCATE_WORKSPACE_FAILURE;
}
/* --------------------------------------------------------- */
/* Allocate workspace that will be needed locally by zprimme */
/* --------------------------------------------------------- */
perm = (int *)primme_calloc((primme->numEvals), sizeof(int), "Perm array");
if (perm == NULL) {
primme_PushErrorMessage(Primme_zprimme, Primme_malloc, 0,
__FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return MALLOC_FAILURE;
}
/*----------------------------------------------------------------------*/
/* Call the solver */
/*----------------------------------------------------------------------*/
ret = main_iter_zprimme(evals, perm, evecs, resNorms, machEps,
primme->intWork, primme->realWork, primme);
if (ret < 0) {
primme_PushErrorMessage(Primme_zprimme, Primme_main_iter,
ret, __FILE__, __LINE__, primme);
primme->stats.elapsedTime = primme_wTimer(0);
return MAIN_ITER_FAILURE;
}
/*----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*/
/* If locking is engaged, the converged Ritz vectors are stored in the */
/* order they converged. They must then be permuted so that they */
/* correspond to the sorted Ritz values in evals. */
/*----------------------------------------------------------------------*/
permute_vecs_zprimme(&evecs[primme->numOrthoConst], primme->nLocal,
primme->initSize, primme->nLocal, perm, (Complex_Z*)primme->realWork,
(int*)primme->intWork);
free(perm);
primme->stats.elapsedTime = primme_wTimer(0);
return(0);
}
double machEps;
/* ------------------ */
/* zero out the timer */
/* ------------------ */
primme_wTimer(1);
/* ---------------------------- */
/* Clear previous error reports */
/* ---------------------------- */
primme_DeleteStackTrace(primme);
/* ----------------------- */
/* Find machine precision */
/* ----------------------- */
machEps = Num_dlamch_primme("E");
/* ------------------ */
/* Set some defaults */
/* ------------------ */
primme_set_defaults(primme);
/* -------------------------------------------------------------- */
/* If needed, we are ready to estimate required memory and return */
/* -------------------------------------------------------------- */
if (evals == NULL && evecs == NULL && resNorms == NULL)
return allocate_workspace(primme, FALSE);
/* ----------------------------------------------------- */
/* Reset random number seed if inappropriate for DLARENV */
/* Yields unique quadruples per proc if procID < 4096^3 */