/*--------------------------------------------------------------------*/ 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 -- map the off diagonal blocks to processes in a domain decomposition fashion created -- 98mar28, cca ---------------------------------------------- */ void SolveMap_ddMap ( SolveMap *solvemap, int symmetryflag, IVL *upperBlockIVL, IVL *lowerBlockIVL, int nproc, IV *ownersIV, Tree *tree, int seed, int msglvl, FILE *msgFile ) { char *mark ; Drand drand ; int ii, I, J, K, loc, nadj, nblockLower, nblockUpper, nfront, proc ; int *adj, *colids, *fch, *map, *owners, *rowids, *sib ; /* --------------- check the input --------------- */ if ( solvemap == NULL || symmetryflag < 0 || upperBlockIVL == NULL || ownersIV == NULL ) { fprintf(stderr, "\n fatal error in SolveMap_ddMap(%p,%d,%p,%p,%p,%d)" "\n bad input\n", solvemap, symmetryflag, upperBlockIVL, lowerBlockIVL, ownersIV, seed) ; spoolesFatal(); } nfront = IV_size(ownersIV) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n SolveMap_ddMap(): nfront = %d, nproc = %d", nfront, nproc) ; fflush(msgFile) ; } /* ----------------------------------------------------------- count the number of upper blocks that do not include U(J,J) ----------------------------------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n upperBlockIVL = %p", upperBlockIVL) ; fflush(msgFile) ; } nblockUpper = 0 ; for ( J = 0 ; J < nfront ; J++ ) { IVL_listAndSize(upperBlockIVL, J, &nadj, &adj) ; for ( ii = 0 ; ii < nadj ; ii++ ) { if ( adj[ii] > J ) { nblockUpper++ ; } } } if ( msglvl > 2 ) { fprintf(msgFile, "\n nblockUpper = %d", nblockUpper) ; fflush(msgFile) ; } /* ----------------------------------------------------------- count the number of lower blocks that do not include L(J,J) ----------------------------------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n lowerBlockIVL = %p", lowerBlockIVL) ; fflush(msgFile) ; } nblockLower = 0 ; if ( lowerBlockIVL != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { IVL_listAndSize(lowerBlockIVL, J, &nadj, &adj) ; for ( ii = 0 ; ii < nadj ; ii++ ) { if ( adj[ii] > J ) { nblockLower++ ; } } } } if ( msglvl > 2 ) { fprintf(msgFile, "\n nblockLower = %d", nblockLower) ; fflush(msgFile) ; } /* --------------------- initialize the object --------------------- */ SolveMap_init(solvemap, symmetryflag, nfront, nproc, nblockUpper, nblockLower) ; owners = SolveMap_owners(solvemap) ; /* ---------------------- fill the owners vector ---------------------- */ IVcopy(nfront, owners, IV_entries(ownersIV)) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n owners") ; IVfprintf(msgFile, nfront, owners) ; fflush(msgFile) ; } /* ----------------------------------------------------- mark a node J in the tree as 'D' if it is in a domain (owners[J] = owners[I] for all I a descendent of J) and 'S' (for the schur complement) otherwise ----------------------------------------------------- */ mark = CVinit(nfront, 'D') ; fch = tree->fch ; sib = tree->sib ; for ( J = Tree_postOTfirst(tree) ; J != -1 ; J = Tree_postOTnext(tree, J) ) { for ( I = fch[J] ; I != -1 ; I = sib[I] ) { if ( mark[I] != 'D' || owners[I] != owners[J] ) { mark[J] = 'S' ; break ; } } } /* -------------------------------------- initialize the random number generator -------------------------------------- */ Drand_setDefaultFields(&drand) ; Drand_setUniform(&drand, 0, nproc) ; /* ------------------------------- if J is in a domain map(J,K) to owners[J] else map(J,K) to a random process ------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n\n mapping upper blocks") ; fflush(msgFile) ; } rowids = SolveMap_rowidsUpper(solvemap) ; colids = SolveMap_colidsUpper(solvemap) ; map = SolveMap_mapUpper(solvemap) ; for ( J = loc = 0 ; J < nfront ; J++ ) { IVL_listAndSize(upperBlockIVL, J, &nadj, &adj) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n J = %d", J) ; fflush(msgFile) ; } for ( ii = 0 ; ii < nadj ; ii++ ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n K = %d", adj[ii]) ; fflush(msgFile) ; } if ( (K = adj[ii]) > J ) { if ( mark[J] == 'D' ) { proc = owners[J] ; } else { proc = (int) Drand_value(&drand) ; } rowids[loc] = J ; colids[loc] = K ; map[loc] = proc ; if ( msglvl > 2 ) { fprintf(msgFile, ", map[%d] = %d", loc, map[loc]) ; fflush(msgFile) ; } loc++ ; } } } if ( symmetryflag == SPOOLES_NONSYMMETRIC ) { /* ------------------------------- if J is in a domain map(K,J) to owners[J] else map(K,J) to a random process ------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n\n mapping lower blocks") ; fflush(msgFile) ; } rowids = SolveMap_rowidsLower(solvemap) ; colids = SolveMap_colidsLower(solvemap) ; map = SolveMap_mapLower(solvemap) ; for ( J = loc = 0 ; J < nfront ; J++ ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n J = %d", J) ; fflush(msgFile) ; } IVL_listAndSize(lowerBlockIVL, J, &nadj, &adj) ; for ( ii = 0 ; ii < nadj ; ii++ ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n K = %d", adj[ii]) ; fflush(msgFile) ; } if ( (K = adj[ii]) > J ) { if ( mark[J] == 'D' ) { proc = owners[J] ; } else { proc = (int) Drand_value(&drand) ; } rowids[loc] = K ; colids[loc] = J ; map[loc] = proc ; if ( msglvl > 2 ) { fprintf(msgFile, ", map[%d] = %d", loc, map[loc]) ; fflush(msgFile) ; } loc++ ; } } } } /* ------------------------ free the working storage ------------------------ */ CVfree(mark) ; return ; }
/* -------------------------------------------------------------------- purpose -- this method is used to determine the support of this matrix for a matrix-vector multiply y[] = A * x[] when A is a symmetric matrix. supIV -- filled with row indices of y[] which will be updated and row indices of x[] which will be used. created -- 98aug01, cca -------------------------------------------------------------------- */ void InpMtx_supportSym ( InpMtx *A, IV *supIV ) { char *mark ; int chev, col, count, ii, loc, maxcol, maxrow, maxv, nent, off, row ; int *ivec1, *ivec2, *sup ; /* --------------- check the input --------------- */ if ( A == NULL || supIV == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)" "\n bad input\n", A, supIV) ; exit(-1) ; } if ( !INPMTX_IS_BY_ROWS(A) && !INPMTX_IS_BY_COLUMNS(A) && !INPMTX_IS_BY_CHEVRONS(A) ) { fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)" "\n coordinate type\n", A, supIV) ; exit(-1) ; } ivec1 = InpMtx_ivec1(A) ; ivec2 = InpMtx_ivec2(A) ; nent = A->nent ; /* ----------------------------------------------------------------- (1) determine the maximum row and column numbers in these entries (2) allocate marking vectors for rows and columns (3) fill marking vectors for rows and columns (4) fill support vectors ----------------------------------------------------------------- */ if ( INPMTX_IS_BY_ROWS(A) ) { maxrow = IVmax(nent, ivec1, &loc) ; maxcol = IVmax(nent, ivec2, &loc) ; maxv = (maxrow >= maxcol) ? maxrow : maxcol ; mark = CVinit(1+maxv, 'O') ; count = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { row = ivec1[ii] ; col = ivec2[ii] ; if ( mark[row] == 'O' ) { count++ ; } mark[row] = 'X' ; if ( mark[col] == 'O' ) { count++ ; } mark[col] = 'X' ; } } else if ( INPMTX_IS_BY_COLUMNS(A) ) { maxrow = IVmax(nent, ivec2, &loc) ; maxcol = IVmax(nent, ivec1, &loc) ; maxv = (maxrow >= maxcol) ? maxrow : maxcol ; mark = CVinit(1+maxv, 'O') ; count = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { row = ivec2[ii] ; col = ivec1[ii] ; if ( mark[row] == 'O' ) { count++ ; } mark[row] = 'X' ; if ( mark[col] == 'O' ) { count++ ; } mark[col] = 'X' ; } } else if ( INPMTX_IS_BY_CHEVRONS(A) ) { maxv = -1 ; for ( ii = 0 ; ii < nent ; ii++ ) { chev = ivec1[ii] ; off = ivec2[ii] ; if ( off >= 0 ) { row = chev ; col = chev + off ; if ( maxv < col ) { maxv = col ; } } else { col = chev ; row = chev - off ; if ( maxv < row ) { maxv = row ; } } } mark = CVinit(1+maxv, 'O') ; count = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { chev = ivec1[ii] ; off = ivec2[ii] ; if ( off >= 0 ) { row = chev ; col = chev + off ; } else { col = chev ; row = chev - off ; } if ( mark[row] == 'O' ) { count++ ; } mark[row] = 'X' ; if ( mark[col] == 'O' ) { count++ ; } mark[col] = 'X' ; } } IV_setSize(supIV, count) ; sup = IV_entries(supIV) ; for ( row = count = 0 ; row <= maxv ; row++ ) { if ( mark[row] == 'X' ) { sup[count++] = row ; } } CVfree(mark) ; return ; }
/* --------------------------------------------------------------- purpose -- fill dvec[J] with the active storage to eliminate J using the right-looking general sparse method symflag -- symmetry flag, one of SPOOLES_SYMMETRIC, SPOOLES_HERMITIAN or SPOOLES_NONSYMMETRIC created -- 98dec19, cca --------------------------------------------------------------- */ void ETree_FSstorageProfile ( ETree *etree, int symflag, IVL *symbfacIVL, double dvec[] ) { char *incore ; int ii, J, K, nDJ, nfront, nUJ, sizeJ, storage ; int *bndwghts, *indJ, *mark, *nodwghts, *stor, *vtxToFront ; Tree *tree ; /* --------------- check the input --------------- */ if ( etree == NULL || symbfacIVL == NULL || dvec == NULL ) { fprintf(stderr, "\n fatal error in ETree_FSstorageProfile(%p,%p,%p)" "\n bad input\n", etree, symbfacIVL, dvec) ; exit(-1) ; } tree = ETree_tree(etree) ; nodwghts = ETree_nodwghts(etree) ; bndwghts = ETree_bndwghts(etree) ; vtxToFront = ETree_vtxToFront(etree) ; nfront = ETree_nfront(etree) ; incore = CVinit(nfront, 'F') ; stor = IVinit(nfront, 0) ; mark = IVinit(nfront, -1) ; /* -------------------------------------------- compute the storage for each front's chevron -------------------------------------------- */ if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) { for ( J = 0 ; J < nfront ; J++ ) { nDJ = nodwghts[J] ; nUJ = bndwghts[J] ; stor[J] = (nDJ*(nDJ+1))/2 + nDJ*nUJ ; } } else { for ( J = 0 ; J < nfront ; J++ ) { nDJ = nodwghts[J] ; nUJ = bndwghts[J] ; stor[J] = nDJ*nDJ + 2*nDJ*nUJ ; } } /* --------------------------------------------- loop over the nodes in a post-order traversal --------------------------------------------- */ storage = 0 ; for ( J = Tree_postOTfirst(tree) ; J != -1 ; J = Tree_postOTnext(tree, J) ) { if ( incore[J] == 'F' ) { storage += stor[J] ; incore[J] = 'T' ; } IVL_listAndSize(symbfacIVL, J, &sizeJ, &indJ) ; mark[J] = J ; for ( ii = 0 ; ii < sizeJ ; ii++ ) { K = vtxToFront[indJ[ii]] ; if ( mark[K] != J ) { mark[K] = J ; if ( incore[K] == 'F' ) { storage += stor[K] ; incore[K] = 'T' ; } } } dvec[J] = storage ; storage -= stor[J] ; } IVfree(mark) ; IVfree(stor) ; CVfree(incore) ; 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 -- this method is used to determine the support of this matrix for a matrix-vector multiply y[] = A * x[] when A is a nonsymmetric matrix. rowsupIV -- filled with row indices of y[] which will be updated. colsupIV -- filled with row indices of x[] which will be used. created -- 98aug01, cca -------------------------------------------------------------------- */ void InpMtx_supportNonsymT ( InpMtx *A, IV *rowsupIV, IV *colsupIV ) { char *colmark, *rowmark ; int chev, col, colcount, ii, loc, maxcol, maxrow, nent, off, row, rowcount ; int *colsup, *ivec1, *ivec2, *rowsup ; /* --------------- check the input --------------- */ if ( A == NULL || rowsupIV == NULL || colsupIV == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)" "\n bad input\n", A, rowsupIV, colsupIV) ; spoolesFatal(); } if ( !INPMTX_IS_BY_ROWS(A) && !INPMTX_IS_BY_COLUMNS(A) && !INPMTX_IS_BY_CHEVRONS(A) ) { fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)" "\n coordinate type\n", A, rowsupIV, colsupIV) ; spoolesFatal(); } ivec1 = InpMtx_ivec1(A) ; ivec2 = InpMtx_ivec2(A) ; nent = A->nent ; /* ----------------------------------------------------------------- (1) determine the maximum row and column numbers in these entries (2) allocate marking vectors for rows and columns (3) fill marking vectors for rows and columns (4) fill support vectors ----------------------------------------------------------------- */ if ( INPMTX_IS_BY_ROWS(A) ) { maxrow = IVmax(nent, ivec1, &loc) ; maxcol = IVmax(nent, ivec2, &loc) ; rowmark = CVinit(1+maxcol, 'O') ; colmark = CVinit(1+maxrow, 'O') ; rowcount = colcount = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { row = ivec1[ii] ; col = ivec2[ii] ; if ( colmark[row] == 'O' ) { colcount++ ; } colmark[row] = 'X' ; if ( rowmark[col] == 'O' ) { rowcount++ ; } rowmark[col] = 'X' ; } } else if ( INPMTX_IS_BY_COLUMNS(A) ) { maxrow = IVmax(nent, ivec2, &loc) ; maxcol = IVmax(nent, ivec1, &loc) ; rowmark = CVinit(1+maxcol, 'O') ; colmark = CVinit(1+maxrow, 'O') ; rowcount = colcount = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { row = ivec2[ii] ; col = ivec1[ii] ; if ( colmark[row] == 'O' ) { colcount++ ; } colmark[row] = 'X' ; if ( rowmark[col] == 'O' ) { rowcount++ ; } rowmark[col] = 'X' ; } } else if ( INPMTX_IS_BY_CHEVRONS(A) ) { maxrow = maxcol = -1 ; for ( ii = 0 ; ii < nent ; ii++ ) { chev = ivec1[ii] ; off = ivec2[ii] ; if ( off >= 0 ) { row = chev ; col = chev + off ; } else { col = chev ; row = chev - off ; } if ( maxrow < row ) { maxrow = row ; } if ( maxcol < col ) { maxcol = col ; } } rowmark = CVinit(1+maxcol, 'O') ; colmark = CVinit(1+maxrow, 'O') ; rowcount = colcount = 0 ; for ( ii = 0 ; ii < nent ; ii++ ) { chev = ivec1[ii] ; off = ivec2[ii] ; if ( off >= 0 ) { row = chev ; col = chev + off ; } else { col = chev ; row = chev - off ; } if ( colmark[row] == 'O' ) { colcount++ ; } colmark[row] = 'X' ; if ( rowmark[col] == 'O' ) { rowcount++ ; } rowmark[col] = 'X' ; } } IV_setSize(rowsupIV, rowcount) ; rowsup = IV_entries(rowsupIV) ; for ( col = rowcount = 0 ; col <= maxcol ; col++ ) { if ( rowmark[col] == 'X' ) { rowsup[rowcount++] = col ; } } IV_setSize(colsupIV, colcount) ; colsup = IV_entries(colsupIV) ; for ( row = colcount = 0 ; row <= maxrow ; row++ ) { if ( colmark[row] == 'X' ) { colsup[colcount++] = row ; } } CVfree(colmark) ; CVfree(rowmark) ; return ; }
/* ---------------------------------------------------- purpose -- worker method to factor the matrix created -- 98may29, cca ---------------------------------------------------- */ static void * FrontMtx_QR_workerFactor ( void *arg ) { char *status ; ChvList *updlist ; ChvManager *chvmanager ; double facops, t0, t1 ; double *cpus ; DV workDV ; FILE *msgFile ; FrontMtx *frontmtx ; Ideq *dequeue ; InpMtx *mtxA ; int J, K, myid, neqns, nfront, msglvl ; int *colmap, *firstnz, *nactiveChild, *owners, *par ; IVL *rowsIVL ; QR_factorData *data ; MARKTIME(t0) ; data = (QR_factorData *) arg ; mtxA = data->mtxA ; rowsIVL = data->rowsIVL ; firstnz = data->firstnz ; IV_sizeAndEntries(data->ownersIV, &nfront, &owners) ; frontmtx = data->frontmtx ; chvmanager = data->chvmanager ; updlist = data->updlist ; myid = data->myid ; cpus = data->cpus ; msglvl = data->msglvl ; msgFile = data->msgFile ; par = frontmtx->tree->par ; neqns = FrontMtx_neqns(frontmtx) ; /* -------------------------------------------------------- status[J] = 'F' --> J finished = 'W' --> J waiting to be finished create the Ideq object to handle the bottom-up traversal nactiveChild[K] = # of unfinished children of K, when zero, K can be placed on the dequeue -------------------------------------------------------- */ status = CVinit(nfront, 'F') ; dequeue = FrontMtx_setUpDequeue(frontmtx, owners, myid, status, NULL, 'W', 'F', msglvl, msgFile) ; FrontMtx_loadActiveLeaves(frontmtx, status, 'W', dequeue) ; nactiveChild = FrontMtx_nactiveChild(frontmtx, status, myid) ; colmap = IVinit(neqns, -1) ; DV_setDefaultFields(&workDV) ; facops = 0.0 ; if ( msglvl > 3 ) { fprintf(msgFile, "\n owners") ; IVfprintf(msgFile, nfront, owners) ; fprintf(msgFile, "\n Ideq") ; Ideq_writeForHumanEye(dequeue, msgFile) ; fflush(msgFile) ; } MARKTIME(t1) ; cpus[0] += t1 - t0 ; /* --------------------------- loop while a path is active --------------------------- */ while ( (J = Ideq_removeFromHead(dequeue)) != -1 ) { if ( msglvl > 1 ) { fprintf(msgFile, "\n\n ### checking out front %d, owner %d", J, owners[J]) ; } if ( owners[J] == myid ) { /* -------------------------------- front J is ready to be processed -------------------------------- */ FrontMtx_QR_factorVisit(frontmtx, J, mtxA, rowsIVL, firstnz, updlist, chvmanager, status, colmap, &workDV, cpus, &facops, msglvl, msgFile) ; if ( status[J] == 'F' ) { /* ------------------------------------------ front J is finished, put parent on dequeue if it exists or all children are finished ------------------------------------------ */ if ( (K = par[J]) != -1 && --nactiveChild[K] == 0 ) { Ideq_insertAtHead(dequeue, K) ; } } else { /* ----------------------------------------------- front J is not complete, put on tail of dequeue ----------------------------------------------- */ Ideq_insertAtTail(dequeue, J) ; } } else { /* ------------------------------------------- front J is not owned, put parent on dequeue if it exists and all children are finished ------------------------------------------- */ if ( (K = par[J]) != -1 && --nactiveChild[K] == 0 ) { Ideq_insertAtHead(dequeue, K) ; } } } data->facops = facops ; /* ------------------------ free the working storage ------------------------ */ CVfree(status) ; Ideq_free(dequeue) ; IVfree(nactiveChild) ; IVfree(colmap) ; DV_clearData(&workDV) ; MARKTIME(t1) ; cpus[6] = t1 - t0 ; cpus[5] = t1 - t0 - cpus[0] - cpus[1] - cpus[2] - cpus[3] - cpus[4] ; return(NULL) ; }