/* * Copyright(C) 1999-2020, 2023 National Technology & Engineering Solutions * of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with * NTESS, the U.S. Government retains certain rights in this software. * * See packages/seacas/LICENSE for details */ #include "params.h" // for MAXDIMS #include "prototypes.h" #include // for fabs, sqrt int SRES_SWITCHES = 0; /* # switches to backup routine for computing evec of T */ /* NOTE: Uses a modified form of the bidirectional recurrence similar to Parlett and Reid's version. Made a minor correction and modified one heuristic that didn't seem to work well for our class of graphs. Code switches to Tinvit, Eispack's inverse iteration routine if the bidirectional recurrence fails to meet tolerance. Switches back to the bidirectional recurrence result if Tinvit fails to converge or gives a worse residual. There's code for the simple forward and backward recurrences in the comments at the end. */ /* NOTE: In this routine the diagonal of T is alpha[1] ... alpha[j], and the off-diagonal is beta[2] ... beta[j]. Because the various literature sources do not agree on indexing, some of the Lanczos algorithms have to call this routine with the beta vector off-set by one. */ /* NOTE: The residual calculations look too simple, but they are right because the recurrences force (in exact arithmetic) most of the terms in the residual (T - ritz*I)s to zero. It's only the end points in the forward or backward recurrences or the merge point in the bidirectional recurrence where the resdual is not forced to zero. The values here are the residuals if we ignore round-off in the other terms (which appears to be valid). */ /* NOTE: This routine is expected to return a normalized vector s such that it's last entry, s[j], is positive, hence the calls to sign_normalize(). This is not an issue in the backward recurrence since we set s[j] positive. */ /* Finds eigenvector s of T and returns residual norm. */ double Tevec(double *alpha, /* vector of Lanczos scalars */ double *beta, /* vector of Lanczos scalars */ int j, /* number of Lanczos iterations taken */ double ritz, /* approximate eigenvalue of T */ double *s /* approximate eigenvector of T */ ) { extern double SRESTOL; /* limit on relative residual tol for evec of T */ extern double DOUBLE_MAX; /* maximum double precision value */ int i; /* index */ double residual = 0.0; /* how well recurrence gives eigenvector */ double temp; /* used to compute residual */ double *work; /* temporary work vector allocated within if used */ double w[MAXDIMS + 1]; /* holds eigenvalue for tinvit */ long index[MAXDIMS + 1]; /* index vector for tinvit */ long ierr; /* error flag for tinvit */ long nevals; /* number of evals sought */ long long_j; /* long copy of j for tinvit interface */ double hurdle; /* hurdle for local maximum in recurrence */ double prev_resid; /* stores residual from previous computation */ s[1] = 1.0; if (j == 1) { residual = fabs(alpha[1] - ritz); } if (j >= 2) { /*Bidirectional recurrence - corrected and modified from Parlett and Reid, "Tracking the Progress of the Lanczos Algorithm ..., IMA JNA 1, 1981 */ hurdle = 1.0; residual = bidir(alpha, beta, j, ritz, s, hurdle); } if (residual > SRESTOL) { /* Try again with Eispack's Tinvit iteration */ SRES_SWITCHES++; index[1] = 1; work = mkvec(1, 7 * j); /* lump things to save mallocs */ w[1] = ritz; work[1] = 0; for (i = 2; i <= j; i++) { work[i] = beta[i] * beta[i]; } nevals = 1; long_j = j; /* save the previously computed evec in case it's better */ cpvec(&(work[6 * j]), 1, j, s); prev_resid = residual; tinvit(&long_j, &long_j, &(alpha[1]), &(beta[1]), &(work[1]), &nevals, &(w[1]), &(index[1]), &(s[1]), &ierr, &(work[j + 1]), &(work[(2 * j) + 1]), &(work[(3 * j) + 1]), &(work[(4 * j) + 1]), &(work[(5 * j) + 1])); /* fix up sign if needed */ if (s[j] < 0) { for (i = 1; i <= j; i++) { s[i] = -s[i]; } } if (ierr != 0) { residual = DOUBLE_MAX; /* ... don't want to use evec since it is set to zero */ } else { temp = (alpha[1] - ritz) * s[1] + beta[2] * s[2]; residual = temp * temp; for (i = 2; i < j; i++) { temp = beta[i] * s[i - 1] + (alpha[i] - ritz) * s[i] + beta[i + 1] * s[i + 1]; residual += temp * temp; } temp = beta[j] * s[j - 1] + (alpha[j] - ritz) * s[j]; residual += temp * temp; residual = sqrt(residual); /* tinvit normalizes, so we don't need to. */ } /* restore previous evec if it had a better residual */ if (prev_resid < residual) { residual = prev_resid; cpvec(s, 1, j, &(work[6 * j])); SRES_SWITCHES++; /* count since switching back as well */ } frvec(work, 1); } return (residual); } /* Keep this code around in case we have problems with the bidirectional recurrence. */ /* Backward recurrence s[j] = 1.0; if (j == 1) { residual = (alpha[1] - ritz); } if (j >= 2) { s[j - 1] = -(alpha[j] - ritz) / beta[j]; for (i = j; i >= 3; i--) { s[i-2] = -((alpha[i - 1] - ritz) * s[i - 1] + beta[i] * s[i]) / beta[i - 1]; } residual = (alpha[1] - ritz) * s[1] + beta[2] * s[2]; } residual = fabs(residual) / ch_normalize(s,1,j); */ /* Forward recurrence s[1] = 1.0; if (j == 1) { residual = (alpha[1] - ritz); } if (j >= 2) { s[2] = -(alpha[1] - ritz) / beta[2]; for (i = 3; i <= j; i++) { s[i] = -((alpha[i - 1] - ritz) * s[i - 1] + beta[i - 1] * s[i - 2]) / beta[i]; } residual = (alpha[j] - ritz) * s[j] + beta[j] * s[j - 1]; } residual = fabs(residual) / sign_normalize(s,1,j,j); */