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;
}
int
main(int argc, char *argv[])
{
size_t nmax_int = 60;
size_t mmax_int = 6;
size_t nmax_ext = 0;
size_t mmax_ext = 0;
size_t nmax_sh = 60;
size_t mmax_sh = 5;
size_t nmax_tor = 60;
size_t mmax_tor = 5;
double alpha_int = 1.0;
double alpha_sh = 1.0;
double alpha_tor = 1.0;
size_t robust_maxit = 5;
const double R = R_EARTH_KM;
const double b = R + 110.0; /* radius of internal current shell (Sq+EEJ) */
const double d = R + 350.0; /* radius of current shell for gravity/diamag */
double universal_time = 11.0; /* UT in hours for data selection */
char *datamap_file = "datamap.dat";
char *data_file = "data.dat";
char *spectrum_file = "poltor.s";
char *corr_file = "corr.dat";
char *residual_file = NULL;
char *output_file = NULL;
char *chisq_file = NULL;
char *lls_file = NULL;
char *Lcurve_file = NULL;
magdata *mdata = NULL;
poltor_workspace *poltor_p;
poltor_parameters params;
struct timeval tv0, tv1;
int print_data = 0;
#if POLTOR_SYNTH_DATA
nmax_int = 30;
mmax_int = 10;
nmax_ext = 2;
mmax_ext = 2;
nmax_sh = 20;
mmax_sh = 10;
nmax_tor = 30;
mmax_tor = 10;
#endif
while (1)
{
int c;
int option_index = 0;
static struct option long_options[] =
{
{ "nmax_int", required_argument, NULL, 'n' },
{ "mmax_int", required_argument, NULL, 'm' },
{ "nmax_tor", required_argument, NULL, 'a' },
{ "mmax_tor", required_argument, NULL, 'b' },
{ "nmax_sh", required_argument, NULL, 'e' },
{ "mmax_sh", required_argument, NULL, 'f' },
{ "nmax_ext", required_argument, NULL, 'g' },
{ "mmax_ext", required_argument, NULL, 'h' },
{ "residual_file", required_argument, NULL, 'r' },
{ "output_file", required_argument, NULL, 'o' },
{ "chisq_file", required_argument, NULL, 'p' },
{ "universal_time", required_argument, NULL, 't' },
{ "lls_file", required_argument, NULL, 'l' },
{ "lcurve_file", required_argument, NULL, 'k' },
{ "alpha_int", required_argument, NULL, 'c' },
{ "alpha_sh", required_argument, NULL, 'd' },
{ "alpha_tor", required_argument, NULL, 'j' },
{ "maxit", required_argument, NULL, 'q' },
{ "print_data", no_argument, NULL, 'u' },
{ 0, 0, 0, 0 }
};
c = getopt_long(argc, argv, "a:b:c:d:e:f:g:h:j:k:l:m:n:o:p:q:r:t:u", long_options, &option_index);
if (c == -1)
break;
switch (c)
{
case 'n':
nmax_int = (size_t) atoi(optarg);
break;
case 'm':
mmax_int = (size_t) atoi(optarg);
break;
case 'a':
nmax_tor = (size_t) atoi(optarg);
break;
case 'b':
mmax_tor = (size_t) atoi(optarg);
break;
case 'e':
nmax_sh = (size_t) atoi(optarg);
break;
case 'f':
mmax_sh = (size_t) atoi(optarg);
break;
case 'g':
nmax_ext = (size_t) atoi(optarg);
break;
case 'h':
mmax_ext = (size_t) atoi(optarg);
break;
case 'c':
alpha_int = atof(optarg);
break;
case 'd':
alpha_sh = atof(optarg);
break;
case 'j':
alpha_tor = atof(optarg);
break;
case 'r':
residual_file = optarg;
break;
case 'k':
Lcurve_file = optarg;
break;
case 'o':
output_file = optarg;
break;
case 't':
universal_time = atof(optarg);
break;
case 'p':
chisq_file = optarg;
break;
case 'l':
lls_file = optarg;
break;
case 'q':
robust_maxit = (size_t) atoi(optarg);
break;
case 'u':
print_data = 1;
break;
default:
break;
}
}
while (optind < argc)
{
fprintf(stderr, "main: reading %s...", argv[optind]);
gettimeofday(&tv0, NULL);
mdata = magdata_read(argv[optind], mdata);
gettimeofday(&tv1, NULL);
if (!mdata)
exit(1);
fprintf(stderr, "done (%zu data total, %g seconds)\n",
mdata->n, time_diff(tv0, tv1));
++optind;
}
if (!mdata)
{
print_help(argv);
exit(1);
}
mmax_int = GSL_MIN(mmax_int, nmax_int);
mmax_ext = GSL_MIN(mmax_ext, nmax_ext);
mmax_sh = GSL_MIN(mmax_sh, nmax_sh);
mmax_tor = GSL_MIN(mmax_tor, nmax_tor);
fprintf(stderr, "main: universal time = %.1f\n", universal_time);
fprintf(stderr, "main: nmax_int = %zu\n", nmax_int);
fprintf(stderr, "main: mmax_int = %zu\n", mmax_int);
fprintf(stderr, "main: nmax_ext = %zu\n", nmax_ext);
fprintf(stderr, "main: mmax_ext = %zu\n", mmax_ext);
fprintf(stderr, "main: nmax_sh = %zu\n", nmax_sh);
fprintf(stderr, "main: mmax_sh = %zu\n", mmax_sh);
fprintf(stderr, "main: nmax_tor = %zu\n", nmax_tor);
fprintf(stderr, "main: mmax_tor = %zu\n", mmax_tor);
fprintf(stderr, "main: alpha_int = %g\n", alpha_int);
fprintf(stderr, "main: alpha_sh = %g\n", alpha_sh);
fprintf(stderr, "main: alpha_tor = %g\n", alpha_tor);
if (residual_file)
fprintf(stderr, "main: residual file = %s\n", residual_file);
if (Lcurve_file)
fprintf(stderr, "main: L-curve file = %s\n", Lcurve_file);
/*
* re-compute flags for fitting components / gradient, etc;
* must be called before magdata_init()
*/
set_flags(mdata);
fprintf(stderr, "main: initializing spatial weighting histogram...");
gettimeofday(&tv0, NULL);
magdata_init(mdata);
gettimeofday(&tv1, NULL);
fprintf(stderr, "done (%g seconds)\n", time_diff(tv0, tv1));
/* re-compute weights, nvec, nres based on flags update */
fprintf(stderr, "main: computing spatial weighting of data...");
gettimeofday(&tv0, NULL);
magdata_calc(mdata);
gettimeofday(&tv1, NULL);
fprintf(stderr, "done (%g seconds)\n", time_diff(tv0, tv1));
#if POLTOR_SYNTH_DATA
fprintf(stderr, "main: setting unit spatial weights...");
magdata_unit_weights(mdata);
fprintf(stderr, "done\n");
#endif
fprintf(stderr, "main: print_data = %d\n", print_data);
if (print_data)
{
fprintf(stderr, "main: writing data to %s...", data_file);
magdata_print(data_file, mdata);
fprintf(stderr, "done\n");
fprintf(stderr, "main: writing data map to %s...", datamap_file);
magdata_map(datamap_file, mdata);
fprintf(stderr, "done\n");
}
fprintf(stderr, "main: satellite rmin = %.1f (%.1f) [km]\n",
mdata->rmin, mdata->rmin - mdata->R);
fprintf(stderr, "main: satellite rmax = %.1f (%.1f) [km]\n",
mdata->rmax, mdata->rmax - mdata->R);
params.R = R;
params.b = b;
params.d = d;
params.rmin = GSL_MAX(mdata->rmin, mdata->R + 250.0);
params.rmax = GSL_MIN(mdata->rmax, mdata->R + 450.0);
params.nmax_int = nmax_int;
params.mmax_int = mmax_int;
params.nmax_ext = nmax_ext;
params.mmax_ext = mmax_ext;
params.nmax_sh = nmax_sh;
params.mmax_sh = mmax_sh;
params.nmax_tor = nmax_tor;
params.mmax_tor = mmax_tor;
params.shell_J = 0;
params.data = mdata;
params.alpha_int = alpha_int;
params.alpha_sh = alpha_sh;
params.alpha_tor = alpha_tor;
#if POLTOR_QD_HARMONICS
params.flags = POLTOR_FLG_QD_HARMONICS;
#else
params.flags = 0;
#endif
poltor_p = poltor_alloc(¶ms);
fprintf(stderr, "main: poltor rmin = %.1f (%.1f) [km]\n",
params.rmin, params.rmin - mdata->R);
fprintf(stderr, "main: poltor rmax = %.1f (%.1f) [km]\n",
params.rmax, params.rmax - mdata->R);
#if POLTOR_SYNTH_DATA
fprintf(stderr, "main: replacing with synthetic data...");
gettimeofday(&tv0, NULL);
poltor_synth(poltor_p);
gettimeofday(&tv1, NULL);
fprintf(stderr, "done (%g seconds)\n", time_diff(tv0, tv1));
#endif
if (lls_file)
{
/* use previously computed LS system from file */
fprintf(stderr, "main: loading LS system from %s...", lls_file);
lls_complex_load(lls_file, poltor_p->lls_workspace_p);
fprintf(stderr, "done\n");
/* solve LS system */
poltor_solve(poltor_p);
}
else
{
size_t maxiter = robust_maxit;
size_t iter = 0;
char buf[2048];
#if POLTOR_SYNTH_DATA
maxiter = 1;
#endif
while (iter++ < maxiter)
{
fprintf(stderr, "main: ROBUST ITERATION %zu/%zu\n", iter, maxiter);
/* build LS system */
poltor_calc(poltor_p);
/* solve LS system */
poltor_solve(poltor_p);
sprintf(buf, "%s.iter%zu", spectrum_file, iter);
fprintf(stderr, "main: printing spectrum to %s...", buf);
poltor_print_spectrum(buf, poltor_p);
fprintf(stderr, "done\n");
}
}
print_coefficients(poltor_p);
fprintf(stderr, "main: printing correlation data to %s...", corr_file);
print_correlation(corr_file, poltor_p);
fprintf(stderr, "done\n");
fprintf(stderr, "main: printing spectrum to %s...", spectrum_file);
poltor_print_spectrum(spectrum_file, poltor_p);
fprintf(stderr, "done\n");
if (Lcurve_file)
{
fprintf(stderr, "main: writing L-curve data to %s...", Lcurve_file);
print_Lcurve(Lcurve_file, poltor_p);
fprintf(stderr, "done\n");
}
if (output_file)
{
fprintf(stderr, "main: writing output coefficients to %s...", output_file);
poltor_write(output_file, poltor_p);
fprintf(stderr, "done\n");
}
if (residual_file)
{
fprintf(stderr, "main: printing residuals to %s...", residual_file);
print_residuals(residual_file, poltor_p);
fprintf(stderr, "done\n");
}
if (chisq_file)
{
fprintf(stderr, "main: printing chisq/dof to %s...", chisq_file);
print_chisq(chisq_file, poltor_p);
fprintf(stderr, "done\n");
}
magdata_free(mdata);
poltor_free(poltor_p);
return 0;
} /* main() */
