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