EXODUS/packages/seacas/libraries/chaco/eigen/bisect.c

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