/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* -------------------------------------------------------------------- this program tests the Graph_MPI_Bcast() method (1) process root generates a random Graph object and computes its checksum (2) process root broadcasts the Graph object to the other processors (3) each process computes the checksum of its Graph object (4) the checksums are compared on root created -- 98sep10, cca -------------------------------------------------------------------- */ { char *buffer ; double chksum, t1, t2 ; double *sums ; Drand drand ; int iproc, length, loc, msglvl, myid, nitem, nproc, nvtx, root, seed, size, type, v ; int *list ; FILE *msgFile ; Graph *graph ; /* --------------------------------------------------------------- find out the identity of this process and the number of process --------------------------------------------------------------- */ MPI_Init(&argc, &argv) ; MPI_Comm_rank(MPI_COMM_WORLD, &myid) ; MPI_Comm_size(MPI_COMM_WORLD, &nproc) ; fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ; fflush(stdout) ; if ( argc != 8 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile type nvtx nitem root seed " "\n msglvl -- message level" "\n msgFile -- message file" "\n type -- type of graph" "\n nvtx -- # of vertices" "\n nitem -- # of items used to generate graph" "\n root -- root processor for broadcast" "\n seed -- random number seed" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else { length = strlen(argv[2]) + 1 + 4 ; buffer = CVinit(length, '\0') ; sprintf(buffer, "%s.%d", argv[2], myid) ; if ( (msgFile = fopen(buffer, "w")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } CVfree(buffer) ; } type = atoi(argv[3]) ; nvtx = atoi(argv[4]) ; nitem = atoi(argv[5]) ; root = atoi(argv[6]) ; seed = atoi(argv[7]) ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n type -- %d" "\n nvtx -- %d" "\n nitem -- %d" "\n root -- %d" "\n seed -- %d" "\n", argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ; fflush(msgFile) ; /* ----------------------- set up the Graph object ----------------------- */ MARKTIME(t1) ; graph = Graph_new() ; if ( myid == root ) { InpMtx *inpmtx ; int nedges, totewght, totvwght, v ; int *adj, *vwghts ; IVL *adjIVL, *ewghtIVL ; /* ----------------------- generate a random graph ----------------------- */ inpmtx = InpMtx_new() ; InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ; Drand_setDefaultFields(&drand) ; Drand_setSeed(&drand, seed) ; Drand_setUniform(&drand, 0, nvtx) ; Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ; Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ; InpMtx_setNent(inpmtx, nitem) ; InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ; InpMtx_writeForHumanEye(inpmtx, msgFile) ; fflush(msgFile) ; } adjIVL = InpMtx_fullAdjacency(inpmtx) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n full adjacency structure") ; IVL_writeForHumanEye(adjIVL, msgFile) ; fflush(msgFile) ; } nedges = adjIVL->tsize ; if ( type == 1 || type == 3 ) { Drand_setUniform(&drand, 1, 10) ; vwghts = IVinit(nvtx, 0) ; Drand_fillIvector(&drand, nvtx, vwghts) ; totvwght = IVsum(nvtx, vwghts) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n vertex weights") ; IVfprintf(msgFile, nvtx, vwghts) ; fflush(msgFile) ; } } else { vwghts = NULL ; totvwght = nvtx ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n totvwght %d", totvwght) ; fflush(msgFile) ; } if ( type == 2 || type == 3 ) { ewghtIVL = IVL_new() ; IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ; Drand_setUniform(&drand, 1, 100) ; totewght = 0 ; for ( v = 0 ; v < nvtx ; v++ ) { IVL_listAndSize(adjIVL, v, &size, &adj) ; IVL_setList(ewghtIVL, v, size, NULL) ; IVL_listAndSize(ewghtIVL, v, &size, &adj) ; Drand_fillIvector(&drand, size, adj) ; totewght += IVsum(size, adj) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n ewghtIVL") ; IVL_writeForHumanEye(ewghtIVL, msgFile) ; fflush(msgFile) ; } } else { ewghtIVL = NULL ; totewght = nedges ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n totewght %d", totewght) ; fflush(msgFile) ; } Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght, adjIVL, vwghts, ewghtIVL) ; InpMtx_free(inpmtx) ; } MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : initialize the Graph object", t2 - t1) ; fflush(msgFile) ; if ( msglvl > 2 ) { Graph_writeForHumanEye(graph, msgFile) ; } else { Graph_writeStats(graph, msgFile) ; } fflush(msgFile) ; if ( myid == root ) { /* ---------------------------------------- compute the checksum of the Graph object ---------------------------------------- */ chksum = graph->type + graph->nvtx + graph->nvbnd + graph->nedges + graph->totvwght + graph->totewght ; for ( v = 0 ; v < nvtx ; v++ ) { IVL_listAndSize(graph->adjIVL, v, &size, &list) ; chksum += 1 + v + size + IVsum(size, list) ; } if ( graph->vwghts != NULL ) { chksum += IVsum(nvtx, graph->vwghts) ; } if ( graph->ewghtIVL != NULL ) { for ( v = 0 ; v < nvtx ; v++ ) { IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ; chksum += 1 + v + size + IVsum(size, list) ; } } fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ; fflush(msgFile) ; } /* -------------------------- broadcast the Graph object -------------------------- */ MARKTIME(t1) ; graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ; if ( msglvl > 2 ) { Graph_writeForHumanEye(graph, msgFile) ; } else { Graph_writeStats(graph, msgFile) ; } /* ---------------------------------------- compute the checksum of the Graph object ---------------------------------------- */ chksum = graph->type + graph->nvtx + graph->nvbnd + graph->nedges + graph->totvwght + graph->totewght ; for ( v = 0 ; v < nvtx ; v++ ) { IVL_listAndSize(graph->adjIVL, v, &size, &list) ; chksum += 1 + v + size + IVsum(size, list) ; } if ( graph->vwghts != NULL ) { chksum += IVsum(nvtx, graph->vwghts) ; } if ( graph->ewghtIVL != NULL ) { for ( v = 0 ; v < nvtx ; v++ ) { IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ; chksum += 1 + v + size + IVsum(size, list) ; } } fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ; fflush(msgFile) ; /* --------------------------------------- gather the checksums from the processes --------------------------------------- */ sums = DVinit(nproc, 0.0) ; MPI_Gather((void *) &chksum, 1, MPI_DOUBLE, (void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ; if ( myid == 0 ) { fprintf(msgFile, "\n\n sums") ; DVfprintf(msgFile, nproc, sums) ; for ( iproc = 0 ; iproc < nproc ; iproc++ ) { sums[iproc] -= chksum ; } fprintf(msgFile, "\n\n errors") ; DVfprintf(msgFile, nproc, sums) ; fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc)); } /* ---------------- free the objects ---------------- */ DVfree(sums) ; Graph_free(graph) ; /* ------------------------ exit the MPI environment ------------------------ */ MPI_Finalize() ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(0) ; }
/* ------------------------------------------------------- purpose -- to read in a Graph object from a CHACO file input -- fn -- filename return value -- 1 if success, 0 if failure created -- 98sep20, jjs -------------------------------------------------------- */ int Graph_readFromChacoFile ( Graph *graph, char *fn ) { char *rc ; FILE *fp; int nvtx, nedges, format; char string[BUFLEN], *s1, *s2; int k, v, vsize, w, vwghts, ewghts; int *adjncy, *weights, *vwghtsINT; IVL *adjIVL, *ewghtIVL; /* --------------- check the input --------------- */ if ((graph == NULL) || (fn == NULL)) { fprintf(stderr, "\n error in Graph_readFromFile(%p,%s)" "\n bad input\n", graph, fn); return(0); } /* --------------------- clear the data fields --------------------- */ Graph_clearData(graph); /* ---------------------------------------------- open file and read in nvtx, nedges, and format ---------------------------------------------- */ if ((fp = fopen(fn, "r")) == (FILE*)NULL) { fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)" "\n unable to open file %s", graph, fn, fn); return(0); } /* ------------- skip comments ------------- */ do { rc = fgets(string, BUFLEN, fp) ; if ( rc == NULL ) { fprintf(stderr, "\n error in Graph_readFromChacoFile()" "\n error skipping comments in file %s\n", fn) ; return(0) ; } } while ( string[0] == '%'); /* ------------------------------------------------- read in # vertices, # edges and (optional) format ------------------------------------------------- */ format = 0; if (sscanf(string, "%d %d %d", &nvtx, &nedges, &format) < 2) { fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)" "\n unable to read header of file %s", graph, fn, fn); return(0); } ewghts = ((format % 10) > 0); vwghts = (((format / 10) % 10) > 0); if (format >= 100) { fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)" "\n unknown format", graph, fn); return(0); } /* ------------------------------------------------------------------ initialize vector(s) to hold adjacency and (optional) edge weights ------------------------------------------------------------------ */ adjncy = IVinit(nvtx, -1) ; if ( ewghts ) { weights = IVinit(nvtx, -1) ; } else { weights = NULL ; } /* --------------------------- initialize the Graph object --------------------------- */ nedges *= 2; nedges += nvtx; Graph_init1(graph, 2*ewghts+vwghts, nvtx, 0, nedges, IVL_CHUNKED, IVL_CHUNKED); adjIVL = graph->adjIVL; if (ewghts) { ewghtIVL = graph->ewghtIVL; weights[0] = 0; /* self loops have no weight */ } if (vwghts) vwghtsINT = graph->vwghts; /* --------------------------- read in all adjacency lists --------------------------- */ k = 0; for (v = 0; v < nvtx; v++) { /* ------------- skip comments ------------- */ do { rc = fgets(string, BUFLEN, fp); if ( rc == NULL ) { fprintf(stderr, "\n error in Graph_readFromChacoFile()" "\n error reading adjacency for vertex %d in file %s\n", v, fn) ; IVfree(adjncy) ; if ( weights != NULL ) { IVfree(weights) ; } return(0) ; } } while ( string[0] == '%'); /* ------------------------- check for buffer overflow ------------------------- */ if (strlen(string) == BUFLEN-1) { fprintf(stderr, "\n error in Graph_readFromChacoFile(%p,%s)" "\n unable to read adjacency lists of file %s (line " "buffer too small)\n", graph, fn, fn); IVfree(adjncy) ; if ( weights != NULL ) { IVfree(weights) ; } return(0); } /* ---------------------------------------------- read in (optional) vertex weight, adjacent vertices, and (optional) edge weights ---------------------------------------------- */ s1 = string; if (vwghts) vwghtsINT[v] = (int)strtol(string, &s1, 10); adjncy[0] = v; /* insert self loop needed by spooles */ if ( ewghts ) { weights[0] = 0; } vsize = 1; while ((w = (int)strtol(s1, &s2, 10)) > 0) { adjncy[vsize] = --w; /* node numbering starts with 0 */ s1 = s2; if (ewghts) { weights[vsize] = (int)strtol(s1, &s2, 10); s1 = s2; } vsize++; } /* --------------------------------- sort the lists in ascending order --------------------------------- */ if ( ewghts ) { IV2qsortUp(vsize, adjncy, weights) ; } else { IVqsortUp(vsize, adjncy) ; } /* -------------------------------- set the lists in the IVL objects -------------------------------- */ IVL_setList(adjIVL, v, vsize, adjncy); if (ewghts) IVL_setList(ewghtIVL, v, vsize, weights); k += vsize; } /* ----------------------------------- close the file and do a final check ----------------------------------- */ fclose(fp); /* ------------------------ free the working storage ------------------------ */ IVfree(adjncy) ; if ( weights != NULL ) { IVfree(weights) ; } /* ---------------- check for errors ---------------- */ if ((k != nedges) || (v != nvtx)) { fprintf(stderr, "\n error in Graph_readFromChacoFile()" "\n number of nodes/edges does not match with header of %s" "\n k %d, nedges %d, v %d, nvtx %d\n", fn, k, nedges, v, nvtx); return(0); } return(1); }
/* ------------------------------------------------------------------- make an element graph for a n1 x n2 x n3 grid with ncomp components created -- 95nov03, cca ------------------------------------------------------------------- */ EGraph * EGraph_make27P ( int n1, int n2, int n3, int ncomp ) { EGraph *egraph ; int eid, icomp, ijk, ielem, jelem, kelem, m, nelem, nvtx ; int *list ; /* --------------- check the input --------------- */ if ( n1 <= 0 || n2 <= 0 || n3 <= 0 || ncomp <= 0 ) { fprintf(stderr, "\n fatal error in EGraph_make27P(%d,%d,%d,%d)" "\n bad input\n", n1, n2, n3, ncomp) ; exit(-1) ; } #if MYDEBUG > 0 fprintf(stdout, "\n inside EGraph_make27P(%d,%d,%d,%d)", n1, n2, n3, ncomp) ; fflush(stdout) ; #endif /* ----------------- create the object ----------------- */ nelem = (n1 - 1)*(n2 - 1)*(n3 - 1) ; nvtx = n1*n2*n3*ncomp ; egraph = EGraph_new() ; if ( ncomp == 1 ) { EGraph_init(egraph, 0, nelem, nvtx, IVL_CHUNKED) ; } else { EGraph_init(egraph, 1, nelem, nvtx, IVL_CHUNKED) ; IVfill(nvtx, egraph->vwghts, ncomp) ; } /* ---------------------------- fill the adjacency structure ---------------------------- */ list = IVinit(8*ncomp, -1) ; for ( kelem = 0 ; kelem < n3 - 1 ; kelem++ ) { for ( jelem = 0 ; jelem < n2 - 1 ; jelem++ ) { for ( ielem = 0 ; ielem < n1 - 1 ; ielem++ ) { eid = ielem + jelem*(n1-1) + kelem*(n1-1)*(n2-1); m = 0 ; ijk = ncomp*(ielem + jelem*n1 + kelem*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + 1 + jelem*n1 + kelem*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + (jelem+1)*n1 + kelem*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + 1 + (jelem+1)*n1 + kelem*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + jelem*n1 + (kelem+1)*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + 1 + jelem*n1 + (kelem+1)*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + (jelem+1)*n1 + (kelem+1)*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } ijk = ncomp*(ielem + 1 + (jelem+1)*n1 + (kelem+1)*n1*n2) ; for ( icomp = 0 ; icomp < ncomp ; icomp++ ) { list[m++] = ijk++ ; } IVqsortUp(m, list) ; IVL_setList(egraph->adjIVL, eid, m, list) ; } } } IVfree(list) ; return(egraph) ; }
/* ------------------------------------------------------------- purpose -- the IVL object ivl and IV object ownersIV are both found on each process. the ownersIV object is identical over all the processes, and owners[ii] tells which processes owns list ii of the ivl object. on return from this method, the ivl object is replicated over all the processes. each process sends the lists that it owns to all the other processes. created -- 98apr03, cca ------------------------------------------------------------- */ void IVL_MPI_allgather ( IVL *ivl, IV *ownersIV, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) { int count, destination, ii, ilist, incount, jlist, jproc, left, maxcount, myid, nlist, nmylists, notherlists, nowners, nproc, offset, outcount, right, size, source, tag ; int *counts, *inbuffer, *list, *outbuffer, *owners ; MPI_Status status ; /* --------------- check the input --------------- */ if ( ivl == NULL || ownersIV == NULL ) { fprintf(stderr, "\n fatal error in IVL_MPI_allgather()" "\n ivl = %p, ownersIV = %p\n", ivl, ownersIV) ; exit(-1) ; } /* ---------------------------------------------- get id of self, # of processes and # of fronts ---------------------------------------------- */ MPI_Comm_rank(comm, &myid) ; MPI_Comm_size(comm, &nproc) ; nlist = ivl->nlist ; IV_sizeAndEntries(ownersIV, &nowners, &owners) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n inside IVL_MPI_allgather()" "\n nproc = %d, myid = %d, nlist = %d, nowners = %d", nproc, myid, nlist, nowners) ; fflush(msgFile) ; } if ( nlist != nowners || owners == NULL ) { fprintf(stderr, "\n fatal error in IVL_MPI_allgather()" "\n nlist = %d, nowners = %d, owners = %p\n", nlist, nowners, owners) ; exit(-1) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n ivl") ; IVL_writeForHumanEye(ivl, msgFile) ; fprintf(msgFile, "\n\n ownersIV") ; IV_writeForHumanEye(ownersIV, msgFile) ; fflush(msgFile) ; } /* ----------------------------------------------- step 1 : determine the size of the message that this process will send to the others ----------------------------------------------- */ for ( ilist = 0, outcount = 1 ; ilist < nlist ; ilist++ ) { if ( owners[ilist] < 0 || owners[ilist] >= nproc ) { fprintf(stderr, "\n owners[%d] = %d", ilist, owners[ilist]) ; exit(-1) ; } if ( owners[ilist] == myid ) { outcount += 2 ; IVL_listAndSize(ivl, ilist, &size, &list) ; outcount += size ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n outcount = %d", outcount) ; fflush(msgFile) ; } /* ---------------------------------------------------- do an all-to-all gather/scatter counts[jproc] = # of int's in the message from jproc ---------------------------------------------------- */ counts = IVinit(nproc, 0) ; counts[myid] = outcount ; MPI_Allgather((void *) &counts[myid], 1, MPI_INT, (void *) counts, 1, MPI_INT, comm) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n counts") ; IVfprintf(msgFile, nproc, counts) ; fflush(msgFile) ; } /* ----------------------------- set up the in and out buffers ----------------------------- */ if ( outcount > 0 ) { outbuffer = IVinit(outcount, -1) ; for ( ilist = nmylists = 0, ii = 1 ; ilist < nlist ; ilist++ ) { if ( owners[ilist] == myid ) { nmylists++ ; IVL_listAndSize(ivl, ilist, &size, &list) ; outbuffer[ii++] = ilist ; outbuffer[ii++] = size ; if ( size > 0 ) { IVcopy(size, &outbuffer[ii], list) ; ii += size ; } } } outbuffer[0] = nmylists ; if ( ii != outcount ) { fprintf(stderr, "\n myid = %d, ii = %d, outcount = %d", myid, ii, outcount) ; fprintf(msgFile, "\n myid = %d, ii = %d, outcount = %d", myid, ii, outcount) ; exit(-1) ; } } else { outbuffer = NULL ; } maxcount = IVmax(nproc, counts, &jproc) ; if ( maxcount > 0 ) { inbuffer = IVinit(maxcount, -1) ; } else { inbuffer = NULL ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n outbuffer %p, maxcount %d, inbuffer %p", outbuffer, maxcount, inbuffer) ; fflush(msgFile) ; } /* ------------------------------------- step 2: loop over the other processes send and receive information ------------------------------------- */ for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) { right = (myid + offset) % nproc ; if ( offset <= myid ) { left = myid - offset ; } else { left = nproc + myid - offset ; } if ( outcount > 0 ) { destination = right ; stats[0]++ ; stats[2] += outcount*sizeof(int) ; } else { destination = MPI_PROC_NULL ; } incount = counts[left] ; if ( incount > 0 ) { source = left ; stats[1]++ ; stats[3] += incount*sizeof(int) ; } else { source = MPI_PROC_NULL ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n offset %d, source %d, destination %d", offset, source, destination) ; fflush(msgFile) ; } /* ----------------- do a send/receive ----------------- */ MPI_Sendrecv(outbuffer, outcount, MPI_INT, destination, tag, inbuffer, incount, MPI_INT, source, tag, comm, &status) ; if ( source != MPI_PROC_NULL ) { MPI_Get_count(&status, MPI_INT, &count) ; if ( count != incount ) { fprintf(stderr, "\n 1. fatal error in IVL_MPI_allgather()" "\n proc %d : source = %d, count = %d, incount = %d\n", myid, source, count, incount) ; exit(-1) ; } } /* ---------------------------- set the values in the vector ---------------------------- */ notherlists = inbuffer[0] ; for ( ilist = 0, ii = 1 ; ilist < notherlists ; ilist++ ) { jlist = inbuffer[ii++] ; size = inbuffer[ii++] ; if ( size > 0 ) { IVL_setList(ivl, jlist, size, &inbuffer[ii]) ; ii += size ; } } if ( ii != incount ) { fprintf(msgFile, "\n ii = %d, incount = %d", ii, incount) ; fprintf(stderr, "\n ii = %d, incount = %d", ii, incount) ; exit(-1) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n after setting values") ; IVL_writeForHumanEye(ivl, msgFile) ; fflush(msgFile) ; } } /* ------------------------ free the working storage ------------------------ */ IVfree(counts) ; if ( outbuffer != NULL ) { IVfree(outbuffer) ; } if ( inbuffer != NULL ) { IVfree(inbuffer) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n leaving IVL_MPI_gatherall()") ; fflush(msgFile) ; } return ; }
/* --------------------------------------------------------------------- purpose -- take a Graph object and a map to expand it, create and return a bigger unit weight Graph object. this is useful for expanding a compressed graph into a unit weight graph. created -- 96mar02, cca --------------------------------------------------------------------- */ Graph * Graph_expand ( Graph *g, int nvtxbig, int map[] ) { Graph *gbig ; int count, ii, nedge, nvtx, v, vbig, vsize, w ; int *head, *indices, *link, *mark, *vadj ; IVL *adjIVL, *adjbigIVL ; /* --------------- check the input --------------- */ if ( g == NULL || nvtxbig <= 0 || map == NULL ) { fprintf(stderr, "\n fatal error in Graph_expand(%p,%d,%p)" "\n bad input\n", g, nvtxbig, map) ; spoolesFatal(); } nvtx = g->nvtx ; adjIVL = g->adjIVL ; /* ---------------------------------------- set up the linked lists for the vertices ---------------------------------------- */ head = IVinit(nvtx, -1) ; link = IVinit(nvtxbig, -1) ; for ( vbig = 0 ; vbig < nvtxbig ; vbig++ ) { v = map[vbig] ; link[vbig] = head[v] ; head[v] = vbig ; } /* -------------------------------- create the expanded Graph object -------------------------------- */ gbig = Graph_new() ; Graph_init1(gbig, 0, nvtxbig, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ; adjbigIVL = gbig->adjIVL ; /* ------------------------------------------- fill the lists in the expanded Graph object ------------------------------------------- */ indices = IVinit(nvtxbig, -1) ; mark = IVinit(nvtx, -1) ; nedge = 0 ; for ( v = 0 ; v < nvtx ; v++ ) { if ( head[v] != -1 ) { /* ------------------------------ load the indices that map to v ------------------------------ */ mark[v] = v ; count = 0 ; for ( vbig = head[v] ; vbig != -1 ; vbig = link[vbig] ) { indices[count++] = vbig ; } /* --------------------------------------------------- load the indices that map to vertices adjacent to v --------------------------------------------------- */ IVL_listAndSize(adjIVL, v, &vsize, &vadj) ; for ( ii = 0 ; ii < vsize ; ii++ ) { w = vadj[ii] ; if ( w < nvtx && mark[w] != v ) { mark[w] = v ; for ( vbig = head[w] ; vbig != -1 ; vbig = link[vbig] ) { indices[count++] = vbig ; } } } /* -------------------------------------- sort the index list in ascending order -------------------------------------- */ IVqsortUp(count, indices) ; /* ------------------------------------------------------- each vertex in the big IVL object has its own list. ------------------------------------------------------- */ for ( vbig = head[v] ; vbig != -1 ; vbig = link[vbig] ) { IVL_setList(adjbigIVL, vbig, count, indices) ; nedge += count ; } } } gbig->nedges = nedge ; /* ------------------------ free the working storage ------------------------ */ IVfree(head) ; IVfree(link) ; IVfree(indices) ; IVfree(mark) ; return(gbig) ; }
/* ---------------------------------------------------------------- purpose -- if the elimination has halted before all the stages have been eliminated, then create the schur complement graph and the map from the original vertices those in the schur complement graph. schurGraph -- Graph object to contain the schur complement graph VtoPhi -- IV object to contain the map from vertices in V to schur complement vertices in Phi created -- 97feb01, cca ---------------------------------------------------------------- */ void MSMD_makeSchurComplement ( MSMD *msmd, Graph *schurGraph, IV *VtoPhiIV ) { int nedge, nPhi, nvtx, totewght, totvwght ; int *mark, *rep, *VtoPhi, *vwghts ; int count, *list ; int ierr, ii, size, *adj ; int phi, psi, tag ; IP *ip ; IVL *adjIVL ; MSMDvtx *u, *v, *vertices, *vfirst, *vlast, *w ; /* --------------- check the input --------------- */ if ( msmd == NULL || schurGraph == NULL || VtoPhiIV == NULL ) { fprintf(stderr, "\n\n fatal error in MSMD_makeSchurComplement(%p,%p,%p)" "\n bad input\n", msmd, schurGraph, VtoPhiIV) ; exit(-1) ; } vertices = msmd->vertices ; nvtx = msmd->nvtx ; /* ------------------------------------- initialize the V-to-Phi map IV object ------------------------------------- */ IV_clearData(VtoPhiIV) ; IV_setSize(VtoPhiIV, nvtx) ; IV_fill(VtoPhiIV, -2) ; VtoPhi = IV_entries(VtoPhiIV) ; /* --------------------------------------------- count the number of Schur complement vertices --------------------------------------------- */ vfirst = vertices ; vlast = vfirst + nvtx - 1 ; nPhi = 0 ; for ( v = vfirst ; v <= vlast ; v++ ) { #if MYDEBUG > 0 fprintf(stdout, "\n v->id = %d, v->status = %c", v->id, v->status) ; fflush(stdout) ; #endif switch ( v->status ) { case 'L' : case 'E' : case 'I' : break ; case 'B' : VtoPhi[v->id] = nPhi++ ; #if MYDEBUG > 0 fprintf(stdout, ", VtoPhi[%d] = %d", v->id, VtoPhi[v->id]) ; fflush(stdout) ; #endif break ; default : break ; } } #if MYDEBUG > 0 fprintf(stdout, "\n\n nPhi = %d", nPhi) ; fflush(stdout) ; #endif /* ---------------------------------------------------- get the representative vertex id for each Phi vertex ---------------------------------------------------- */ rep = IVinit(nPhi, -1) ; for ( v = vfirst ; v <= vlast ; v++ ) { if ( (phi = VtoPhi[v->id]) >= 0 ) { #if MYDEBUG > 0 fprintf(stdout, "\n rep[%d] = %d", phi, v->id) ; fflush(stdout) ; #endif rep[phi] = v->id ; } } /* ------------------------------------------ set the map for indistinguishable vertices ------------------------------------------ */ for ( v = vfirst ; v <= vlast ; v++ ) { if ( v->status == 'I' ) { w = v ; while ( w->status == 'I' ) { w = w->par ; } #if MYDEBUG > 0 fprintf(stdout, "\n v = %d, status = %c, w = %d, status = %c", v->id, v->status, w->id, w->status) ; fflush(stdout) ; #endif VtoPhi[v->id] = VtoPhi[w->id] ; } } #if MYDEBUG > 0 fprintf(stdout, "\n\n VtoPhi") ; IV_writeForHumanEye(VtoPhiIV, stdout) ; fflush(stdout) ; #endif /* --------------------------- initialize the Graph object --------------------------- */ Graph_clearData(schurGraph) ; Graph_init1(schurGraph, 1, nPhi, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ; adjIVL = schurGraph->adjIVL ; vwghts = schurGraph->vwghts ; #if MYDEBUG > 0 fprintf(stdout, "\n\n schurGraph initialized, nvtx = %d", schurGraph->nvtx) ; fflush(stdout) ; #endif /* ------------------------------- fill the vertex adjacency lists ------------------------------- */ mark = IVinit(nPhi, -1) ; list = IVinit(nPhi, -1) ; nedge = totvwght = totewght = 0 ; for ( phi = 0 ; phi < nPhi ; phi++ ) { /* ----------------------------- get the representative vertex ----------------------------- */ v = vfirst + rep[phi] ; #if MYDEBUG > 0 fprintf(stdout, "\n phi = %d, v = %d", phi, v->id) ; fflush(stdout) ; MSMDvtx_print(v, stdout) ; fflush(stdout) ; #endif count = 0 ; tag = v->id ; /* --------------------------- load self in adjacency list --------------------------- */ mark[phi] = tag ; totewght += v->wght * v->wght ; #if MYDEBUG > 0 fprintf(stdout, "\n mark[%d] = %d", phi, mark[phi]) ; fflush(stdout) ; #endif list[count++] = phi ; /* ---------------------------------------- load boundary lists of adjacent subtrees ---------------------------------------- */ for ( ip = v->subtrees ; ip != NULL ; ip = ip->next ) { u = vertices + ip->val ; size = u->nadj ; adj = u->adj ; #if MYDEBUG > 0 fprintf(stdout, "\n subtree %d :", u->id) ; IVfp80(stdout, size, adj, 15, &ierr) ; fflush(stdout) ; #endif for ( ii = 0 ; ii < size ; ii++ ) { w = vertices + adj[ii] ; #if MYDEBUG > 0 fprintf(stdout, "\n w %d, status %c, psi %d", w->id, w->status, VtoPhi[w->id]) ; fflush(stdout) ; #endif if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) { mark[psi] = tag ; #if MYDEBUG > 0 fprintf(stdout, ", mark[%d] = %d", psi, mark[psi]) ; fflush(stdout) ; #endif list[count++] = psi ; totewght += v->wght * w->wght ; } } } /* ---------------------- load adjacent vertices ---------------------- */ size = v->nadj ; adj = v->adj ; for ( ii = 0 ; ii < size ; ii++ ) { w = vertices + adj[ii] ; if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) { mark[psi] = tag ; list[count++] = psi ; totewght += v->wght * w->wght ; } } /* --------------------------------------------- sort the list and inform adjacency IVL object --------------------------------------------- */ IVqsortUp(count, list) ; IVL_setList(adjIVL, phi, count, list) ; /* -------------------------------------- set the vertex weight and increment the total vertex weight and edge count -------------------------------------- */ vwghts[phi] = v->wght ; totvwght += v->wght ; nedge += count ; } schurGraph->totvwght = totvwght ; schurGraph->nedges = nedge ; schurGraph->totewght = totewght ; /* ------------------------ free the working storage ------------------------ */ IVfree(list) ; IVfree(mark) ; IVfree(rep) ; return ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* ------------------------------------------------- this program tests the IVL_MPI_allgather() method (1) each process generates the same owners[n] map (2) each process creates an IVL object and fills its owned lists with random numbers (3) the processes gather-all's the lists of ivl created -- 98apr03, cca ------------------------------------------------- */ { char *buffer ; double chksum, globalsum, t1, t2 ; Drand drand ; int ilist, length, myid, msglvl, nlist, nproc, rc, seed, size, tag ; int *list, *owners, *vec ; int stats[4], tstats[4] ; IV *ownersIV ; IVL *ivl ; FILE *msgFile ; /* --------------------------------------------------------------- find out the identity of this process and the number of process --------------------------------------------------------------- */ MPI_Init(&argc, &argv) ; MPI_Comm_rank(MPI_COMM_WORLD, &myid) ; MPI_Comm_size(MPI_COMM_WORLD, &nproc) ; fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ; fflush(stdout) ; if ( argc != 5 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile n seed " "\n msglvl -- message level" "\n msgFile -- message file" "\n nlist -- number of lists in the IVL object" "\n seed -- random number seed" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else { length = strlen(argv[2]) + 1 + 4 ; buffer = CVinit(length, '\0') ; sprintf(buffer, "%s.%d", argv[2], myid) ; if ( (msgFile = fopen(buffer, "w")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } CVfree(buffer) ; } nlist = atoi(argv[3]) ; seed = atoi(argv[4]) ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n nlist -- %d" "\n seed -- %d" "\n", argv[0], msglvl, argv[2], nlist, seed) ; fflush(msgFile) ; /* ---------------------------- generate the ownersIV object ---------------------------- */ MARKTIME(t1) ; ownersIV = IV_new() ; IV_init(ownersIV, nlist, NULL) ; owners = IV_entries(ownersIV) ; Drand_setDefaultFields(&drand) ; Drand_setSeed(&drand, seed) ; Drand_setUniform(&drand, 0, nproc) ; Drand_fillIvector(&drand, nlist, owners) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : initialize the ownersIV object", t2 - t1) ; fflush(msgFile) ; fprintf(msgFile, "\n\n ownersIV generated") ; if ( msglvl > 2 ) { IV_writeForHumanEye(ownersIV, msgFile) ; } else { IV_writeStats(ownersIV, msgFile) ; } fflush(msgFile) ; /* -------------------------------------------- set up the IVL object and fill owned entries -------------------------------------------- */ MARKTIME(t1) ; ivl = IVL_new() ; IVL_init1(ivl, IVL_CHUNKED, nlist) ; vec = IVinit(nlist, -1) ; Drand_setSeed(&drand, seed + myid) ; Drand_setUniform(&drand, 0, nlist) ; for ( ilist = 0 ; ilist < nlist ; ilist++ ) { if ( owners[ilist] == myid ) { size = (int) Drand_value(&drand) ; Drand_fillIvector(&drand, size, vec) ; IVL_setList(ivl, ilist, size, vec) ; } } MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : initialize the IVL object", t2 - t1) ; fflush(msgFile) ; if ( msglvl > 2 ) { IVL_writeForHumanEye(ivl, msgFile) ; } else { IVL_writeStats(ivl, msgFile) ; } fflush(msgFile) ; /* -------------------------------------------- compute the local checksum of the ivl object -------------------------------------------- */ for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) { if ( owners[ilist] == myid ) { IVL_listAndSize(ivl, ilist, &size, &list) ; chksum += 1 + ilist + size + IVsum(size, list) ; } } fprintf(msgFile, "\n\n local partial chksum = %12.4e", chksum) ; fflush(msgFile) ; /* ----------------------- get the global checksum ----------------------- */ rc = MPI_Allreduce((void *) &chksum, (void *) &globalsum, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD) ; /* -------------------------------- execute the all-gather operation -------------------------------- */ tag = 47 ; IVzero(4, stats) ; IVL_MPI_allgather(ivl, ownersIV, stats, msglvl, msgFile, tag, MPI_COMM_WORLD) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n\n return from IVL_MPI_allgather()") ; fprintf(msgFile, "\n local send stats : %10d messages with %10d bytes" "\n local recv stats : %10d messages with %10d bytes", stats[0], stats[2], stats[1], stats[3]) ; fflush(msgFile) ; } MPI_Reduce((void *) stats, (void *) tstats, 4, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD) ; if ( myid == 0 ) { fprintf(msgFile, "\n total send stats : %10d messages with %10d bytes" "\n total recv stats : %10d messages with %10d bytes", tstats[0], tstats[2], tstats[1], tstats[3]) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n ivl") ; IVL_writeForHumanEye(ivl, msgFile) ; fflush(msgFile) ; } /* ----------------------------------------- compute the checksum of the entire object ----------------------------------------- */ for ( ilist = 0, chksum = 0.0 ; ilist < nlist ; ilist++ ) { IVL_listAndSize(ivl, ilist, &size, &list) ; chksum += 1 + ilist + size + IVsum(size, list) ; } fprintf(msgFile, "\n globalsum = %12.4e, chksum = %12.4e, error = %12.4e", globalsum, chksum, fabs(globalsum - chksum)) ; fflush(msgFile) ; /* ---------------- free the objects ---------------- */ IV_free(ownersIV) ; IVL_free(ivl) ; /* ------------------------ exit the MPI environment ------------------------ */ MPI_Finalize() ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(0) ; }
/* ---------------------------------------------------------------- purpose -- to create and return an IVL object that holds the submatrix nonzero pattern for the lower triangular factor. NOTE: this method supercedes calling IVL_mapEntries() on the row adjacency structure. that gave problems when pivoting forced some fronts to have no eliminated columns. in some cases, solve aggregates were expected when none were forthcoming. created -- 98aug20, cca ---------------------------------------------------------------- */ IVL * FrontMtx_makeLowerBlockIVL ( FrontMtx *frontmtx, IV *rowmapIV ) { int count, ii, J, K, nrow, nfront, nJ ; int *rowmap, *rowind, *list, *mark ; IVL *lowerblockIVL ; /* --------------- check the input --------------- */ if ( frontmtx == NULL || rowmapIV == NULL ) { fprintf(stderr, "\n fatal error in FrontMtx_makeLowerBlockIVL()" "\n bad input\n") ; exit(-1) ; } nfront = FrontMtx_nfront(frontmtx) ; rowmap = IV_entries(rowmapIV) ; /* ----------------------------- set up the working storage and initialize the IVL object ----------------------------- */ mark = IVinit(nfront, -1) ; list = IVinit(nfront, -1) ; lowerblockIVL = IVL_new() ; IVL_init1(lowerblockIVL, IVL_CHUNKED, nfront) ; /* ------------------- fill the IVL object ------------------- */ for ( J = 0 ; J < nfront ; J++ ) { if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) { FrontMtx_rowIndices(frontmtx, J, &nrow, &rowind) ; if ( nrow > 0 ) { mark[J] = J ; count = 0 ; list[count++] = J ; for ( ii = nJ ; ii < nrow ; ii++ ) { K = rowmap[rowind[ii]] ; if ( mark[K] != J ) { mark[K] = J ; list[count++] = K ; } } IVL_setList(lowerblockIVL, J, count, list) ; } } } /* ------------------------ free the working storage ------------------------ */ IVfree(mark) ; IVfree(list) ; return(lowerblockIVL) ; }
/* ------------------------------------------------------------------ this method is used during the setup for matrix-vector multiplies. each processor has computed the vertices it needs from other processors, these lists are contained in sendIVL. on return, recvIVL contains the lists of vertices this processor must send to all others. sendIVL -- on input, list[q] contains the vertices needed by this processor that are owned by q recvIVL -- on output, list[q] contains the vertices owned by this processor that are needed by q. note, if NULL on input, a new IVL object is allocated stats[] -- statistics vector stats[0] -- contains # of sends stats[1] -- contains # of receives stats[2] -- contains # of bytes sent stats[3] -- contains # of bytes received firsttag -- first tag for messages, tags in range [firsttag, firsttag+nproc-1] are used return value -- recvIVL created -- 98jul26, cca ------------------------------------------------------------------ */ IVL * IVL_MPI_alltoall ( IVL *sendIVL, IVL *recvIVL, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) { int count, destination, lasttag, left, myid, nproc, offset, q, recvcount, right, sendcount, source, tag, tagbound ; int *incounts, *outcounts, *recvvec, *sendvec ; MPI_Status status ; /* --------------- check the input --------------- */ if ( sendIVL == NULL || stats == NULL || (msglvl > 0 && msgFile == NULL) ) { fprintf(msgFile, "\n fatal error in IVL_MPI_alltoall()" "\n bad input\n") ; exit(-1) ; } /* --------------------------------------- get id of self and number of processors --------------------------------------- */ MPI_Comm_rank(comm, &myid) ; MPI_Comm_size(comm, &nproc) ; if ( sendIVL->nlist != nproc ) { fprintf(msgFile, "\n fatal error in IVL_MPI_alltoall()" "\n sendIVL: nproc = %d, nlist = %d\n", nproc, sendIVL->nlist) ; exit(-1) ; } lasttag = firsttag + nproc ; if ( lasttag > (tagbound = maxTagMPI(comm)) ) { fprintf(stderr, "\n fatal error in IVL_MPI_alltoall()" "\n lasttag = %d, tag_bound = %d", lasttag, tagbound) ; exit(-1) ; } if ( recvIVL == NULL ) { recvIVL = IVL_new() ; } else { IVL_clearData(recvIVL) ; } IVL_init1(recvIVL, IVL_CHUNKED, nproc) ; /* ------------------------------------------ outcounts[] is sendIVL->sizes[] incounts[] will be recvIVL->sizes[] fill incounts via a call to MPI_Alltoall() and then initialize the recvIVL lists. ------------------------------------------ */ outcounts = sendIVL->sizes ; incounts = IVinit(nproc, 0) ; MPI_Alltoall((void *) outcounts, 1, MPI_INT, (void *) incounts, 1, MPI_INT, comm) ; for ( q = 0 ; q < nproc ; q++ ) { IVL_setList(recvIVL, q, incounts[q], NULL) ; } IVfree(incounts) ; /* --------------------------------------------------- load list myid of sendIVL into list myid of recvIVL --------------------------------------------------- */ IVL_listAndSize(sendIVL, myid, &sendcount, &sendvec) ; IVL_setList(recvIVL, myid, sendcount, sendvec) ; /* --------------------------------------------------------- now loop over the processes, send and receive information --------------------------------------------------------- */ for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) { right = (myid + offset) % nproc ; if ( offset <= myid ) { left = myid - offset ; } else { left = nproc + myid - offset ; } IVL_listAndSize(sendIVL, right, &sendcount, &sendvec) ; IVL_listAndSize(recvIVL, left, &recvcount, &recvvec) ; if ( sendcount > 0 ) { destination = right ; stats[0]++ ; stats[2] += sendcount*sizeof(int) ; } else { destination = MPI_PROC_NULL ; } if ( recvcount > 0 ) { source = left ; stats[1]++ ; stats[3] += recvcount*sizeof(int) ; } else { source = MPI_PROC_NULL ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n offset %d, recvcount %d, source %d, sendcount %d, destination %d", offset, recvcount, source, sendcount, destination) ; fflush(msgFile) ; } /* ----------------- do a send/receive ----------------- */ MPI_Sendrecv((void *) sendvec, sendcount, MPI_INT, destination, tag, (void *) recvvec, recvcount, MPI_INT, source, tag, comm, &status) ; if ( source != MPI_PROC_NULL ) { MPI_Get_count(&status, MPI_INT, &count) ; if ( count != recvcount ) { fprintf(stderr, "\n fatal error in IVL_MPI_alltoall()" "\n proc %d : source %d, count %d, recvcount %d\n", myid, source, count, recvcount) ; exit(-1) ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n send/recv completed") ; fflush(msgFile) ; } } return(recvIVL) ; }
/* ------------------------------------------------------------------- purpose -- take an adjacency structure in the (offsets[neqns+1], adjncy[*]) form and load the Graph object g -- pointer to Graph object, must be initialized with nvtx = neqns neqns -- # of equations offsets -- offsets vector adjncy -- big adjacency vector note, the adjacency for list v is found in adjncy[offsets[v]:offsets[v+1]-1] also note, offsets[] and adjncy[] must be zero based, if (offsets,adjncy) come from a harwell-boeing file, they use the fortran numbering, so each value must be decremented to conform with C's zero based numbering flag -- task flag flag = 0 --> just set the adjacency list for v to be that found in adjncy[offsets[v]:offsets[v+1]-1] flag = 1 --> the input adjancency is just the upper triangle (or strict upper triangle) as from a harwell-boeing file. fill the Graph object with the full adjacency structure, including (v,v) edges created -- 96mar16, cca ------------------------------------------------------------------- */ void Graph_fillFromOffsets ( Graph *g, int neqns, int offsets[], int adjncy[], int flag ) { IVL *adjIVL ; /* --------------- check the input --------------- */ if ( g == NULL || neqns <= 0 || offsets == NULL || adjncy == NULL || flag < 0 || flag > 1 ) { fprintf(stderr, "\n fatal error in Graph_fillFromOffsets(%p,%d,%p,%p,%d)" "\n bad input\n", g, neqns, offsets, adjncy, flag) ; exit(-1) ; } /* --------------------------- initialize the Graph object --------------------------- */ Graph_init1(g, 0, neqns, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ; adjIVL = g->adjIVL ; if ( flag == 0 ) { int count, ii, nedge, v, w ; int *list, *mark ; /* ---------------------------------------------- simple map, do not enforce symmetric structure ---------------------------------------------- */ list = IVinit(neqns, -1) ; mark = IVinit(neqns, -1) ; for ( v = 0, nedge = 0 ; v < neqns ; v++ ) { count = 0 ; for ( ii = offsets[v] ; ii < offsets[v+1] ; ii++ ) { w = adjncy[ii] ; if ( v == neqns ) { fprintf(stdout, "\n hey there!! (v,w) = (%d,%d)", v, w) ; } if ( 0 <= w && w < neqns && mark[w] != v ) { list[count++] = w ; mark[w] = v ; } } if ( mark[v] != v ) { list[count++] = v ; mark[v] = v ; } IVqsortUp(count, list) ; IVL_setList(adjIVL, v, count, list) ; nedge += count ; } g->totvwght = neqns ; g->totewght = g->nedges = nedge ; /* ---------------------------- now free the working storage ---------------------------- */ IVfree(list) ; IVfree(mark) ; } else { int ii, jj, u, v, vsize, w ; int *head, *link, *list, *sizes, *vadj ; int **p_adj ; /* ------------------------------------------- enforce symmetric structure and (v,v) edges make a first pass to check the input ------------------------------------------- */ fprintf(stdout, "\n offsets") ; IVfprintf(stdout, neqns+1, offsets) ; for ( v = 0 ; v < neqns ; v++ ) { fprintf(stdout, "\n v = %d", v) ; for ( ii = offsets[v] ; ii < offsets[v+1] ; ii++ ) { fprintf(stdout, "\n w = %d", adjncy[ii]) ; if ( (w = adjncy[ii]) < v || neqns <= w ) { fprintf(stderr, "\n fatal error in Graph_fillFromOffsets(%p,%d,%p,%p,%d)" "\n list %d, entry %d\n", g, neqns, offsets, adjncy, flag, v, w) ; exit(-1) ; } } } head = IVinit(neqns, -1) ; link = IVinit(neqns, -1) ; list = IVinit(neqns, -1) ; sizes = IVinit(neqns, 0) ; p_adj = PIVinit(neqns) ; for ( v = 0 ; v < neqns ; v++ ) { vsize = 0 ; /* ------------------------- add edges to vertices < v ------------------------- */ while ( (u = head[v]) != -1 ) { head[v] = link[u] ; list[vsize++] = u ; if ( --sizes[u] > 0 ) { w = *(++p_adj[u]) ; link[u] = head[w] ; head[w] = u ; } } /* ----------------- add in edge (v,v) ----------------- */ list[vsize++] = v ; jj = vsize ; /* ------------------------- add edges to vertices > v ------------------------- */ for ( ii = offsets[v] ; ii < offsets[v+1] ; ii++ ) { if ( (w = adjncy[ii]) != v ) { list[vsize++] = w ; } } /* --------------------- sort and set the list --------------------- */ IVqsortUp(vsize, list) ; IVL_setList(adjIVL, v, vsize, list) ; /* -------------------------------------------------- link v to first vertex in its lists greater than v -------------------------------------------------- */ if ( jj < vsize ) { IVL_listAndSize(adjIVL, v, &vsize, &vadj) ; w = vadj[jj] ; link[v] = head[w] ; head[w] = v ; sizes[v] = vsize - jj ; p_adj[v] = &vadj[jj] ; } g->nedges += vsize ; } g->totvwght = neqns ; g->totewght = g->nedges ; /* ---------------------------- now free the working storage ---------------------------- */ IVfree(head) ; IVfree(link) ; IVfree(list) ; IVfree(sizes) ; PIVfree(p_adj) ; } return ; }
/* -------------------------------------------------------------------- fill *pndom with ndom, the number of domains. fill *pnseg with nseg, the number of segments. domains are numbered in [0, ndom), segments in [ndom,ndom+nseg). return -- an IV object that contains the map from vertices to segments created -- 99feb29, cca -------------------------------------------------------------------- */ IV * GPart_domSegMap ( GPart *gpart, int *pndom, int *pnseg ) { FILE *msgFile ; Graph *g ; int adjdom, count, d, first, ierr, ii, jj1, jj2, last, ndom, msglvl, nextphi, nPhi, nPsi, nV, phi, phi0, phi1, phi2, phi3, psi, sigma, size, size0, size1, size2, v, vsize, w ; int *adj, *adj0, *adj1, *adj2, *compids, *dmark, *dsmap, *head, *link, *list, *offsets, *PhiToPsi, *PhiToV, *PsiToSigma, *vadj, *VtoPhi ; IV *dsmapIV ; IVL *PhiByPhi, *PhiByPowD, *PsiByPowD ; /* -------------------- set the initial time -------------------- */ icputimes = 0 ; MARKTIME(cputimes[icputimes]) ; /* --------------- check the input --------------- */ if ( gpart == NULL || (g = gpart->g) == NULL || pndom == NULL || pnseg == NULL ) { fprintf(stderr, "\n fatal error in GPart_domSegMap(%p,%p,%p)" "\n bad input\n", gpart, pndom, pnseg) ; exit(-1) ; } compids = IV_entries(&gpart->compidsIV) ; msglvl = gpart->msglvl ; msgFile = gpart->msgFile ; /* ------------------------ create the map IV object ------------------------ */ nV = g->nvtx ; dsmapIV = IV_new() ; IV_init(dsmapIV, nV, NULL) ; dsmap = IV_entries(dsmapIV) ; /* ---------------------------------- check compids[] and get the number of domains and interface vertices ---------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; ndom = nPhi = 0 ; for ( v = 0 ; v < nV ; v++ ) { if ( (d = compids[v]) < 0 ) { fprintf(stderr, "\n fatal error in GPart_domSegMap(%p,%p,%p)" "\n compids[%d] = %d\n", gpart, pndom, pnseg, v, compids[v]) ; exit(-1) ; } else if ( d == 0 ) { nPhi++ ; } else if ( ndom < d ) { ndom = d ; } } *pndom = ndom ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n Inside GPart_domSegMap") ; fprintf(msgFile, "\n %d domains, %d Phi vertices", ndom, nPhi) ; } if ( ndom == 1 ) { IVfill(nV, dsmap, 0) ; *pndom = 1 ; *pnseg = 0 ; return(dsmapIV) ; } /* -------------------------------- get the maps PhiToV : [0,nPhi) |---> [0,nV) VtoPhi : [0,nV) |---> [0,nPhi) -------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; PhiToV = IVinit(nPhi, -1) ; VtoPhi = IVinit(nV, -1) ; for ( v = 0, phi = 0 ; v < nV ; v++ ) { if ( (d = compids[v]) == 0 ) { PhiToV[phi] = v ; VtoPhi[v] = phi++ ; } } if ( phi != nPhi ) { fprintf(stderr, "\n fatal error in GPart_domSegMap(%p,%p,%p)" "\n phi = %d != %d = nPhi\n", gpart, pndom, pnseg, phi, nPhi) ; exit(-1) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n PhiToV(%d) :", nPhi) ; IVfp80(msgFile, nPhi, PhiToV, 15, &ierr) ; fflush(msgFile) ; } if ( msglvl > 3 ) { fprintf(msgFile, "\n VtoPhi(%d) :", nV) ; IVfp80(msgFile, nV, VtoPhi, 15, &ierr) ; fflush(msgFile) ; } /* --------------------------------------------------- create an IVL object, PhiByPowD, to hold lists from the interface vertices to their adjacent domains --------------------------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; dmark = IVinit(ndom+1, -1) ; if ( nPhi >= ndom ) { list = IVinit(nPhi, -1) ; } else { list = IVinit(ndom, -1) ; } PhiByPowD = IVL_new() ; IVL_init1(PhiByPowD, IVL_CHUNKED, nPhi) ; for ( phi = 0 ; phi < nPhi ; phi++ ) { v = PhiToV[phi] ; Graph_adjAndSize(g, v, &vsize, &vadj) ; /* if ( phi == 0 ) { int ierr ; fprintf(msgFile, "\n adj(%d,%d) = ", v, phi) ; IVfp80(msgFile, vsize, vadj, 15, &ierr) ; fflush(msgFile) ; } */ count = 0 ; for ( ii = 0 ; ii < vsize ; ii++ ) { if ( (w = vadj[ii]) < nV && (d = compids[w]) > 0 && dmark[d] != phi ) { dmark[d] = phi ; list[count++] = d ; } } if ( count > 0 ) { IVqsortUp(count, list) ; IVL_setList(PhiByPowD, phi, count, list) ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n PhiByPowD : interface x adjacent domains") ; IVL_writeForHumanEye(PhiByPowD, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------- create an IVL object, PhiByPhi to hold lists from the interface vertices to interface vertices. (s,t) are in the list if (s,t) is an edge in the graph and s and t do not share an adjacent domain ------------------------------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; PhiByPhi = IVL_new() ; IVL_init1(PhiByPhi, IVL_CHUNKED, nPhi) ; offsets = IVinit(nPhi, 0) ; head = IVinit(nPhi, -1) ; link = IVinit(nPhi, -1) ; for ( phi1 = 0 ; phi1 < nPhi ; phi1++ ) { count = 0 ; if ( msglvl > 2 ) { v = PhiToV[phi1] ; Graph_adjAndSize(g, v, &vsize, &vadj) ; fprintf(msgFile, "\n checking out phi = %d, v = %d", phi1, v) ; fprintf(msgFile, "\n adj(%d) : ", v) ; IVfp80(msgFile, vsize, vadj, 10, &ierr) ; } /* ------------------------------------------------------------- get (phi1, phi0) edges that were previously put into the list ------------------------------------------------------------- */ if ( msglvl > 3 ) { if ( head[phi1] == -1 ) { fprintf(msgFile, "\n no previous edges") ; } else { fprintf(msgFile, "\n previous edges :") ; } } for ( phi0 = head[phi1] ; phi0 != -1 ; phi0 = nextphi ) { if ( msglvl > 3 ) { fprintf(msgFile, " %d", phi0) ; } nextphi = link[phi0] ; list[count++] = phi0 ; IVL_listAndSize(PhiByPhi, phi0, &size0, &adj0) ; if ( (ii = ++offsets[phi0]) < size0 ) { /* ---------------------------- link phi0 into the next list ---------------------------- */ phi2 = adj0[ii] ; link[phi0] = head[phi2] ; head[phi2] = phi0 ; } } /* -------------------------- get new edges (phi1, phi2) -------------------------- */ IVL_listAndSize(PhiByPowD, phi1, &size1, &adj1) ; v = PhiToV[phi1] ; Graph_adjAndSize(g, v, &vsize, &vadj) ; for ( ii = 0 ; ii < vsize ; ii++ ) { if ( (w = vadj[ii]) < nV && compids[w] == 0 && (phi2 = VtoPhi[w]) > phi1 ) { if ( msglvl > 3 ) { fprintf(msgFile, "\n checking out phi2 = %d", phi2) ; } /* -------------------------------------------------- see if phi1 and phi2 have a common adjacent domain -------------------------------------------------- */ IVL_listAndSize(PhiByPowD, phi2, &size2, &adj2) ; adjdom = 0 ; jj1 = jj2 = 0 ; while ( jj1 < size1 && jj2 < size2 ) { if ( adj1[jj1] < adj2[jj2] ) { jj1++ ; } else if ( adj1[jj1] > adj2[jj2] ) { jj2++ ; } else { if ( msglvl > 3 ) { fprintf(msgFile, ", common adj domain %d", adj1[jj1]) ; } adjdom = 1 ; break ; } } if ( adjdom == 0 ) { if ( msglvl > 3 ) { fprintf(msgFile, ", no adjacent domain") ; } list[count++] = phi2 ; } } } if ( count > 0 ) { /* --------------------- set the list for phi1 --------------------- */ IVqsortUp(count, list) ; IVL_setList(PhiByPhi, phi1, count, list) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n edge list for %d :", phi1) ; IVfp80(msgFile, count, list, 15, &ierr) ; } for ( ii = 0, phi2 = -1 ; ii < count ; ii++ ) { if ( list[ii] > phi1 ) { offsets[phi1] = ii ; phi2 = list[ii] ; break ; } } if ( phi2 != -1 ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n linking %d into list for %d", phi1, phi2) ; } link[phi1] = head[phi2] ; head[phi2] = phi1 ; } /* phi2 = list[0] ; link[phi1] = head[phi2] ; head[phi2] = phi1 ; */ } } if ( msglvl > 2 ) { fprintf(msgFile, "\n PhiByPhi : interface x interface") ; IVL_writeForHumanEye(PhiByPhi, msgFile) ; fflush(msgFile) ; } /* -------------------- get the PhiToPsi map -------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; PhiToPsi = IVinit(nPhi, -1) ; nPsi = 0 ; for ( phi = 0 ; phi < nPhi ; phi++ ) { if ( PhiToPsi[phi] == -1 ) { /* --------------------------- phi not yet mapped to a psi --------------------------- */ first = last = 0 ; list[0] = phi ; PhiToPsi[phi] = nPsi ; while ( first <= last ) { phi2 = list[first++] ; IVL_listAndSize(PhiByPhi, phi2, &size, &adj) ; for ( ii = 0 ; ii < size ; ii++ ) { phi3 = adj[ii] ; if ( PhiToPsi[phi3] == -1 ) { PhiToPsi[phi3] = nPsi ; list[++last] = phi3 ; } } } nPsi++ ; } } if ( msglvl > 1 ) { fprintf(msgFile, "\n nPsi = %d", nPsi) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n PhiToPsi(%d) :", nPhi) ; IVfp80(msgFile, nPhi, PhiToPsi, 15, &ierr) ; fflush(msgFile) ; } /* --------------------------------- create an IVL object, Psi --> 2^D --------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; IVfill(nPsi, head, -1) ; IVfill(nPhi, link, -1) ; for ( phi = 0 ; phi < nPhi ; phi++ ) { psi = PhiToPsi[phi] ; link[phi] = head[psi] ; head[psi] = phi ; } PsiByPowD = IVL_new() ; IVL_init1(PsiByPowD, IVL_CHUNKED, nPsi) ; IVfill(ndom+1, dmark, -1) ; for ( psi = 0 ; psi < nPsi ; psi++ ) { count = 0 ; for ( phi = head[psi] ; phi != -1 ; phi = link[phi] ) { v = PhiToV[phi] ; Graph_adjAndSize(g, v, &size, &adj) ; for ( ii = 0 ; ii < size ; ii++ ) { if ( (w = adj[ii]) < nV && (d = compids[w]) > 0 && dmark[d] != psi ) { dmark[d] = psi ; list[count++] = d ; } } } if ( count > 0 ) { IVqsortUp(count, list) ; IVL_setList(PsiByPowD, psi, count, list) ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n PsiByPowD(%d) :", nPhi) ; IVL_writeForHumanEye(PsiByPowD, msgFile) ; fflush(msgFile) ; } icputimes++ ; MARKTIME(cputimes[icputimes]) ; /* ------------------------------------- now get the map Psi |---> Sigma that is the equivalence map over PhiByPowD ------------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; PsiToSigma = IVL_equivMap1(PsiByPowD) ; *pnseg = 1 + IVmax(nPsi, PsiToSigma, &ii) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n nSigma = %d", *pnseg) ; fprintf(msgFile, "\n PsiToSigma(%d) :", nPhi) ; IVfp80(msgFile, nPsi, PsiToSigma, 15, &ierr) ; fflush(msgFile) ; } /* -------------------------------------------------------------- now fill the map from the vertices to the domains and segments -------------------------------------------------------------- */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; for ( v = 0 ; v < nV ; v++ ) { if ( (d = compids[v]) > 0 ) { dsmap[v] = d - 1 ; } else { phi = VtoPhi[v] ; psi = PhiToPsi[phi] ; sigma = PsiToSigma[psi] ; dsmap[v] = ndom + sigma ; } } /* ------------------------ free the working storage ------------------------ */ icputimes++ ; MARKTIME(cputimes[icputimes]) ; IVL_free(PhiByPhi) ; IVL_free(PhiByPowD) ; IVL_free(PsiByPowD) ; IVfree(PhiToV) ; IVfree(VtoPhi) ; IVfree(dmark) ; IVfree(list) ; IVfree(PhiToPsi) ; IVfree(head) ; IVfree(link) ; IVfree(offsets) ; IVfree(PsiToSigma) ; icputimes++ ; MARKTIME(cputimes[icputimes]) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n domain/segment map timings split") ; fprintf(msgFile, "\n %9.5f : create the DSmap object" "\n %9.5f : get numbers of domain and interface vertices" "\n %9.5f : generate PhiToV and VtoPhi" "\n %9.5f : generate PhiByPowD" "\n %9.5f : generate PhiByPhi" "\n %9.5f : generate PhiToPsi" "\n %9.5f : generate PsiByPowD" "\n %9.5f : generate PsiToSigma" "\n %9.5f : generate dsmap" "\n %9.5f : free working storage" "\n %9.5f : total time", cputimes[1] - cputimes[0], cputimes[2] - cputimes[1], cputimes[3] - cputimes[2], cputimes[4] - cputimes[3], cputimes[5] - cputimes[4], cputimes[6] - cputimes[5], cputimes[7] - cputimes[6], cputimes[8] - cputimes[7], cputimes[9] - cputimes[8], cputimes[10] - cputimes[9], cputimes[11] - cputimes[0]) ; } return(dsmapIV) ; }
/* ---------------------------------- return an IVL object that contains the adjacency structure of A^TA. created -- 98jan28, cca ---------------------------------- */ IVL * InpMtx_adjForATA ( InpMtx *inpmtxA ) { InpMtx *inpmtxATA ; int firstcol, firstrow, irow, jvtx, lastcol, lastrow, loc, ncol, nent, nrow, size ; int *ind, *ivec1, *ivec2 ; IVL *adjIVL ; /* --------------- check the input --------------- */ if ( inpmtxA == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_adjForATA(%p)" "\n NULL input\n", inpmtxA) ; exit(-1) ; } /* ---------------------------------------------------------- change the coordinate type and storage mode to row vectors ---------------------------------------------------------- */ InpMtx_changeCoordType(inpmtxA, INPMTX_BY_ROWS) ; InpMtx_changeStorageMode(inpmtxA, INPMTX_BY_VECTORS) ; nent = InpMtx_nent(inpmtxA) ; ivec1 = InpMtx_ivec1(inpmtxA) ; ivec2 = InpMtx_ivec2(inpmtxA) ; firstrow = IVmin(nent, ivec1, &loc) ; lastrow = IVmax(nent, ivec1, &loc) ; firstcol = IVmin(nent, ivec2, &loc) ; lastcol = IVmax(nent, ivec2, &loc) ; if ( firstrow < 0 || firstcol < 0 ) { fprintf(stderr, "\n fatal error" "\n firstrow = %d, firstcol = %d" "\n lastrow = %d, lastcol = %d", firstrow, firstcol, lastrow, lastcol) ; exit(-1) ; } nrow = 1 + lastrow ; ncol = 1 + lastcol ; /* ----------------------------------------------------------- create the new InpMtx object to hold the structure of A^TA ----------------------------------------------------------- */ inpmtxATA = InpMtx_new() ; InpMtx_init(inpmtxATA, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, 0, 0) ; for ( irow = 0 ; irow < nrow ; irow++ ) { InpMtx_vector(inpmtxA, irow, &size, &ind) ; InpMtx_inputMatrix(inpmtxATA, size, size, 1, size, ind, ind) ; } for ( jvtx = 0 ; jvtx < nrow ; jvtx++ ) { InpMtx_inputEntry(inpmtxATA, jvtx, jvtx) ; } InpMtx_changeStorageMode(inpmtxATA, INPMTX_BY_VECTORS) ; /* ------------------- fill the IVL object ------------------- */ adjIVL = IVL_new() ; IVL_init1(adjIVL, IVL_CHUNKED, nrow) ; for ( jvtx = 0 ; jvtx < ncol ; jvtx++ ) { InpMtx_vector(inpmtxATA, jvtx, &size, &ind) ; IVL_setList(adjIVL, jvtx, size, ind) ; } /* ------------------------------ free the working InpMtx object ------------------------------ */ InpMtx_free(inpmtxATA) ; return(adjIVL) ; }
/* ----------------------------------------------------------- purpose -- return the Y by Y graph where (y1,y2) is an edge if there exists a x in X such that (x,y1) and (x,y2) are edges in the bipartite graph. created -- 95dec07, cca ----------------------------------------------------------- */ Graph * BPG_makeGraphYbyY ( BPG *bpg ) { Graph *graph, *gYbyY ; int count, ii, jj, nX, nY, x, xsize, y, ysize, z ; int *list, *mark, *xadj, *yadj ; /* --------------- check the input --------------- */ if ( bpg == NULL ) { fprintf(stdout, "\n fatal error in BPG_makeGraphXbyX(%p)" "\n bad input\n", bpg) ; spoolesFatal(); } /* ---------------------- check for quick return ---------------------- */ if ( (graph = bpg->graph) == NULL || (nY = bpg->nY) <= 0 ) { return(NULL) ; } nX = bpg->nX ; /* -------------------- initialize the graph -------------------- */ gYbyY = Graph_new() ; Graph_init1(gYbyY, graph->type, nY, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ; /* -------------- fill the graph -------------- */ mark = IVinit(nY, -1) ; list = IVinit(nY, -1) ; for ( y = 0 ; y < nY ; y++ ) { Graph_adjAndSize(graph, nX + y, &ysize, &yadj) ; mark[y] = y ; for ( ii = 0, count = 0 ; ii < ysize ; ii++ ) { x = yadj[ii] ; Graph_adjAndSize(graph, x, &xsize, &xadj) ; for ( jj = 0 ; jj < xsize ; jj++ ) { z = xadj[jj] ; if ( mark[z] != y ) { mark[z] = y ; list[count++] = z ; } } } if ( count > 0 ) { IVqsortUp(count, list) ; IVL_setList(gYbyY->adjIVL, nX + y, count, list) ; } } IVfree(list) ; IVfree(mark) ; /* --------------------------------------- set vertex weight vector if appropriate --------------------------------------- */ if ( graph->type % 2 == 1 ) { IVcopy(nY, gYbyY->vwghts, graph->vwghts + nX) ; } return(gYbyY) ; }
/* -------------------------------------------------------------------- purpose -- to setup two data structures for a QR serial or multithreaded factorization rowsIVL[J] -- list of rows of A to be assembled into front J firstnz[irow] -- column with location of leading nonzero of row in A created -- 98may29, cca -------------------------------------------------------------------- */ void FrontMtx_QR_setup ( FrontMtx *frontmtx, InpMtx *mtxA, IVL **prowsIVL, int **pfirstnz, int msglvl, FILE *msgFile ) { int count, irow, jcol, J, loc, neqns, nfront, nrowA, rowsize ; int *firstnz, *head, *link, *list, *rowind, *vtxToFront ; IVL *rowsIVL ; /* --------------- check the input --------------- */ if ( frontmtx == NULL || mtxA == NULL || prowsIVL == NULL || pfirstnz == NULL || (msglvl > 0 && msgFile == NULL) ) { fprintf(stderr, "\n fatal error in FrontMtx_QR_setup()" "\n bad input\n") ; exit(-1) ; } neqns = FrontMtx_neqns(frontmtx) ; nfront = FrontMtx_nfront(frontmtx) ; vtxToFront = ETree_vtxToFront(frontmtx->frontETree) ; /* ---------------------------------------------------------------- create the rowsIVL object, list(J) = list of rows that are assembled in front J firstnz[irowA] = first column with nonzero element in A(irowA,*) ---------------------------------------------------------------- */ InpMtx_changeCoordType(mtxA, INPMTX_BY_ROWS) ; InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; nrowA = 1 + IVmax(InpMtx_nent(mtxA), InpMtx_ivec1(mtxA), &loc) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n nrowA = %d ", nrowA) ; fflush(msgFile) ; } firstnz = IVinit(nrowA, -1) ; head = IVinit(nfront, -1) ; link = IVinit(nrowA, -1) ; for ( irow = nrowA - 1 ; irow >= 0 ; irow-- ) { InpMtx_vector(mtxA, irow, &rowsize, &rowind) ; if ( rowsize > 0 ) { firstnz[irow] = jcol = rowind[0] ; J = vtxToFront[jcol] ; link[irow] = head[J] ; head[J] = irow ; } } rowsIVL = IVL_new() ; IVL_init2(rowsIVL, IVL_CHUNKED, nfront, nrowA) ; list = IVinit(neqns, -1) ; for ( J = 0 ; J < nfront ; J++ ) { count = 0 ; for ( irow = head[J] ; irow != -1 ; irow = link[irow] ) { list[count++] = irow ; } if ( count > 0 ) { IVL_setList(rowsIVL, J, count, list) ; } } IVfree(head) ; IVfree(link) ; IVfree(list) ; /* --------------------------- set the pointers for return --------------------------- */ *prowsIVL = rowsIVL ; *pfirstnz = firstnz ; return ; }
/* ---------------------------------------------------- create a Graph object that holds the adjacency graph of the assembled elements. created -- 95nov03, cca ---------------------------------------------------- */ Graph * EGraph_mkAdjGraph ( EGraph *egraph ) { int elem, esize, i, nelem, nvtx, v, vsize, w ; int *eind, *head, *link, *marker, *offsets, *vind ; IVL *eadjIVL, *gadjIVL ; Graph *graph ; /* --------------- check the input --------------- */ if ( egraph == NULL || (eadjIVL = egraph->adjIVL) == NULL ) { fprintf(stderr, "\n fatal error in EGraph_mkAdjGraph(%p)" "\n bad input\n", egraph) ; spoolesFatal(); } nelem = egraph->nelem ; nvtx = egraph->nvtx ; /* -------------------------------- set up the linked list structure -------------------------------- */ head = IVinit(nvtx, -1) ; link = IVinit(nelem, -1) ; offsets = IVinit(nelem, 0) ; /* ----------------------------------------------------------- sort the vertices in each element list into ascending order and link them into their first vertex ----------------------------------------------------------- */ for ( elem = 0 ; elem < nelem ; elem++ ) { IVL_listAndSize(eadjIVL, elem, &esize, &eind) ; if ( esize > 0 ) { IVqsortUp(esize, eind) ; v = eind[0] ; link[elem] = head[v] ; head[v] = elem ; } } /* --------------------------- create the new Graph object --------------------------- */ graph = Graph_new() ; Graph_init1(graph, egraph->type, nvtx, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ; gadjIVL = graph->adjIVL ; /* ---------------------- loop over the vertices ---------------------- */ vind = IVinit(nvtx, -1) ; marker = IVinit(nvtx, -1) ; for ( v = 0 ; v < nvtx ; v++ ) { /* --------------------------------- loop over the supporting elements --------------------------------- */ vsize = 0 ; vind[vsize++] = v ; marker[v] = v ; while ( (elem = head[v]) != -1 ) { /* fprintf(stdout, "\n checking out element %d :", jelem) ; */ head[v] = link[elem] ; IVL_listAndSize(eadjIVL, elem, &esize, &eind) ; for ( i = 0 ; i < esize ; i++ ) { w = eind[i] ; if ( marker[w] != v ) { marker[w] = v ; vind[vsize++] = w ; } } if ( (i = ++offsets[elem]) < esize ) { w = eind[i] ; link[elem] = head[w] ; head[w] = elem ; } } IVqsortUp(vsize, vind) ; IVL_setList(gadjIVL, v, vsize, vind) ; } graph->nedges = gadjIVL->tsize ; if ( egraph->type == 0 ) { graph->totvwght = nvtx ; } else if ( egraph->type == 1 ) { /* ------------------------------ fill the vertex weights vector ------------------------------ */ IVcopy(nvtx, graph->vwghts, egraph->vwghts) ; graph->totvwght = IVsum(nvtx, graph->vwghts) ; } graph->totewght = graph->nedges ; /* ------------------------ free the working storage ------------------------ */ IVfree(head) ; IVfree(link) ; IVfree(marker) ; IVfree(vind) ; IVfree(offsets) ; return(graph) ; }