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 */