void display_board(board *b)
{
int x, y;
if (alt_video_page) {
outpage(2);
} else {
outpage(4);
}
textcolour(7);
clearscr();
movecur(30, 7);
os_long_int_to_string(&score, 10, conv_buffer);
strout("Score: ");
strout(conv_buffer);
for (y = 0; y < brd_h; y++) {
movecur(30, y * 2 + 8);
strout(seperator);
movecur(30, y * 2 + 9);
for (x = 0; x < brd_w; x++) {
charout('|');
if ((*b)[y][x] < 10000) charout(' ');
if ((*b)[y][x] < 1000) charout(' ');
if ((*b)[y][x] < 100) charout(' ');
if ((*b)[y][x] < 10) charout(' ');
if ((*b)[y][x] == 0) {
charout(' ');
} else {
strout(os_int_to_string((*b)[y][x]));
}
}
charout('|');
}
movecur(30, 16);
strout(seperator);
if (alt_video_page) {
viewpage(2);
alt_video_page = 0;
} else {
viewpage(4);
alt_video_page = 1;
}
}
void TestWrappedOutput::testBasicWrap_() {
UserOutput user_soutput{new StringOutput};
StringOutput& strout(*dynamic_cast<StringOutput*>(user_soutput.get()));
UserOutput user_output{new WrappedOutput{user_soutput}};
WrappedOutput& wrout(*dynamic_cast<WrappedOutput*>(user_output.get()));
wrout.setMaxColumns(10);
string utterance = "Now is the time for all good men to come to the aid of their country.";
user_output->put(utterance);
user_output->endLine();
string result = strout.getOutput();
out() << result;
istringstream istr(result);
string line;
deque<string> lines;
while (getline(istr, line)) {
ARCHETYPE_TEST(line.size() <= 10);
lines.push_back(line);
}
ARCHETYPE_TEST(lines.size() > 1);
// Paste it back together and make sure it matches the original
ostringstream back_out;
copy(lines.begin(), lines.end(), ostream_iterator<string>(back_out, " "));
string back_out_s = back_out.str();
back_out_s.resize(back_out_s.size() - 1);
ARCHETYPE_TEST_EQUAL(back_out_s, utterance);
out() << "TestWrappedOutput finished." << endl;
}
void DegreeConverter::ToDMSString(double value, std::wstring& strDMS)
{
double fD, fM, fS;
ToDMS(value, &fD, &fM, &fS);
std::wostringstream strout(std::wostringstream::out);
strout << fD << "¡ã" << fM << "'" << fS << "\"";
strDMS = strout.str();
}
CStr B64_decode(CStr strin)
{
if (!strin.IsEmpty()) {
CStr strout((int) strin.Length());
int len = B64_decode(strin, strout.GetBuffer(), strin.Length());
if (len < 0) len = 0;
return strout.Grow(len);
} else
return strin;
}
void DropBoxOperations::authorize(QDropbox* d){
//TODO Gérer ce cas proprement
QTextStream strout(stdout);
QTextStream strin(stdin);
//qDebug() << " Authorisation URL: " << d->authorizeLink().toString() ;
//QDesktopServices::openUrl(d->authorizeLink());
//strout << "Press ENTER after you authorized the application!";
strout.flush();
//strin.readLine();
//strout << endl;
d->requestAccessTokenAndWait();
}
void display(void)
{
char *ptr, *ft="Outline font";
glClear(GL_COLOR_BUFFER_BIT);
glLoadIdentity();
glColor3f( 1.,0.,0. ); // 赤はビットマップフォント
strout( -0.4,0.3,"Bitmap font" );
glColor3f( 0.,0.,1. ); // 青はアウトラインフォント
glTranslatef( -0.4,-0.4,0. );
glScalef(0.001,0.001,1.);
ptr = ft;
while(*ptr)glutStrokeCharacter(GLUT_STROKE_ROMAN,*ptr++);
glFlush(); // 画面に出力
}
int newrecv(int fd,char *buff,int size,int flag) {
int i,k;
k=recv(fd,buff,size,flag);
if(k==0||k<0)
{
i=WSAGetLastError();
if(k==0||i==0x2746||i==0x2745)
{
strout("\r\n\r\nServer close!\r\n");
Sleep(1000);
exit(1);
}
}
if(xordatabegin==1) {
for(i=0; i<k; ++i) {
lockintvar1=lockintvar1*0x100;
lockintvar1=lockintvar1%LOCKBIGNUM;
lockcharvar=lockintvar1%0x100;
buff[i]^=lockcharvar; // DATAXORCODE;
}
}
else {
if(k>0) {
buff[k]=0;
if(strstr(buff,"XORDATA")!=0) {
xordatabegin=1;
i=strstr(buff,"XORDATA");
memcpy(i,"\r\nok!!\r\n",8);
for(i=strstr(buff,"\r\nok!!\r\n")-buff+8; i<k; ++i)
{
lockintvar1=lockintvar1*0x100;
lockintvar1=lockintvar1%LOCKBIGNUM;
lockcharvar=lockintvar1%0x100;
buff[i]^=lockcharvar; // DATAXORCODE;
}
}
}
}
return(k);
}
int main()
{
int key;
init_display();
play_again:
reset_game();
display_board(&grid);
play_game();
movecur(15, 9 + brd_h * 2);
textcolour(12);
strout("Game Over! Press ESCAPE to exit or ENTER to play again.");
do {
key = os_wait_for_key();
} while (key != ESC_KEY && key != ENTER_KEY);
if (key == ENTER_KEY) goto play_again;
end_program();
}
void getvar(int argc, char **argv)
{
unsigned int i;
WSADATA wsaData;
int result;
struct sockaddr_in s_in;
struct hostent *he;
int fd;
u_short port=WEBPORT;
SOCKET d_ip;
exp_name=argv[0];
for(i=strlen(exp_name);i>0;--i)
{
if(*(char *)(exp_name+i)=='\\')
{
exp_name=exp_name+i+1;
break;
}
}
for ( i = 1; i < argc; i++ )
{
/*
* 同时支持-和/两种引入命令行参数的方式
*/
if ( ( argv[i][0] == '-' ) || ( argv[i][0] == '/' ) )
{
/*
* 在这个字节上，大小写不敏感
*/
switch ( tolower( argv[i][1] ) )
{
case 's':
/*
* 服务地址
*/
server = argv[++i];
break;
case 'p':
/*
* 服务端口
*/
s_port = argv[++i];
break;
case 'c':
/*
* 回联地址
*/
callback_address = argv[++i];
break;
case 'o':
/*
* 回联端口
*/
callback_port = argv[++i];
break;
case 'u':
/*
* 网页文件连接
*/
urlfile = argv[++i];
break;
case 'f':
/*
* 文件名
*/
file = argv[++i];
break;
case 'v':
/*
* 系统版本
*/
version = argv[++i];
break;
case 't':
/*
* 溢出点偏移
*/
offsetstr = argv[++i];
if(offsetstr!=NULL) offset=atoi(offsetstr);
break;
case 'r':
/*
* 代理地址
*/
proxy = argv[++i];
break;
case 'd':
/*
* DOS命令
*/
doscmd = argv[++i];
break;
case 'h':
case '?':
default:
usage( argv[0] );
} /* end of switch */
}
else
{
usage( argv[0] );
}
} /* end of for */
if(server==NULL) usage( argv[0] );
result= WSAStartup(MAKEWORD(1, 1), &wsaData);
if (result != 0) {
strout("Your computer was not connected "
"to the Internet at the time that "
"this program was launched, or you "
"do not have a 32-bit "
"connection to the Internet.");
exit(1);
}
if(callback_address!=NULL){
d_ip = inet_addr(callback_address);
if(d_ip==-1)
{
he = gethostbyname(callback_address);
if(!he)
{
WSACleanup( );
outprintf("\r\nCan't get the ip of %s !\r\n",server);
exit(1);
}
else memcpy(&d_ip, he->h_addr, 4);
}
port=CALLBACK_PORT;
if(callback_port!=NULL) port=atoi(callback_port);
if(port==0) port=CALLBACK_PORT;
fd = socket(AF_INET, SOCK_STREAM,0);
i=TIMEOUT;
setsockopt(fd,SOL_SOCKET,SO_RCVTIMEO,(const char *) &i,sizeof(i));
s_in.sin_family = AF_INET;
s_in.sin_port = htons(port);
s_in.sin_addr.s_addr = d_ip;
if(connect(fd, (struct sockaddr *)&s_in, sizeof(struct sockaddr_in))!=0)
{
closesocket(fd);
WSACleanup( );
outprintf("\r\nConnect %s err!\r\n",callback_address);
exit(1);
}
else callback_socket=fd;
}
for(i=0;i<strlen(server);++i)
{
if(server[i]!=' ') break;
}
if(i<strlen(server)) server+=i;
for(i=0;i+3<strlen(server);++i){
if(server[i]==':'){
if(server[i+1]=='\\'||server[i+1]=='/'){
if(server[i+2]=='\\'||server[i+2]=='/'){
server+=i;
server+=3;
break;
}
}
}
}
for(i=1;i<=strlen(server);++i){
if(server[i-1]=='\\'||server[i-1]=='/') server[i-1]=0;
}
if(proxy!=NULL) d_ip=inet_addr(proxy);
else d_ip = inet_addr(server);
if(d_ip==-1)
{
if(proxy!=NULL) he = gethostbyname(proxy);
else he = gethostbyname(server);
if(!he)
{
WSACleanup( );
outprintf("\r\nCan't get the ip of %s !\r\n",server);
exit(1);
}
else memcpy(&d_ip, he->h_addr, 4);
}
if(s_port!=NULL) port=atoi(s_port);
if(port<=0) port=WEBPORT;
fd = socket(AF_INET, SOCK_STREAM,0);
i=TIMEOUT;
setsockopt(fd,SOL_SOCKET,SO_RCVTIMEO,(const char *) &i,sizeof(i));
s_in.sin_family = AF_INET;
s_in.sin_port = htons(port);
s_in.sin_addr.s_addr = d_ip;
if(connect(fd, (struct sockaddr *)&s_in, sizeof(struct sockaddr_in))!=0)
{
closesocket(fd);
WSACleanup( );
outprintf("\r\nConnect %s err!\r\n",server);
exit(1);
}
else server_socket=fd;
printinfo();
}
int
interface (
int nvtxs, /* number of vertices in full graph */
int *start, /* start of edge list for each vertex */
int *adjacency, /* edge list data */
int *vwgts, /* weights for all vertices */
float *ewgts, /* weights for all edges */
float *x,
float *y,
float *z, /* coordinates for inertial method */
char *outassignname, /* name of assignment output file */
char *outfilename, /* output file name */
int *assignment, /* set number of each vtx (length n) */
int architecture, /* 0 => hypercube, d => d-dimensional mesh */
int ndims_tot, /* total number of cube dimensions to divide */
int mesh_dims[3], /* dimensions of mesh of processors */
double *goal, /* desired set sizes for each set */
int global_method, /* global partitioning algorithm */
int local_method, /* local partitioning algorithm */
int rqi_flag, /* should I use RQI/Symmlq eigensolver? */
int vmax, /* how many vertices to coarsen down to? */
int ndims, /* number of eigenvectors (2^d sets) */
double eigtol, /* tolerance on eigenvectors */
long seed /* for random graph mutations */
)
{
extern char *PARAMS_FILENAME; /* name of file with parameter updates */
extern int MAKE_VWGTS; /* make vertex weights equal to degrees? */
extern int MATCH_TYPE; /* matching routine to use */
extern int FREE_GRAPH; /* free graph data structure after reformat? */
extern int DEBUG_PARAMS; /* debug flag for reading parameters */
extern int DEBUG_TRACE; /* trace main execution path */
extern double start_time; /* time routine is entered */
extern double reformat_time;/* time spent reformatting graph */
FILE *params_file=NULL; /* file for reading new parameters */
struct vtx_data **graph; /* graph data structure */
double vwgt_sum; /* sum of vertex weights */
double time; /* timing variable */
float **coords; /* coordinates for vertices if used */
int *vptr; /* loops through vertex weights */
int flag; /* return code from balance */
int nedges; /* number of edges in graph */
int using_vwgts; /* are vertex weights being used? */
int using_ewgts; /* are edge weights being used? */
int nsets_tot=0; /* total number of sets being created */
int igeom; /* geometric dimension for inertial method */
int default_goal; /* using default goals? */
int i; /* loop counter */
double seconds();
int reformat();
void free_graph(), read_params(), strout();
if (DEBUG_TRACE > 0) {
printf("<Entering interface>\n");
}
flag = 0;
graph = NULL;
coords = NULL;
if (!Using_Main) { /* If not using main, need to read parameters file. */
start_time = seconds();
params_file = fopen(PARAMS_FILENAME, "r");
if (params_file == NULL && DEBUG_PARAMS > 1) {
printf("Parameter file `%s' not found; using default parameters.\n",
PARAMS_FILENAME);
}
read_params(params_file);
}
if (goal == NULL) { /* If not passed in, default goals have equal set sizes. */
default_goal = TRUE;
if (architecture == 0)
nsets_tot = 1 << ndims_tot;
else if (architecture == 1)
nsets_tot = mesh_dims[0];
else if (architecture == 2)
nsets_tot = mesh_dims[0] * mesh_dims[1];
else if (architecture > 2)
nsets_tot = mesh_dims[0] * mesh_dims[1] * mesh_dims[2];
if (MAKE_VWGTS && start != NULL) {
vwgt_sum = start[nvtxs] - start[0] + nvtxs;
}
else if (vwgts == NULL) {
vwgt_sum = nvtxs;
}
else {
vwgt_sum = 0;
vptr = vwgts;
for (i = nvtxs; i; i--)
vwgt_sum += *(vptr++);
}
vwgt_sum /= nsets_tot;
goal = smalloc_ret(nsets_tot * sizeof(double));
if (goal == NULL) {
strout("\nERROR: No room to make goals.\n");
flag = 1;
goto skip;
}
for (i = 0; i < nsets_tot; i++)
goal[i] = vwgt_sum;
}
else {
default_goal = FALSE;
}
if (MAKE_VWGTS) {
/* Generate vertex weights equal to degree of node. */
if (vwgts != NULL) {
strout("WARNING: Vertex weights being overwritten by vertex degrees.");
}
vwgts = smalloc_ret(nvtxs * sizeof(int));
if (vwgts == NULL) {
strout("\nERROR: No room to make vertex weights.\n");
flag = 1;
goto skip;
}
if (start != NULL) {
for (i = 0; i < nvtxs; i++)
vwgts[i] = 1 + start[i + 1] - start[i];
}
else {
for (i = 0; i < nvtxs; i++)
vwgts[i] = 1;
}
}
using_vwgts = (vwgts != NULL);
using_ewgts = (ewgts != NULL);
if (start != NULL || vwgts != NULL) { /* Reformat into our data structure. */
time = seconds();
flag = reformat(start, adjacency, nvtxs, &nedges, vwgts, ewgts, &graph);
if (flag) {
strout("\nERROR: No room to reformat graph.\n");
goto skip;
}
reformat_time += seconds() - time;
}
else {
nedges = 0;
}
if (FREE_GRAPH) { /* Free old graph data structures. */
free(start);
free(adjacency);
if (vwgts != NULL)
free(vwgts);
if (ewgts != NULL)
free(ewgts);
start = NULL;
adjacency = NULL;
vwgts = NULL;
ewgts = NULL;
}
if (global_method == 3 ||
(MATCH_TYPE == 5 && (global_method == 1 ||
(global_method == 2 && rqi_flag)))) {
if (x == NULL) {
igeom = 0;
}
else { /* Set up coordinate data structure. */
coords = smalloc_ret(3 * sizeof(float *));
if (coords == NULL) {
strout("\nERROR: No room to make coordinate array.\n");
flag = 1;
goto skip;
}
/* Minus 1's are to allow remainder of program to index with 1. */
coords[0] = x - 1;
igeom = 1;
if (y != NULL) {
coords[1] = y - 1;
igeom = 2;
if (z != NULL) {
coords[2] = z - 1;
igeom = 3;
}
}
}
}
else {
igeom = 0;
}
/* Subtract from assignment to allow code to index from 1. */
assignment = assignment - 1;
flag = submain(graph, nvtxs, nedges, using_vwgts, using_ewgts, igeom, coords,
outassignname, outfilename,
assignment, goal,
architecture, ndims_tot, mesh_dims,
global_method, local_method, rqi_flag, vmax, ndims,
eigtol, seed);
skip:
if (coords != NULL)
sfree(coords);
if (default_goal)
sfree(goal);
if (graph != NULL)
free_graph(graph);
if (flag && FREE_GRAPH) {
sfree(start);
sfree(adjacency);
sfree(vwgts);
sfree(ewgts);
}
if (!Using_Main && params_file != NULL)
fclose(params_file);
return (flag);
}
/* Greedily increase the number of internal vtxs in each set. */
void
force_internal (
struct vtx_data **graph, /* graph data structure */
int nvtxs, /* number of vertices in graph */
int using_ewgts, /* are edge weights being used? */
int *assign, /* current assignment */
double *goal, /* desired set sizes */
int nsets_tot, /* total number of sets */
int npasses_max /* number of passes to make */
)
{
extern int DEBUG_TRACE; /* trace main execution path? */
extern int DEBUG_INTERNAL; /* turn on debugging code here? */
struct bidint *prev; /* back pointer for setting up lists */
struct bidint *int_list = NULL; /* internal vwgt in each set */
struct bidint *vtx_elems = NULL; /* linked lists of vtxs in each set */
struct bidint *set_list = NULL; /* headers for vtx_elems lists */
double *internal_vwgt = NULL; /* total internal vwgt in each set */
int *total_vwgt = NULL; /* total vertex weight in each set */
int *indices = NULL; /* orders sets by internal vwgt */
int *locked = NULL; /* is vertex allowed to switch sets? */
int internal; /* is a vertex internal or not? */
int *space = NULL; /* space for mergesort */
int npasses; /* number of callse to improve_internal */
int nlocked; /* number of vertices that can't move */
int set, set2; /* sets two vertices belong to */
int any_change; /* did pass improve # internal vtxs? */
int niter; /* counts calls to improve_internal */
int vwgt_max; /* largest vertex weight in graph */
int progress; /* am I improving # internal vertices? */
int error; /* out of space? */
int size; /* array spacing */
int i, j; /* loop counters */
int improve_internal();
void mergesort(), check_internal(), strout();
error = 1;
/* For each set, compute the total weight of internal vertices. */
if (DEBUG_TRACE > 0) {
printf("<Entering force_internal>\n");
}
indices = smalloc_ret(nsets_tot * sizeof(int));
internal_vwgt = smalloc_ret(nsets_tot * sizeof(double));
total_vwgt = smalloc_ret(nsets_tot * sizeof(int));
if (indices == NULL || internal_vwgt == NULL || total_vwgt == NULL) goto skip;
for (set=0; set < nsets_tot; set++) {
total_vwgt[set] = internal_vwgt[set] = 0;
indices[set] = set;
}
vwgt_max = 0;
for (i=1; i<=nvtxs; i++) {
internal = TRUE;
set = assign[i];
for (j = 1; j < graph[i]->nedges && internal; j++) {
set2 = assign[graph[i]->edges[j]];
internal = (set2 == set);
}
total_vwgt[set] += graph[i]->vwgt;
if (internal) {
internal_vwgt[set] += graph[i]->vwgt;
}
if (graph[i]->vwgt > vwgt_max) {
vwgt_max = graph[i]->vwgt;
}
}
/* Now sort all the internal_vwgt values. */
space = smalloc_ret(nsets_tot * sizeof(int));
if (space == NULL) goto skip;
mergesort(internal_vwgt, nsets_tot, indices, space);
sfree(space);
space = NULL;
/* Now construct a doubly linked list of sorted, internal_vwgt values. */
int_list = smalloc_ret((nsets_tot + 1) * sizeof(struct bidint));
if (int_list == NULL) goto skip;
prev = &(int_list[nsets_tot]);
prev->prev = NULL;
for (i = 0; i < nsets_tot; i++) {
set = indices[i];
int_list[set].prev = prev;
int_list[set].val = internal_vwgt[set];
prev->next = &(int_list[set]);
prev = &(int_list[set]);
}
prev->next = NULL;
int_list[nsets_tot].val = -1;
sfree(internal_vwgt);
sfree(indices);
internal_vwgt = NULL;
indices = NULL;
/* Set up convenient data structure for navigating through sets. */
set_list = smalloc_ret(nsets_tot * sizeof(struct bidint));
vtx_elems = smalloc_ret((nvtxs + 1) * sizeof(struct bidint));
if (set_list == NULL || vtx_elems == NULL) goto skip;
for (i = 0; i < nsets_tot; i++) {
set_list[i].next = NULL;
}
for (i = 1; i <= nvtxs; i++) {
set = assign[i];
vtx_elems[i].next = set_list[set].next;
if (vtx_elems[i].next != NULL) {
vtx_elems[i].next->prev = &(vtx_elems[i]);
}
vtx_elems[i].prev = &(set_list[set]);
set_list[set].next = &(vtx_elems[i]);
}
locked = smalloc_ret((nvtxs + 1) * sizeof(int));
if (locked == NULL) goto skip;
nlocked = 0;
size = (int) (&(int_list[1]) - &(int_list[0]));
any_change = TRUE;
npasses = 1;
while (any_change && npasses <= npasses_max) {
for (i = 1; i <= nvtxs; i++) {
locked[i] = FALSE;
}
/* Now select top guy off the list and improve him. */
any_change = FALSE;
progress = TRUE;
niter = 1;
while (progress) {
prev = int_list[nsets_tot].next;
set = ((int) (prev - int_list)) / size;
if (DEBUG_INTERNAL > 0) {
printf("Before iteration %d, nlocked = %d, int[%d] = %d\n",
niter, nlocked, set, prev->val);
}
if (DEBUG_INTERNAL > 1) {
check_internal(graph, nvtxs, int_list, set_list, vtx_elems, total_vwgt,
assign, nsets_tot);
}
progress = improve_internal(graph, nvtxs, assign, goal, int_list, set_list,
vtx_elems, set, locked, &nlocked, using_ewgts, vwgt_max, total_vwgt);
if (progress) any_change = TRUE;
niter++;
}
npasses++;
}
error = 0;
skip:
if (error) {
strout("\nWARNING: No space to increase internal vertices.");
strout(" NO INTERNAL VERTEX INCREASE PERFORMED.\n");
}
sfree(internal_vwgt);
sfree(indices);
sfree(locked);
sfree(total_vwgt);
sfree(vtx_elems);
sfree(int_list);
sfree(set_list);
}
int
lanczos_ext_float (
struct vtx_data **A, /* sparse matrix in row linked list format */
int n, /* problem size */
int d, /* problem dimension = number of eigvecs to find */
double **y, /* columns of y are eigenvectors of A */
double eigtol, /* tolerance on eigenvectors */
double *vwsqrt, /* square roots of vertex weights */
double maxdeg, /* maximum degree of graph */
int version, /* flags which version of sel. orth. to use */
double *gvec, /* the rhs n-vector in the extended eigen problem */
double sigma /* specifies the norm constraint on extended
eigenvector */
)
{
extern FILE *Output_File; /* output file or null */
extern int LANCZOS_SO_INTERVAL; /* interval between orthogonalizations */
extern int LANCZOS_MAXITNS; /* maximum Lanczos iterations allowed */
extern int DEBUG_EVECS; /* print debugging output? */
extern int DEBUG_TRACE; /* trace main execution path */
extern int WARNING_EVECS; /* print warning messages? */
extern double BISECTION_SAFETY; /* safety factor for T bisection */
extern double SRESTOL; /* resid tol for T evec comp */
extern double DOUBLE_EPSILON; /* machine precision */
extern double DOUBLE_MAX; /* largest double value */
extern double splarax_time; /* time matvec */
extern double orthog_time; /* time orthogonalization work */
extern double evec_time; /* time to generate eigenvectors */
extern double ql_time; /* time tridiagonal eigenvalue work */
extern double blas_time; /* time for blas. linear algebra */
extern double init_time; /* time to allocate, intialize variables */
extern double scan_time; /* time for scanning eval and bound lists */
extern double debug_time; /* time for (some of) debug computations */
extern double ritz_time; /* time to generate ritz vectors */
extern double pause_time; /* time to compute whether to pause */
int i, j, k; /* indicies */
int maxj; /* maximum number of Lanczos iterations */
float *u, *r; /* Lanczos vectors */
double *u_double; /* double version of u */
double *alpha, *beta; /* the Lanczos scalars from each step */
double *ritz; /* copy of alpha for ql */
double *workj; /* work vector, e.g. copy of beta for ql */
float *workn; /* work vector, e.g. product Av for checkeig */
double *workn_double; /* work vector, e.g. product Av for checkeig */
double *s; /* eigenvector of T */
float **q; /* columns of q are Lanczos basis vectors */
double *bj; /* beta(j)*(last el. of corr. eigvec s of T) */
double bis_safety; /* real safety factor for T bisection */
double Sres; /* how well Tevec calculated eigvec s */
double Sres_max; /* Max value of Sres */
int inc_bis_safety; /* need to increase bisection safety */
double *Ares; /* how well Lanczos calc. eigpair lambda,y */
int *index; /* the Ritz index of an eigenpair */
struct orthlink_float **solist; /* vec. of structs with vecs. to orthog. against */
struct scanlink *scanlist; /* linked list of fields to do with min ritz vals */
struct scanlink *curlnk; /* for traversing the scanlist */
double bji_tol; /* tol on bji est. of eigen residual of A */
int converged; /* has the iteration converged? */
double goodtol; /* error tolerance for a good Ritz vector */
int ngood; /* total number of good Ritz pairs at current step */
int maxngood; /* biggest val of ngood through current step */
int left_ngood; /* number of good Ritz pairs on left end */
int lastpause; /* Most recent step with good ritz vecs */
int nopauses; /* Have there been any pauses? */
int interval; /* number of steps between pauses */
double time; /* Current clock time */
int left_goodlim; /* number of ritz pairs checked on left end */
double Anorm; /* Norm estimate of the Laplacian matrix */
int pausemode; /* which Lanczos pausing criterion to use */
int pause; /* whether to pause */
int temp; /* used to prevent redundant index computations */
double *extvec; /* n-vector solving the extended A eigenproblem */
double *v; /* j-vector solving the extended T eigenproblem */
double extval=0.0; /* computed extended eigenvalue (of both A and T) */
double *work1, *work2; /* work vectors */
double check; /* to check an orthogonality condition */
double numerical_zero; /* used for zero in presense of round-off */
int ritzval_flag; /* status flag for get_ritzvals() */
double resid; /* residual */
int memory_ok; /* TRUE until memory runs out */
float *vwsqrt_float = NULL; /* float version of vwsqrt */
struct orthlink_float *makeorthlnk_float(); /* makes space for new entry in orthog. set */
struct scanlink *mkscanlist(); /* init scan list for min ritz vecs */
double *mkvec(); /* allocates space for a vector */
float *mkvec_float(); /* allocates space for a vector */
float *mkvec_ret_float(); /* mkvec() which returns error code */
double dot_float(); /* standard dot product routine */
double ch_norm(); /* vector norm */
double norm_float(); /* vector norm */
double Tevec(); /* calc eigenvector of T by linear recurrence */
double lanc_seconds(); /* switcheable timer */
/* free allocated memory safely */
int lanpause_float(); /* figure when to pause Lanczos iteration */
int get_ritzvals(); /* compute eigenvalues of T */
void setvec(); /* initialize a vector */
void setvec_float(); /* initialize a vector */
void vecscale_float(); /* scale a vector */
void splarax(); /* matrix vector multiply */
void splarax_float(); /* matrix vector multiply */
void update_float(); /* add scalar multiple of a vector to another */
void sorthog_float(); /* orthogonalize vector against list of others */
void bail(); /* our exit routine */
void scanmin(); /* store small values of vector in linked list */
void frvec(); /* free vector */
void frvec_float(); /* free vector */
void scadd(); /* add scalar multiple of vector to another */
void scadd_float(); /* add scalar multiple of vector to another */
void scadd_mixed(); /* add scalar multiple of vector to another */
void orthog1_float(); /* efficiently orthog. against vector of ones */
void solistout_float(); /* print out orthogonalization list */
void doubleout(); /* print a double precision number */
void orthogvec_float(); /* orthogonalize one vector against another */
void double_to_float(); /* copy a double vector to a float vector */
void get_extval(); /* find extended Ritz values */
void scale_diag(); /* scale vector by diagonal matrix */
void scale_diag_float(); /* scale vector by diagonal matrix */
void strout(); /* print string to screen and file */
if (DEBUG_TRACE > 0) {
printf("<Entering lanczos_ext_float>\n");
}
if (DEBUG_EVECS > 0) {
printf("Selective orthogonalization Lanczos for extended eigenproblem, matrix size = %d.\n", n);
}
/* Initialize time. */
time = lanc_seconds();
if (d != 1) {
bail("ERROR: Extended Lanczos only available for bisection.",1);
/* ... something must be wrong upstream. */
}
if (n < d + 1) {
bail("ERROR: System too small for number of eigenvalues requested.",1);
/* ... d+1 since don't use zero eigenvalue pair */
}
/* Allocate space. */
maxj = LANCZOS_MAXITNS;
u = mkvec_float(1, n);
u_double = mkvec(1, n);
r = mkvec_float(1, n);
workn = mkvec_float(1, n);
workn_double = mkvec(1, n);
Ares = mkvec(0, d);
index = smalloc((d + 1) * sizeof(int));
alpha = mkvec(1, maxj);
beta = mkvec(0, maxj);
ritz = mkvec(1, maxj);
s = mkvec(1, maxj);
bj = mkvec(1, maxj);
workj = mkvec(0, maxj);
q = smalloc((maxj + 1) * sizeof(float *));
solist = smalloc((maxj + 1) * sizeof(struct orthlink_float *));
scanlist = mkscanlist(d);
extvec = mkvec(1, n);
v = mkvec(1, maxj);
work1 = mkvec(1, maxj);
work2 = mkvec(1, maxj);
/* Set some constants governing orthogonalization */
ngood = 0;
maxngood = 0;
bji_tol = eigtol;
Anorm = 2 * maxdeg; /* Gershgorin estimate for ||A|| */
goodtol = Anorm * sqrt(DOUBLE_EPSILON); /* Parlett & Scott's bound, p.224 */
interval = 2 + (int) min(LANCZOS_SO_INTERVAL - 2, n / (2 * LANCZOS_SO_INTERVAL));
bis_safety = BISECTION_SAFETY;
numerical_zero = 1.0e-6;
if (DEBUG_EVECS > 0) {
printf(" maxdeg %g\n", maxdeg);
printf(" goodtol %g\n", goodtol);
printf(" interval %d\n", interval);
printf(" maxj %d\n", maxj);
}
/* Make a float copy of vwsqrt */
if (vwsqrt != NULL) {
vwsqrt_float = mkvec_float(0,n);
double_to_float(vwsqrt_float,1,n,vwsqrt);
}
/* Initialize space. */
double_to_float(r,1,n,gvec);
if (vwsqrt_float != NULL) {
scale_diag_float(r,1,n,vwsqrt_float);
}
check = norm_float(r,1,n);
if (vwsqrt_float == NULL) {
orthog1_float(r, 1, n);
}
else {
orthogvec_float(r, 1, n, vwsqrt_float);
}
check = fabs(check - norm_float(r,1,n));
if (check > 10*numerical_zero && WARNING_EVECS > 0) {
strout("WARNING: In terminal propagation, rhs should have no component in the");
printf(" nullspace of the Laplacian, so check val %g should be zero.\n", check);
if (Output_File != NULL) {
fprintf(Output_File,
" nullspace of the Laplacian, so check val %g should be zero.\n",
check);
}
}
beta[0] = norm_float(r, 1, n);
q[0] = mkvec_float(1, n);
setvec_float(q[0], 1, n, 0.0);
setvec(bj, 1, maxj, DOUBLE_MAX);
if (beta[0] < numerical_zero) {
/* The rhs vector, Dg, of the transformed problem is numerically zero or is
in the null space of the Laplacian, so this is not a well posed extended
eigenproblem. Set maxj to zero to force a quick exit but still clean-up
memory and return(1) to indicate to eigensolve that it should call the
default eigensolver routine for the standard eigenproblem. */
maxj = 0;
}
/* Main Lanczos loop. */
j = 1;
lastpause = 0;
pausemode = 1;
left_ngood = 0;
left_goodlim = 0;
converged = FALSE;
Sres_max = 0.0;
inc_bis_safety = FALSE;
nopauses = TRUE;
memory_ok = TRUE;
init_time += lanc_seconds() - time;
while ((j <= maxj) && (!converged) && memory_ok) {
time = lanc_seconds();
/* Allocate next Lanczos vector. If fail, back up to last pause. */
q[j] = mkvec_ret_float(1, n);
if (q[j] == NULL) {
memory_ok = FALSE;
if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
strout("WARNING: Lanczos_ext out of memory; computing best approximation available.\n");
}
if (nopauses) {
bail("ERROR: Sorry, can't salvage Lanczos_ext.",1);
/* ... save yourselves, men. */
}
for (i = lastpause+1; i <= j-1; i++) {
frvec_float(q[i], 1);
}
j = lastpause;
}
/* Basic Lanczos iteration */
vecscale_float(q[j], 1, n, (float)(1.0 / beta[j - 1]), r);
blas_time += lanc_seconds() - time;
time = lanc_seconds();
splarax_float(u, A, n, q[j], vwsqrt_float, workn);
splarax_time += lanc_seconds() - time;
time = lanc_seconds();
update_float(r, 1, n, u, (float)(-beta[j - 1]), q[j - 1]);
alpha[j] = dot_float(r, 1, n, q[j]);
update_float(r, 1, n, r, (float)(-alpha[j]), q[j]);
blas_time += lanc_seconds() - time;
/* Selective orthogonalization */
time = lanc_seconds();
if (vwsqrt_float == NULL) {
orthog1_float(r, 1, n);
}
else {
orthogvec_float(r, 1, n, vwsqrt_float);
}
if ((j == (lastpause + 1)) || (j == (lastpause + 2))) {
sorthog_float(r, n, solist, ngood);
}
orthog_time += lanc_seconds() - time;
beta[j] = norm_float(r, 1, n);
time = lanc_seconds();
pause = lanpause_float(j, lastpause, interval, q, n, &pausemode, version, beta[j]);
pause_time += lanc_seconds() - time;
if (pause) {
nopauses = FALSE;
lastpause = j;
/* Compute limits for checking Ritz pair convergence. */
if (version == 2) {
if (left_ngood + 2 > left_goodlim) {
left_goodlim = left_ngood + 2;
}
}
/* Special case: need at least d Ritz vals on left. */
left_goodlim = max(left_goodlim, d);
/* Special case: can't find more than j total Ritz vals. */
if (left_goodlim > j) {
left_goodlim = min(left_goodlim, j);
}
/* Find Ritz vals using faster of Sturm bisection or ql. */
time = lanc_seconds();
if (inc_bis_safety) {
bis_safety *= 10;
inc_bis_safety = FALSE;
}
ritzval_flag = get_ritzvals(alpha, beta, j, Anorm, workj, ritz, d,
left_goodlim, 0, eigtol, bis_safety);
ql_time += lanc_seconds() - time;
if (ritzval_flag != 0) {
bail("ERROR: Lanczos_ext failed in computing eigenvalues of T.",1);
/* ... we recover from this in lanczos_SO, but don't worry here. */
}
/* Scan for minimum evals of tridiagonal. */
time = lanc_seconds();
scanmin(ritz, 1, j, &scanlist);
scan_time += lanc_seconds() - time;
/* Compute Ritz pair bounds at left end. */
time = lanc_seconds();
setvec(bj, 1, j, 0.0);
for (i = 1; i <= left_goodlim; i++) {
Sres = Tevec(alpha, beta - 1, j, ritz[i], s);
if (Sres > Sres_max) {
Sres_max = Sres;
}
if (Sres > SRESTOL) {
inc_bis_safety = TRUE;
}
bj[i] = s[j] * beta[j];
}
ritz_time += lanc_seconds() - time;
/* Show the portion of the spectrum checked for convergence. */
if (DEBUG_EVECS > 2) {
time = lanc_seconds();
printf("\nindex Ritz vals bji bounds\n");
for (i = 1; i <= left_goodlim; i++) {
printf(" %3d", i);
doubleout(ritz[i], 1);
doubleout(bj[i], 1);
printf("\n");
}
printf("\n");
curlnk = scanlist;
while (curlnk != NULL) {
temp = curlnk->indx;
if ((temp > left_goodlim) && (temp < j)) {
printf(" %3d", temp);
doubleout(ritz[temp], 1);
doubleout(bj[temp], 1);
printf("\n");
}
curlnk = curlnk->pntr;
}
printf(" -------------------\n");
printf(" goodtol: %19.16f\n\n", goodtol);
debug_time += lanc_seconds() - time;
}
get_extval(alpha, beta, j, ritz[1], s, eigtol, beta[0], sigma, &extval,
v, work1, work2);
/* check convergence of Ritz pairs */
time = lanc_seconds();
converged = TRUE;
if (j < d)
converged = FALSE;
else {
curlnk = scanlist;
while (curlnk != NULL) {
if (bj[curlnk->indx] > bji_tol) {
converged = FALSE;
}
curlnk = curlnk->pntr;
}
}
scan_time += lanc_seconds() - time;
if (!converged) {
ngood = 0;
left_ngood = 0; /* for setting left_goodlim on next loop */
/* Compute converged Ritz pairs on left end */
time = lanc_seconds();
for (i = 1; i <= left_goodlim; i++) {
if (bj[i] <= goodtol) {
ngood += 1;
left_ngood += 1;
if (ngood > maxngood) {
maxngood = ngood;
solist[ngood] = makeorthlnk_float();
(solist[ngood])->vec = mkvec_float(1, n);
}
(solist[ngood])->index = i;
Sres = Tevec(alpha, beta - 1, j, ritz[i], s);
if (Sres > Sres_max) {
Sres_max = Sres;
}
if (Sres > SRESTOL) {
inc_bis_safety = TRUE;
}
setvec_float((solist[ngood])->vec, 1, n, 0.0);
for (k = 1; k <= j; k++) {
scadd_float((solist[ngood])->vec, 1, n, s[k], q[k]);
}
}
}
ritz_time += lanc_seconds() - time;
if (DEBUG_EVECS > 2) {
time = lanc_seconds();
printf(" j %3d; goodlim lft %2d, rgt %2d; list ",
j, left_goodlim, 0);
solistout_float(solist, n, ngood, j);
printf("---------------------end of iteration---------------------\n\n");
debug_time += lanc_seconds() - time;
}
}
}
j++;
}
j--;
if (DEBUG_EVECS > 0) {
time = lanc_seconds();
if (maxj == 0) {
printf("Not extended eigenproblem -- calling ordinary eigensolver.\n");
}
else {
printf(" Lanczos_ext itns: %d\n",j);
printf(" eigenvalue: %g\n",ritz[1]);
printf(" extended eigenvalue: %g\n",extval);
}
debug_time += lanc_seconds() - time;
}
if (maxj != 0) {
/* Compute (scaled) extended eigenvector. */
time = lanc_seconds();
setvec(y[1], 1, n, 0.0);
for (k = 1; k <= j; k++) {
scadd_mixed(y[1], 1, n, v[k], q[k]);
}
evec_time += lanc_seconds() - time;
/* Note: assign() will scale this y vector back to x (since y = Dx) */
/* Compute and check residual directly. Use the Ay = extval*y + Dg version of
the problem for convenience. Note that u and v are used here as workspace */
time = lanc_seconds();
splarax(workn_double, A, n, y[1], vwsqrt, u_double);
scadd(workn_double, 1, n, -extval, y[1]);
scale_diag(gvec,1,n,vwsqrt);
scadd(workn_double, 1, n, -1.0, gvec);
resid = ch_norm(workn_double, 1, n);
if (DEBUG_EVECS > 0) {
printf(" extended residual: %g\n",resid);
if (Output_File != NULL) {
fprintf(Output_File, " extended residual: %g\n",resid);
}
}
if (WARNING_EVECS > 0 && resid > eigtol) {
printf("WARNING: Extended residual (%g) greater than tolerance (%g).\n",
resid, eigtol);
if (Output_File != NULL) {
fprintf(Output_File,
"WARNING: Extended residual (%g) greater than tolerance (%g).\n",
resid, eigtol);
}
}
debug_time += lanc_seconds() - time;
}
/* free up memory */
time = lanc_seconds();
frvec_float(u, 1);
frvec(u_double, 1);
frvec_float(r, 1);
frvec_float(workn, 1);
frvec(workn_double, 1);
frvec(Ares, 0);
sfree(index);
frvec(alpha, 1);
frvec(beta, 0);
frvec(ritz, 1);
frvec(s, 1);
frvec(bj, 1);
frvec(workj, 0);
for (i = 0; i <= j; i++) {
frvec_float(q[i], 1);
}
sfree(q);
while (scanlist != NULL) {
curlnk = scanlist->pntr;
sfree(scanlist);
scanlist = curlnk;
}
for (i = 1; i <= maxngood; i++) {
frvec_float((solist[i])->vec, 1);
sfree(solist[i]);
}
sfree(solist);
frvec(extvec, 1);
frvec(v, 1);
frvec(work1, 1);
frvec(work2, 1);
if (vwsqrt != NULL)
frvec_float(vwsqrt_float, 1);
init_time += lanc_seconds() - time;
if (maxj == 0) return(1); /* see note on beta[0] and maxj above */
else return(0);
}
CStr HEX_decode(CStr strin)
{
CStr strout((int) strin.Length() / 2);
HEX_decode(strin, strout.GetBuffer(), strin.Length());
return strout;
}
CStr HEX_encode(CStr strin)
{
CStr strout(strin.Length() * 2);
HEX_encode(strin, strout.GetBuffer(), strin.Length());
return strout;
}
CStr MD5_string(CStr strin)
{
CStr strout(MD5_DIGEST_LENGTH);
MD5_string(strin, strin.Length(), strout.GetBuffer());
return strout;
}
CStr SHA1_string(CStr strin)
{
CStr strout(SHA_DIGEST_LENGTH);
SHA1_string(strin, strin.Length(), strout.GetBuffer());
return strout;
}
int
submain (
struct vtx_data **graph, /* data structure for graph */
int nvtxs, /* number of vertices in full graph */
int nedges, /* number of edges in graph */
int using_vwgts, /* are vertex weights being used? */
int using_ewgts, /* are edge weights being used? */
int igeom, /* geometry dimension if using inertial method */
float **coords, /* coordinates of vertices if used */
char *outassignname, /* name of assignment output file */
char *outfilename, /* in which to print output metrics */
int *assignment, /* set number of each vtx (length n) */
double *goal, /* desired sizes for each set */
int architecture, /* 0=> hypercube, d=> d-dimensional mesh */
int ndims_tot, /* total number hypercube dimensions */
int mesh_dims[3], /* extent of mesh in 3 directions */
int global_method, /* global partitioning algorithm */
int local_method, /* local partitioning algorithm */
int rqi_flag, /* use RQI/Symmlq eigensolver? */
int vmax, /* if so, how many vtxs to coarsen down to */
int ndims, /* number of eigenvectors (2^d sets) */
double eigtol, /* tolerance on eigenvectors */
long seed /* for random graph mutations */
)
{
extern int ECHO; /* controls output to file or screen */
extern int CHECK_INPUT; /* should I check input for correctness? */
extern int SEQUENCE; /* just generate spectal ordering? */
extern int OUTPUT_ASSIGN; /* print assignment to a file? */
extern int OUTPUT_METRICS; /* controls formatting of output */
extern int PERTURB; /* perturb matrix if quad/octasection? */
extern int NSQRTS; /* number of square roots to precompute */
extern int KL_METRIC; /* KL interset cost: 1=>cuts, 2=>hops */
extern int LANCZOS_TYPE; /* type of Lanczos to use */
extern int REFINE_MAP; /* use greedy strategy to improve mapping? */
extern int REFINE_PARTITION;/* number of calls to pairwise_refine to make */
extern int VERTEX_COVER; /* use matching to reduce vertex separator? */
extern int CONNECTED_DOMAINS; /* force subdomain connectivity at end? */
extern int INTERNAL_VERTICES; /* greedily increase internal vtxs? */
extern int DEBUG_INTERNAL; /* debug code about force_internal? */
extern int DEBUG_REFINE_PART; /* debug code about refine_part? */
extern int DEBUG_REFINE_MAP; /* debug code about refine_map? */
extern int DEBUG_MACH_PARAMS; /* print out computed machine params? */
extern int DEBUG_TRACE; /* trace main execution path */
extern int PRINT_HEADERS; /* print section headings for output? */
extern int TIME_KERNELS; /* benchmark some numerical kernels? */
extern double start_time; /* time code was entered */
extern double total_time; /* (almost) total time spent in code */
extern double check_input_time; /* time spent checking input */
extern double partition_time; /* time spent partitioning graph */
extern double kernel_time; /* time spent benchmarking kernels */
extern double count_time; /* time spent evaluating the answer */
extern double print_assign_time; /* time spent writing output file */
FILE *outfile; /* output file */
struct vtx_data **graph2; /* data structure for graph */
int hop_mtx[MAXSETS][MAXSETS]; /* between-set hop cost for KL */
double *vwsqrt; /* sqrt of vertex weights (length nvtxs+1) */
double time, time1; /* timing variables */
char *graphname, *geomname; /* names of input files */
char *inassignname; /* name of assignment input file */
int old_nsqrts; /* old value of NSQRTS */
int append; /* append output to existing file? */
int nsets; /* number of sets created by each divide */
int nsets_tot; /* total number of sets */
int bits; /* used in computing hops */
int flag; /* return code from check_input */
int old_perturb=0; /* saves original pertubation flag */
int i, j, k; /* loop counters */
double seconds();
void setrandom(long int seed);
int check_input(), refine_part();
void connect_enforce();
void setrandom(), makevwsqrt(), balance(), countup();
void force_internal(), sequence(), reflect_input();
void machine_params(), assign_out(), refine_map();
void time_out(), time_kernels(), strout();
if (DEBUG_TRACE > 0) {
printf("<Entering submain>\n");
}
/* First check all the input for consistency. */
if (architecture == 1)
mesh_dims[1] = mesh_dims[2] = 1;
else if (architecture == 2)
mesh_dims[2] = 1;
/* Check for simple special case of 1 processor. */
k = 0;
if (architecture == 0)
k = 1 << ndims_tot;
else if (architecture > 0)
k = mesh_dims[0] * mesh_dims[1] * mesh_dims[2];
if (k == 1) {
for (i = 1; i <= nvtxs; i++) assignment[i] = 0;
if (OUTPUT_ASSIGN > 0 && outassignname != NULL) {
time1 = seconds();
assign_out(nvtxs, assignment, k, outassignname);
print_assign_time += seconds() - time1;
}
return(0);
}
graphname = Graph_File_Name;
geomname = Geometry_File_Name;
inassignname = Assign_In_File_Name;
/* Turn of perturbation if using bisection */
if (ndims == 1) {
old_perturb = PERTURB;
PERTURB = FALSE;
}
if (ECHO < 0 && outfilename != NULL) { /* Open output file */
outfile = fopen(outfilename, "r");
if (outfile != NULL) {
append = TRUE;
fclose(outfile);
}
else append = FALSE;
outfile = fopen(outfilename, "a");
if (append) {
fprintf(outfile, "\n------------------------------------------------\n\n");
}
}
else {
outfile = NULL;
}
Output_File = outfile;
if (outfile != NULL && PRINT_HEADERS) {
fprintf(outfile, "\n Chaco 2.0\n");
fprintf(outfile, " Sandia National Laboratories\n\n");
}
if (CHECK_INPUT) { /* Check the input for inconsistencies. */
time1 = seconds();
flag = check_input(graph, nvtxs, nedges, igeom, coords,
graphname, assignment, goal,
architecture, ndims_tot, mesh_dims,
global_method, local_method, rqi_flag, &vmax, ndims,
eigtol);
check_input_time += seconds() - time1;
if (flag) {
strout("ERROR IN INPUT.\n");
return (1);
}
}
if (ECHO != 0) {
reflect_input(nvtxs, nedges, igeom, graphname, geomname,
inassignname, outassignname, outfilename,
architecture, ndims_tot, mesh_dims,
global_method, local_method, rqi_flag, vmax, ndims,
eigtol, seed, outfile);
}
if (PRINT_HEADERS) {
printf("\n\nStarting to partition ...\n\n");
if (Output_File != NULL ) {
fprintf(Output_File,
"\n\nStarting to partition ... (residual, warning and error messages only)\n\n");
}
}
time = seconds();
/* Perform some one-time initializations. */
setrandom(seed);
machine_params(&DOUBLE_EPSILON, &DOUBLE_MAX);
if (DEBUG_MACH_PARAMS > 0) {
printf("Machine parameters:\n");
printf(" DOUBLE_EPSILON = %e\n", DOUBLE_EPSILON);
printf(" DOUBLE_MAX = %e\n", DOUBLE_MAX);
}
nsets = (1 << ndims);
old_nsqrts = NSQRTS;
if (nvtxs < NSQRTS && !using_vwgts) {
NSQRTS = nvtxs;
}
SQRTS = smalloc_ret((NSQRTS + 1) * sizeof(double));
if (SQRTS == NULL) {
strout("ERROR: No space to allocate sqrts\n");
return(1);
}
for (i = 1; i <= NSQRTS; i++)
SQRTS[i] = sqrt((double) i);
if (using_vwgts && (global_method == 1 || global_method == 2)) {
vwsqrt = smalloc_ret((nvtxs + 1) * sizeof(double));
if (vwsqrt == NULL) {
strout("ERROR: No space to allocate vwsqrt\n");
sfree(SQRTS);
NSQRTS = old_nsqrts;
return(1);
}
makevwsqrt(vwsqrt, graph, nvtxs);
}
else
vwsqrt = NULL;
if (TIME_KERNELS) {
time1 = seconds();
time_kernels(graph, nvtxs, vwsqrt);
kernel_time += seconds() - time1;
}
if (SEQUENCE) {
sequence(graph, nvtxs, nedges, using_ewgts, vwsqrt,
LANCZOS_TYPE, rqi_flag, vmax, eigtol);
goto End_Label;
}
/* Initialize cost function for KL-spiff */
if (global_method == 1 || local_method == 1) {
for (i = 0; i < nsets; i++) {
hop_mtx[i][i] = 0;
for (j = 0; j < i; j++) {
if (KL_METRIC == 2) { /* Count hypercube hops */
hop_mtx[i][j] = 0;
bits = i ^ j;
while (bits) {
if (bits & 1) {
++hop_mtx[i][j];
}
bits >>= 1;
}
}
else if (KL_METRIC == 1) { /* Count cut edges */
hop_mtx[i][j] = 1;
}
hop_mtx[j][i] = hop_mtx[i][j];
}
}
void refine_map(struct vtx_data **graph, /* graph data structure */
int nvtxs, /* number of vertices in graph */
int using_ewgts, /* are edge weights being used? */
int * assign, /* current assignment */
int cube_or_mesh, /* 0 => hypercube, d => d-dimensional mesh */
int ndims_tot, /* if hypercube, number of dimensions */
int mesh_dims[3] /* if mesh, dimensions of mesh */
)
{
struct vtx_data **comm_graph; /* graph for communication requirements */
int nsets_tot = 0; /* total number of sets */
int * vtx2node = NULL; /* mapping of comm_graph vtxs to processors */
int * node2vtx = NULL; /* mapping of sets to comm_graph vtxs */
double maxdesire = 0.0; /* largest possible desire to flip an edge */
int error = 0; /* out of space? */
int i; /* loop counter */
double find_maxdeg();
void free_graph(), strout();
int make_comm_graph(), refine_mesh(), refine_cube();
if (cube_or_mesh == 0)
nsets_tot = 1 << ndims_tot;
else if (cube_or_mesh == 1)
nsets_tot = mesh_dims[0];
else if (cube_or_mesh == 2)
nsets_tot = mesh_dims[0] * mesh_dims[1];
else if (cube_or_mesh == 3)
nsets_tot = mesh_dims[0] * mesh_dims[1] * mesh_dims[2];
node2vtx = vtx2node = NULL;
/* Construct the weighted quotient graph representing communication. */
error = make_comm_graph(&comm_graph, graph, nvtxs, using_ewgts, assign, nsets_tot);
if (!error) {
maxdesire = 2 * find_maxdeg(comm_graph, nsets_tot, TRUE, (float *)NULL);
vtx2node = smalloc_ret((nsets_tot + 1) * sizeof(int));
node2vtx = smalloc_ret(nsets_tot * sizeof(int));
if (node2vtx == NULL || vtx2node == NULL) {
error = 1;
goto skip;
}
for (i = 1; i <= nsets_tot; i++) {
vtx2node[i] = (int)i - 1;
node2vtx[i - 1] = (int)i;
}
if (cube_or_mesh > 0) {
error = refine_mesh(comm_graph, cube_or_mesh, mesh_dims, maxdesire, vtx2node, node2vtx);
}
else if (cube_or_mesh == 0) {
error = refine_cube(comm_graph, ndims_tot, maxdesire, vtx2node, node2vtx);
}
if (!error) {
for (i = 1; i <= nvtxs; i++) {
assign[i] = vtx2node[assign[i] + 1];
}
}
}
skip:
if (error) {
strout("\nWARNING: No space to refine mapping to processors.");
strout(" NO MAPPING REFINEMENT PERFORMED.\n");
}
sfree(node2vtx);
sfree(vtx2node);
free_graph(comm_graph);
}
void
rqi (
struct vtx_data **A, /* matrix/graph being analyzed */
double **yvecs, /* eigenvectors to be refined */
int index, /* index of vector in yvecs to be refined */
int n, /* number of rows/columns in matrix */
double *r1,
double *r2,
double *v,
double *w,
double *x,
double *y,
double *work, /* work space for symmlq */
double tol, /* error tolerance in eigenpair */
double initshift, /* initial shift */
double *evalest, /* returned eigenvalue */
double *vwsqrt, /* square roots of vertex weights */
struct orthlink *orthlist, /* lower evecs to orthogonalize against */
int cube_or_mesh, /* 0 => hypercube, d => d-dimensional mesh */
int nsets, /* number of sets to divide into */
int *assignment, /* set number of each vtx (length n+1) */
int *active, /* space for nvtxs integers */
int mediantype, /* which partitioning strategy to use */
double *goal, /* desired set sizes */
int vwgt_max, /* largest vertex weight */
int ndims /* dimensionality of partition */
)
{
extern int DEBUG_EVECS; /* debug flag for eigen computation */
extern int DEBUG_TRACE; /* trace main execution path */
extern int WARNING_EVECS; /* warning flag for eigen computation */
extern int RQI_CONVERGENCE_MODE; /* type of convergence monitoring to do */
int rqisteps; /* # rqi rqisteps */
double res; /* convergence quant for rqi */
double last_res; /* res on previous rqi step */
double macheps; /* machine precision calculated by symmlq */
double normxlim; /* a stopping criteria for symmlq */
double normx; /* norm of the solution vector */
int symmlqitns; /* # symmlq itns */
int inv_it_steps; /* intial steps of inverse iteration */
long itnmin; /* symmlq input */
double shift, rtol; /* symmlq input */
long precon, goodb, nout; /* symmlq input */
long checka, intlim; /* symmlq input */
double anorm, acond; /* symmlq output */
double rnorm, ynorm; /* symmlq output */
long istop, itn; /* symmlq output */
long long_n; /* copy of n for passing to symmlq */
int warning; /* warning on possible misconvergence */
double factor; /* ratio between previous res and new tol */
double minfactor; /* minimum acceptable value of factor */
int converged; /* has process converged yet? */
double *u; /* name of vector being refined */
int *old_assignment=NULL;/* previous assignment vector */
int *assgn_pntr; /* pntr to assignment vector */
int *old_assgn_pntr; /* pntr to previous assignment vector */
int assigndiff=0; /* discrepancies between old and new assignment */
int assigntol=0; /* tolerance on convergence of assignment vector */
int first; /* is this the first RQI step? */
int i; /* loop index */
double dot(), ch_norm();
int symmlq_();
void splarax(), scadd(), vecscale(), doubleout(), assign(), x2y(), strout();
if (DEBUG_TRACE > 0) {
printf("<Entering rqi>\n");
}
/* Initialize RQI loop */
u = yvecs[index];
splarax(y, A, n, u, vwsqrt, r1);
shift = dot(u, 1, n, y);
scadd(y, 1, n, -shift, u);
res = ch_norm(y, 1, n); /* eigen-residual */
rqisteps = 0; /* a counter */
symmlqitns = 0; /* a counter */
/* Set invariant symmlq parameters */
precon = FALSE; /* FALSE until we figure out a good way */
goodb = TRUE; /* should be TRUE for this application */
nout = 0; /* set to 0 for no Symmlq output; 6 for lots */
checka = FALSE; /* if don't know by now, too bad */
intlim = n; /* set to enforce a maximum number of Symmlq itns */
itnmin = 0; /* set to enforce a minimum number of Symmlq itns */
long_n = n; /* type change for alint */
if (DEBUG_EVECS > 0) {
printf("Using RQI/Symmlq refinement on graph with %d vertices.\n", n);
}
if (DEBUG_EVECS > 1) {
printf(" step lambda est. Ares Symmlq its. istop factor delta\n");
printf(" 0");
doubleout(shift, 1);
doubleout(res, 1);
printf("\n");
}
if (RQI_CONVERGENCE_MODE == 1) {
assigntol = tol * n;
old_assignment = smalloc((n + 1) * sizeof(int));
}
/* Perform RQI */
inv_it_steps = 2;
warning = FALSE;
factor = 10;
minfactor = factor / 2;
first = TRUE;
if (res < tol)
converged = TRUE;
else
converged = FALSE;
while (!converged) {
if (res / tol < 1.2) {
factor = max(factor / 2, minfactor);
}
rtol = res / factor;
/* exit Symmlq if iterate is this large */
normxlim = 1.0 / rtol;
if (rqisteps < inv_it_steps) {
shift = initshift;
}
symmlq_(&long_n, &u[1], &r1[1], &r2[1], &v[1], &w[1], &x[1], &y[1],
work, &checka, &goodb, &precon, &shift, &nout,
&intlim, &rtol, &istop, &itn, &anorm, &acond,
&rnorm, &ynorm, (double *) A, vwsqrt, (double *) orthlist,
&macheps, &normxlim, &itnmin);
symmlqitns += itn;
normx = ch_norm(x, 1, n);
vecscale(u, 1, n, 1.0 / normx, x);
splarax(y, A, n, u, vwsqrt, r1);
shift = dot(u, 1, n, y);
scadd(y, 1, n, -shift, u);
last_res = res;
res = ch_norm(y, 1, n);
if (res > last_res) {
warning = TRUE;
}
rqisteps++;
if (res < tol)
converged = TRUE;
if (RQI_CONVERGENCE_MODE == 1 && !converged && ndims == 1) {
if (first) {
assign(A, yvecs, n, 1, cube_or_mesh, nsets, vwsqrt, assignment,
active, mediantype, goal, vwgt_max);
x2y(yvecs, ndims, n, vwsqrt);
first = FALSE;
assigndiff = n; /* dummy value for debug chart */
}
else {
/* copy assignment to old_assignment */
assgn_pntr = assignment;
old_assgn_pntr = old_assignment;
for (i = n + 1; i; i--) {
*old_assgn_pntr++ = *assgn_pntr++;
}
assign(A, yvecs, n, ndims, cube_or_mesh, nsets, vwsqrt, assignment,
active, mediantype, goal, vwgt_max);
x2y(yvecs, ndims, n, vwsqrt);
/* count differences in assignment */
assigndiff = 0;
assgn_pntr = assignment;
old_assgn_pntr = old_assignment;
for (i = n + 1; i; i--) {
if (*old_assgn_pntr++ != *assgn_pntr++)
assigndiff++;
}
assigndiff = min(assigndiff, n - assigndiff);
if (assigndiff <= assigntol)
converged = TRUE;
}
}
if (DEBUG_EVECS > 1) {
printf(" %2d", rqisteps);
doubleout(shift, 1);
doubleout(res, 1);
printf(" %3ld", itn);
printf(" %ld", istop);
printf(" %g", factor);
if (RQI_CONVERGENCE_MODE == 1)
printf(" %d\n", assigndiff);
else
printf("\n");
}
}
*evalest = shift;
if (WARNING_EVECS > 0 && warning) {
strout("WARNING: Residual convergence not monotonic; RQI may have misconverged.\n");
}
if (DEBUG_EVECS > 0) {
printf("Eval ");
doubleout(*evalest, 1);
printf(" RQI steps %d, Symmlq iterations %d.\n\n", rqisteps, symmlqitns);
}
if (RQI_CONVERGENCE_MODE == 1) {
sfree(old_assignment);
}
}
void
lanczos_FO (
struct vtx_data **A, /* graph data structure */
int n, /* number of rows/colums in matrix */
int d, /* problem dimension = # evecs to find */
double **y, /* columns of y are eigenvectors of A */
double *lambda, /* ritz approximation to eigenvals of A */
double *bound, /* on ritz pair approximations to eig pairs of A */
double eigtol, /* tolerance on eigenvectors */
double *vwsqrt, /* square root of vertex weights */
double maxdeg, /* maximum degree of graph */
int version /* 1 = standard mode, 2 = inverse operator mode */
)
{
extern FILE *Output_File; /* output file or NULL */
extern int DEBUG_EVECS; /* print debugging output? */
extern int DEBUG_TRACE; /* trace main execution path */
extern int WARNING_EVECS; /* print warning messages? */
extern int LANCZOS_MAXITNS; /* maximum Lanczos iterations allowed */
extern double BISECTION_SAFETY; /* safety factor for bisection algorithm */
extern double SRESTOL; /* resid tol for T evec comp */
extern double DOUBLE_MAX; /* Warning on inaccurate computation of evec of T */
extern double splarax_time; /* time matvecs */
extern double orthog_time; /* time orthogonalization work */
extern double tevec_time; /* time tridiagonal eigvec work */
extern double evec_time; /* time to generate eigenvectors */
extern double ql_time; /* time tridiagonal eigval work */
extern double blas_time; /* time for blas (not assembly coded) */
extern double init_time; /* time for allocating memory, etc. */
extern double scan_time; /* time for scanning bounds list */
extern double debug_time; /* time for debug computations and output */
int i, j; /* indicies */
int maxj; /* maximum number of Lanczos iterations */
double *u, *r; /* Lanczos vectors */
double *Aq; /* sparse matrix-vector product vector */
double *alpha, *beta; /* the Lanczos scalars from each step */
double *ritz; /* copy of alpha for tqli */
double *workj; /* work vector (eg. for tqli) */
double *workn; /* work vector (eg. for checkeig) */
double *s; /* eigenvector of T */
double **q; /* columns of q = Lanczos basis vectors */
double *bj; /* beta(j)*(last element of evecs of T) */
double bis_safety; /* real safety factor for bisection algorithm */
double Sres; /* how well Tevec calculated eigvecs */
double Sres_max; /* Maximum value of Sres */
int inc_bis_safety; /* need to increase bisection safety */
double *Ares; /* how well Lanczos calculated each eigpair */
double *inv_lambda; /* eigenvalues of inverse operator */
int *index; /* the Ritz index of an eigenpair */
struct orthlink *orthlist = NULL; /* vectors to orthogonalize against in Lanczos */
struct orthlink *orthlist2 = NULL; /* vectors to orthogonalize against in Symmlq */
struct orthlink *temp; /* for expanding orthogonalization list */
double *ritzvec=NULL; /* ritz vector for current iteration */
double *zeros=NULL; /* vector of all zeros */
double *ones=NULL; /* vector of all ones */
struct scanlink *scanlist; /* list of fields for min ritz vals */
struct scanlink *curlnk; /* for traversing the scanlist */
double bji_tol; /* tol on bji estimate of A e-residual */
int converged; /* has the iteration converged? */
double time; /* current clock time */
double shift, rtol; /* symmlq input */
long precon, goodb, nout; /* symmlq input */
long checka, intlim; /* symmlq input */
double anorm, acond; /* symmlq output */
double rnorm, ynorm; /* symmlq output */
long istop, itn; /* symmlq output */
double macheps; /* machine precision calculated by symmlq */
double normxlim; /* a stopping criteria for symmlq */
long itnmin; /* enforce minimum number of iterations */
int symmlqitns; /* # symmlq itns */
double *wv1=NULL, *wv2=NULL, *wv3=NULL; /* Symmlq work space */
double *wv4=NULL, *wv5=NULL, *wv6=NULL; /* Symmlq work space */
long long_n; /* long int copy of n for symmlq */
int ritzval_flag = 0; /* status flag for ql() */
double Anorm; /* Norm estimate of the Laplacian matrix */
int left, right; /* ranges on the search for ritzvals */
int memory_ok; /* TRUE as long as don't run out of memory */
double *mkvec(); /* allocates space for a vector */
double *mkvec_ret(); /* mkvec() which returns error code */
double dot(); /* standard dot product routine */
struct orthlink *makeorthlnk(); /* make space for entry in orthog. set */
double ch_norm(); /* vector norm */
double Tevec(); /* calc evec of T by linear recurrence */
struct scanlink *mkscanlist(); /* make scan list for min ritz vecs */
double lanc_seconds(); /* current clock timer */
int symmlq_(), get_ritzvals();
void setvec(), vecscale(), update(), vecran(), strout();
void splarax(), scanmin(), scanmax(), frvec(), orthogonalize();
void orthog1(), orthogvec(), bail(), warnings(), mkeigvecs();
if (DEBUG_TRACE > 0) {
printf("<Entering lanczos_FO>\n");
}
if (DEBUG_EVECS > 0) {
if (version == 1) {
printf("Full orthogonalization Lanczos, matrix size = %d\n", n);
}
else {
printf("Full orthogonalization Lanczos, inverted operator, matrix size = %d\n", n);
}
}
/* Initialize time. */
time = lanc_seconds();
if (n < d + 1) {
bail("ERROR: System too small for number of eigenvalues requested.",1);
/* d+1 since don't use zero eigenvalue pair */
}
/* Allocate Lanczos space. */
maxj = LANCZOS_MAXITNS;
u = mkvec(1, n);
r = mkvec(1, n);
Aq = mkvec(1, n);
ritzvec = mkvec(1, n);
zeros = mkvec(1, n);
setvec(zeros, 1, n, 0.0);
workn = mkvec(1, n);
Ares = mkvec(1, d);
inv_lambda = mkvec(1, d);
index = smalloc((d + 1) * sizeof(int));
alpha = mkvec(1, maxj);
beta = mkvec(1, maxj + 1);
ritz = mkvec(1, maxj);
s = mkvec(1, maxj);
bj = mkvec(1, maxj);
workj = mkvec(1, maxj + 1);
q = smalloc((maxj + 1) * sizeof(double *));
scanlist = mkscanlist(d);
if (version == 2) {
/* Allocate Symmlq space all in one chunk. */
wv1 = smalloc(6 * (n + 1) * sizeof(double));
wv2 = &wv1[(n + 1)];
wv3 = &wv1[2 * (n + 1)];
wv4 = &wv1[3 * (n + 1)];
wv5 = &wv1[4 * (n + 1)];
wv6 = &wv1[5 * (n + 1)];
/* Set invariant symmlq parameters */
precon = FALSE; /* FALSE until we figure out a good way */
goodb = FALSE; /* should be FALSE for this application */
checka = FALSE; /* if don't know by now, too bad */
intlim = n; /* set to enforce a maximum number of Symmlq itns */
itnmin = 0; /* set to enforce a minimum number of Symmlq itns */
shift = 0.0; /* since just solving rather than doing RQI */
symmlqitns = 0; /* total number of Symmlq iterations */
nout = 0; /* Effectively disabled - see notes in symmlq.f */
rtol = 1.0e-5; /* requested residual tolerance */
normxlim = DOUBLE_MAX; /* Effectively disables ||x|| termination criterion */
long_n = n; /* copy to long for linting */
}
/* Initialize. */
vecran(r, 1, n);
if (vwsqrt == NULL) {
/* whack one's direction from initial vector */
orthog1(r, 1, n);
/* list the ones direction for later use in Symmlq */
if (version == 2) {
orthlist2 = makeorthlnk();
ones = mkvec(1, n);
setvec(ones, 1, n, 1.0);
orthlist2->vec = ones;
orthlist2->pntr = NULL;
}
}
else {
/* whack vwsqrt direction from initial vector */
orthogvec(r, 1, n, vwsqrt);
if (version == 2) {
/* list the vwsqrt direction for later use in Symmlq */
orthlist2 = makeorthlnk();
orthlist2->vec = vwsqrt;
orthlist2->pntr = NULL;
}
}
beta[1] = ch_norm(r, 1, n);
q[0] = zeros;
bji_tol = eigtol;
orthlist = NULL;
Sres_max = 0.0;
Anorm = 2 * maxdeg; /* Gershgorin estimate for ||A|| */
bis_safety = BISECTION_SAFETY;
inc_bis_safety = FALSE;
init_time += lanc_seconds() - time;
/* Main Lanczos loop. */
j = 1;
converged = FALSE;
memory_ok = TRUE;
while ((j <= maxj) && (converged == FALSE) && memory_ok) {
time = lanc_seconds();
/* Allocate next Lanczos vector. If fail, back up one step and compute approx. eigvec. */
q[j] = mkvec_ret(1, n);
if (q[j] == NULL) {
memory_ok = FALSE;
if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
strout("WARNING: Lanczos out of memory; computing best approximation available.\n");
}
if (j <= 2) {
bail("ERROR: Sorry, can't salvage Lanczos.",1);
/* ... save yourselves, men. */
}
j--;
}
vecscale(q[j], 1, n, 1.0 / beta[j], r);
blas_time += lanc_seconds() - time;
time = lanc_seconds();
if (version == 1) {
splarax(Aq, A, n, q[j], vwsqrt, workn);
}
else {
symmlq_(&long_n, &(q[j][1]), &wv1[1], &wv2[1], &wv3[1], &wv4[1], &Aq[1], &wv5[1],
&wv6[1], &checka, &goodb, &precon, &shift, &nout,
&intlim, &rtol, &istop, &itn, &anorm, &acond,
&rnorm, &ynorm, (double *) A, vwsqrt, (double *) orthlist2,
&macheps, &normxlim, &itnmin);
symmlqitns += itn;
if (DEBUG_EVECS > 2) {
printf("Symmlq report: rtol %g\n", rtol);
printf(" system norm %g, solution norm %g\n", anorm, ynorm);
printf(" system condition %g, residual %g\n", acond, rnorm);
printf(" termination condition %2ld, iterations %3ld\n", istop, itn);
}
}
splarax_time += lanc_seconds() - time;
time = lanc_seconds();
update(u, 1, n, Aq, -beta[j], q[j - 1]);
alpha[j] = dot(u, 1, n, q[j]);
update(r, 1, n, u, -alpha[j], q[j]);
blas_time += lanc_seconds() - time;
time = lanc_seconds();
if (vwsqrt == NULL) {
orthog1(r, 1, n);
}
else {
orthogvec(r, 1, n, vwsqrt);
}
orthogonalize(r, n, orthlist);
temp = orthlist;
orthlist = makeorthlnk();
orthlist->vec = q[j];
orthlist->pntr = temp;
beta[j + 1] = ch_norm(r, 1, n);
orthog_time += lanc_seconds() - time;
time = lanc_seconds();
left = j/2;
right = j - left + 1;
if (inc_bis_safety) {
bis_safety *= 10;
inc_bis_safety = FALSE;
}
ritzval_flag = get_ritzvals(alpha, beta+1, j, Anorm, workj+1,
ritz, d, left, right, eigtol, bis_safety);
/* ... have to off-set beta and workj since full orthogonalization
indexes these from 1 to maxj+1 whereas selective orthog.
indexes them from 0 to maxj */
if (ritzval_flag != 0) {
bail("ERROR: Both Sturm bisection and QL failed.",1);
/* ... give up. */
}
ql_time += lanc_seconds() - time;
/* Convergence check using Paige bji estimates. */
time = lanc_seconds();
for (i = 1; i <= j; i++) {
Sres = Tevec(alpha, beta, j, ritz[i], s);
if (Sres > Sres_max) {
Sres_max = Sres;
}
if (Sres > SRESTOL) {
inc_bis_safety = TRUE;
}
bj[i] = s[j] * beta[j + 1];
}
tevec_time += lanc_seconds() - time;
time = lanc_seconds();
if (version == 1) {
scanmin(ritz, 1, j, &scanlist);
}
else {
scanmax(ritz, 1, j, &scanlist);
}
converged = TRUE;
if (j < d)
converged = FALSE;
else {
curlnk = scanlist;
while (curlnk != NULL) {
if (bj[curlnk->indx] > bji_tol) {
converged = FALSE;
}
curlnk = curlnk->pntr;
}
}
scan_time += lanc_seconds() - time;
j++;
}
j--;
/* Collect eigenvalue and bound information. */
time = lanc_seconds();
mkeigvecs(scanlist,lambda,bound,index,bj,d,&Sres_max,alpha,beta+1,j,s,y,n,q);
evec_time += lanc_seconds() - time;
/* Analyze computation for and report additional problems */
time = lanc_seconds();
if (DEBUG_EVECS>0 && version == 2) {
printf("\nTotal Symmlq iterations %3d\n", symmlqitns);
}
if (version == 2) {
for (i = 1; i <= d; i++) {
lambda[i] = 1.0/lambda[i];
}
}
warnings(workn, A, y, n, lambda, vwsqrt, Ares, bound, index,
d, j, maxj, Sres_max, eigtol, u, Anorm, Output_File);
debug_time += lanc_seconds() - time;
/* Free any memory allocated in this routine. */
time = lanc_seconds();
frvec(u, 1);
frvec(r, 1);
frvec(Aq, 1);
frvec(ritzvec, 1);
frvec(zeros, 1);
if (vwsqrt == NULL && version == 2) {
frvec(ones, 1);
}
frvec(workn, 1);
frvec(Ares, 1);
frvec(inv_lambda, 1);
sfree(index);
frvec(alpha, 1);
frvec(beta, 1);
frvec(ritz, 1);
frvec(s, 1);
frvec(bj, 1);
frvec(workj, 1);
if (version == 2) {
frvec(wv1, 0);
}
while (scanlist != NULL) {
curlnk = scanlist->pntr;
sfree(scanlist);
scanlist = curlnk;
}
for (i = 1; i <= j; i++) {
frvec(q[i], 1);
}
while (orthlist != NULL) {
temp = orthlist->pntr;
sfree(orthlist);
orthlist = temp;
}
while (version == 2 && orthlist2 != NULL) {
temp = orthlist2->pntr;
sfree(orthlist2);
orthlist2 = temp;
}
sfree(q);
init_time += lanc_seconds() - time;
}
/* Finds needed eigenvalues of tridiagonal T using either the QL algorithm
or Sturm sequence bisection, whichever is predicted to be faster based
on a simple complexity model. If one fails (which is rare), the other
is tried. The return value is 0 if one of the routines succeeds. If they
both fail, the return value is 1, and Lanczos should compute the best
approximation it can based on previous iterations. */
int get_ritzvals(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 d, /* problem dimension = num. eigenpairs needed */
int left_goodlim, /* number of ritz pairs checked on left end */
int right_goodlim, /* number of ritz pairs checked on right end */
double eigtol, /* tolerance on eigenpair */
double bis_safety /* bisection tolerance function divisor */
)
{
extern int DEBUG_EVECS; /* debug flag for eigen computation */
extern int WARNING_EVECS; /* warning flag for eigen computation */
int nvals_left; /* numb. evals to find on left end of spectrum */
int nvals_right; /* numb. evals to find on right end of spectrum */
double bisection_tol; /* width of interval bisection should converge to */
int pred_steps; /* predicts # of required bisection steps per eval */
int tot_pred_steps; /* predicts total # of required bisection steps */
double * ritz_sav = NULL; /* copy of ritzvals for debugging */
int bisect_flag; /* return status of bisect() */
int ql_flag; /* return status of ql() */
int local_debug; /* whether to check bisection results with ql */
int bisect(); /* locates eigvals using bisection on Sturm seq. */
int ql(); /* computes eigenvalues of T using eispack algorithm */
void shell_sort(); /* sorts vector of eigenvalues */
double * mkvec(); /* to allocate a vector */
void frvec(); /* free vector */
void cpvec(); /* vector copy */
void bail(); /* our exit routine */
void strout(); /* string out to screen and output file */
/* Determine number of ritzvals to find on left and right ends */
nvals_left = max(d, left_goodlim);
nvals_right = min(j - nvals_left, right_goodlim);
/* Estimate work for bisection vs. ql assuming bisection takes 5j flops per
step, ql takes 30j^2 flops per call. (Ignore sorts, copies, addressing.) */
bisection_tol = eigtol * eigtol / bis_safety;
pred_steps = (log10(Anorm / bisection_tol) / log10(2.0)) + 1;
tot_pred_steps = (nvals_left + nvals_right) * pred_steps;
bisect_flag = ql_flag = 0;
if (5 * tot_pred_steps < 30 * j) {
if (DEBUG_EVECS > 2)
printf(" tridiagonal solver: bisection\n");
/* Set local_debug = TRUE for a table checking bisection against QL. */
local_debug = FALSE;
if (local_debug) {
ritz_sav = mkvec(1, j);
cpvec(ritz_sav, 1, j, alpha);
cpvec(workj, 0, j, beta);
ql_flag = ql(ritz_sav, workj, j);
if (ql_flag != 0) {
bail("Aborting debugging procedure in get_ritzvals().\n", 1);
}
shell_sort(j, &ritz_sav[1]);
}
bisect_flag = bisect(alpha, beta, j, Anorm, workj, ritz, nvals_left, nvals_right, bisection_tol,
ritz_sav, pred_steps + 10);
if (local_debug)
frvec(ritz_sav, 1);
}
else {
if (DEBUG_EVECS > 2)
printf(" tridiagonal solver: ql\n");
cpvec(ritz, 1, j, alpha);
cpvec(workj, 0, j, beta);
ql_flag = ql(ritz, workj, j);
shell_sort(j, &ritz[1]);
}
if (bisect_flag != 0 && ql_flag == 0) {
if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
strout("WARNING: Sturm bisection of T failed; switching to QL.\n");
}
if (DEBUG_EVECS > 1 || WARNING_EVECS > 1) {
if (bisect_flag == 1)
strout(" - failure detected in sturmcnt().\n");
if (bisect_flag == 2)
strout(" - maximum number of bisection steps reached.\n");
}
cpvec(ritz, 1, j, alpha);
cpvec(workj, 0, j, beta);
ql_flag = ql(ritz, workj, j);
shell_sort(j, &ritz[1]);
}
if (ql_flag != 0 && bisect_flag == 0) {
if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
strout("WARNING: QL failed for T; switching to Sturm bisection.\n");
}
bisect_flag = bisect(alpha, beta, j, Anorm, workj, ritz, nvals_left, nvals_right, bisection_tol,
ritz_sav, pred_steps + 3);
}
if (bisect_flag != 0 && ql_flag != 0) {
if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
return (1); /* can't recover; bail out with error code */
}
}
return (0); /* ... things seem ok. */
}
