You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
182 lines
6.6 KiB
182 lines
6.6 KiB
/*
|
|
* 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 "prototypes.h"
|
|
#include <stdio.h> // for printf, NULL
|
|
|
|
/* Finds selected eigenvalues of T using Sturm sequence bisection. Based
|
|
on Wilkinson's algorithm, AEP, p.302. Returns 1 if sturmcnt() fails and
|
|
2 if it hasn't converged in max_steps of bisection. If neither of these
|
|
errors is detected the return value is 0. */
|
|
int bisect(double *alpha, /* vector of Lanczos scalars */
|
|
double *beta, /* vector of Lanczos scalars */
|
|
int j, /* number of Lanczos iterations taken */
|
|
double Anorm, /* Gershgorin estimate */
|
|
double *workj, /* work vector for Sturm sequence */
|
|
double *ritz, /* array holding evals */
|
|
int nevals_left, /* number of evals on right to find */
|
|
int nevals_right, /* number of evals on left to find */
|
|
double tol, /* tolerance on bracket width */
|
|
double *ritz_sav, /* space to copy ritzvals for debugging */
|
|
int max_steps /* maximum number of bisection steps allowed */
|
|
)
|
|
{
|
|
extern int DEBUG_EVECS; /* debug flag for eigen computation */
|
|
extern double DOUBLE_MAX; /* largest double value */
|
|
int index; /* index of sturm polynomial */
|
|
int i; /* loop index */
|
|
double *pntr; /* pntr to double array */
|
|
double x1, x2; /* the bracketing interval */
|
|
int x1cnt, x2cnt; /* Sturm counts at x1 and x2 */
|
|
double x; /* the inserted point */
|
|
int xcnt; /* the Sturm count at x */
|
|
int steps; /* number of bisection steps for a Ritzval */
|
|
int tot_steps; /* number of bisection steps for all Ritzvals */
|
|
int numbracketed; /* number of evals between x1 and x2 */
|
|
int x1ck; /* debugging check on x1cnt */
|
|
int x2ck; /* debugging check on x2cnt */
|
|
int numck; /* debugging check on numbracketed */
|
|
double diff; /* debugging register */
|
|
int ii; /* debugging loop counter */
|
|
|
|
/* If space has been allocated for a copy of the ritz values, assume
|
|
we are to check the Sturm sequence counts directly using ql(). */
|
|
if (ritz_sav != NULL) {
|
|
printf("\nAnorm %g j %d nevals_left %d\n", Anorm, j, nevals_left);
|
|
printf("step x1 x2 x1cnt ck x2cnt ck brack ck "
|
|
"x2-x1\n");
|
|
ii = 0;
|
|
}
|
|
|
|
/* Initialize portion of ritz we will use (use max double so scanmin will work
|
|
properly when called later on) */
|
|
pntr = &ritz[1];
|
|
for (i = j; i; i--) {
|
|
*pntr++ = DOUBLE_MAX;
|
|
}
|
|
|
|
tot_steps = 0;
|
|
|
|
/* find evals on left in decreasing index order */
|
|
x2 = Anorm;
|
|
x2cnt = j;
|
|
numbracketed = j;
|
|
for (index = nevals_left; index >= 1; index--) {
|
|
x1 = 0;
|
|
x1cnt = 0;
|
|
steps = 1; /* ... since started with Anorm bracketing j roots */
|
|
while ((x2 - x1) > tol || numbracketed > 1) {
|
|
x = 0.5 * (x1 + x2);
|
|
xcnt = sturmcnt(alpha, beta, j, x, workj);
|
|
if (xcnt == -1) {
|
|
return (1);
|
|
/* ... sturmcnt() failed; bail out with error code */
|
|
}
|
|
if (xcnt >= index) {
|
|
x2 = x;
|
|
x2cnt = xcnt;
|
|
}
|
|
else {
|
|
x1 = x;
|
|
x1cnt = xcnt;
|
|
}
|
|
numbracketed = x2cnt - x1cnt;
|
|
steps++;
|
|
if (steps == max_steps) {
|
|
return (2);
|
|
/* ... not converging; bail out with error code */
|
|
}
|
|
|
|
if (ritz_sav != NULL) {
|
|
diff = x2 - x1;
|
|
cksturmcnt(ritz_sav, 1, j, x1, x2, &x1ck, &x2ck, &numck);
|
|
printf("%4d %20.16f %20.16f %3d %3d %3d %3d %3d %3d %g", ii++, x1, x2, x1cnt,
|
|
x1ck, x2cnt, x2ck, numbracketed, numck, diff);
|
|
if (x1cnt != x1ck || x2cnt != x2ck || numbracketed != numck) {
|
|
printf("**\n");
|
|
}
|
|
else {
|
|
printf("\n");
|
|
}
|
|
}
|
|
}
|
|
ritz[index] = 0.5 * (x1 + x2);
|
|
if (ritz_sav != NULL) {
|
|
printf("Ritzval #%d:\n", index);
|
|
printf(" bisection %20.16f\n", ritz[index]);
|
|
printf(" ql %20.16f\n", ritz_sav[index]);
|
|
printf(" difference %20.16f\n", ritz[index] - ritz_sav[index]);
|
|
printf("---------------------------------------------------\n");
|
|
}
|
|
if (DEBUG_EVECS > 2) {
|
|
printf(" index %d, bisection steps %d, root %20.16f\n", index, steps, ritz[index]);
|
|
}
|
|
tot_steps += steps;
|
|
}
|
|
|
|
/* find evals on right in increasing index order */
|
|
x1 = 0;
|
|
x1cnt = 0;
|
|
for (index = j - nevals_right + 1; index <= j; index++) {
|
|
x2 = Anorm;
|
|
x2cnt = j;
|
|
steps = 1; /* ... since started with Anorm bracketing j roots */
|
|
while ((x2 - x1) > tol || numbracketed > 1) {
|
|
x = 0.5 * (x1 + x2);
|
|
xcnt = sturmcnt(alpha, beta, j, x, workj);
|
|
if (xcnt == -1) {
|
|
return (1);
|
|
/* ... sturmcnt() failed; bail out with error code */
|
|
}
|
|
if (xcnt >= index) {
|
|
x2 = x;
|
|
x2cnt = xcnt;
|
|
}
|
|
else {
|
|
x1 = x;
|
|
x1cnt = xcnt;
|
|
}
|
|
numbracketed = x2cnt - x1cnt;
|
|
steps++;
|
|
if (steps == max_steps) {
|
|
return (2);
|
|
/* ... not converging; bail out with error code */
|
|
}
|
|
|
|
if (ritz_sav != NULL) {
|
|
diff = x2 - x1;
|
|
cksturmcnt(ritz_sav, 1, j, x1, x2, &x1ck, &x2ck, &numck);
|
|
printf("%4d %20.16f %20.16f %3d %3d %3d %3d %3d %3d %g", ii++, x1, x2, x1cnt,
|
|
x1ck, x2cnt, x2ck, numbracketed, numck, diff);
|
|
if (x1cnt != x1ck || x2cnt != x2ck || numbracketed != numck) {
|
|
printf("**\n");
|
|
}
|
|
else {
|
|
printf("\n");
|
|
}
|
|
}
|
|
}
|
|
ritz[index] = 0.5 * (x1 + x2);
|
|
if (ritz_sav != NULL) {
|
|
printf("Ritzval #%d:\n", index);
|
|
printf(" bisection %20.16f\n", ritz[index]);
|
|
printf(" ql %20.16f\n", ritz_sav[index]);
|
|
printf(" difference %20.16f\n", ritz[index] - ritz_sav[index]);
|
|
printf("---------------------------------------------------\n");
|
|
}
|
|
if (DEBUG_EVECS > 2) {
|
|
printf(" index %d, bisection steps %d, root %20.16f\n", index, steps, ritz[index]);
|
|
}
|
|
tot_steps += steps;
|
|
}
|
|
if (DEBUG_EVECS > 2) {
|
|
printf(" Total number of bisection steps %d.\n", tot_steps);
|
|
}
|
|
|
|
return (0); /* ... things seem ok. */
|
|
}
|
|
|