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.
128 lines
4.1 KiB
128 lines
4.1 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 "defs.h" // for FALSE, TRUE
|
|
#include <math.h>
|
|
#include <stdio.h> // for printf
|
|
|
|
/* Determine whether to pause in Lanczos */
|
|
int lanpause(int j, /* current step */
|
|
int lastpause, /* when last paused */
|
|
int interval, /* interval between pauses */
|
|
double **q, /* the Lanczos vectors */
|
|
int n, /* length of Lanczos vectors */
|
|
int *pausemode, /* which pausing criterion to use */
|
|
int version, /* which version of sel. orth. we are using */
|
|
double beta /* current off-diagonal value */
|
|
)
|
|
{
|
|
extern int DEBUG_EVECS; /* debugging level for eigen computation */
|
|
extern double DOUBLE_EPSILON; /* machine precision */
|
|
double paige_dot; /* q[j]^T q[1] */
|
|
double paigetol; /* pause if paigedot > paigetol */
|
|
|
|
/* Check orthogonality of last Lanczos vector against previous ones */
|
|
if (DEBUG_EVECS > 3) {
|
|
checkorth(q, n, j);
|
|
}
|
|
|
|
/* periodic reorthogonalization */
|
|
if (version == 1 || version == 2) {
|
|
if ((j - lastpause) == interval || beta < 1000 * DOUBLE_EPSILON) {
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
|
|
/* Run until orthogonality with first Lanczos vector deteriorates, then switch
|
|
switch to periodic reorthog. */
|
|
if (version == 3) {
|
|
paigetol = 1.0e-3;
|
|
if (*pausemode == 1) {
|
|
paige_dot = fabs(dot(q[1], 1, n, q[j]));
|
|
if ((paige_dot > paigetol && j > 1) || beta < 1000 * DOUBLE_EPSILON) {
|
|
if (DEBUG_EVECS > 1) {
|
|
printf(" Pausing on step %3d with Paige prod. = %g\n", j, paige_dot);
|
|
}
|
|
*pausemode = 2;
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
if (*pausemode == 2) {
|
|
if ((j - lastpause) == interval || beta < 1000 * DOUBLE_EPSILON) {
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
}
|
|
|
|
/* shouldn't ever get this far, but alint really wants a return value */
|
|
return (FALSE);
|
|
}
|
|
|
|
int lanpause_float(int j, /* current step */
|
|
int lastpause, /* when last paused */
|
|
int interval, /* interval between pauses */
|
|
float **q, /* the Lanczos vectors */
|
|
int n, /* length of Lanczos vectors */
|
|
int *pausemode, /* which pausing criterion to use */
|
|
int version, /* which version of sel. orth. we are using */
|
|
double beta /* current off-diagonal value */
|
|
)
|
|
{
|
|
extern int DEBUG_EVECS; /* debugging level for eigen computation */
|
|
extern double DOUBLE_EPSILON; /* machine precision */
|
|
double paige_dot; /* q[j]^T q[1] */
|
|
double paigetol; /* pause if paigedot > paigetol */
|
|
|
|
/* Check orthogonality of last Lanczos vector against previous ones */
|
|
if (DEBUG_EVECS > 3) {
|
|
checkorth_float(q, n, j);
|
|
}
|
|
|
|
/* periodic reorthogonalization */
|
|
if (version == 1 || version == 2) {
|
|
if ((j - lastpause) == interval || beta < 1000 * DOUBLE_EPSILON) {
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
|
|
/* Run until orthogonality with first Lanczos vector deteriorates, then switch
|
|
switch to periodic reorthog. */
|
|
if (version == 3) {
|
|
paigetol = 1.0e-3;
|
|
if (*pausemode == 1) {
|
|
paige_dot = fabs(dot_float(q[1], 1, n, q[j]));
|
|
if ((paige_dot > paigetol && j > 1) || beta < 1000 * DOUBLE_EPSILON) {
|
|
if (DEBUG_EVECS > 1) {
|
|
printf(" Pausing on step %3d with Paige prod. = %g\n", j, paige_dot);
|
|
}
|
|
*pausemode = 2;
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
if (*pausemode == 2) {
|
|
if ((j - lastpause) == interval || beta < 1000 * DOUBLE_EPSILON) {
|
|
return (TRUE);
|
|
}
|
|
|
|
return (FALSE);
|
|
}
|
|
}
|
|
|
|
/* shouldn't ever get this far, but alint really wants a return value */
|
|
return (FALSE);
|
|
}
|
|
|