SpoolesSolver :: ~SpoolesSolver() { if ( msgFileCloseFlag ) { fclose(msgFile); } if ( frontmtx ) { FrontMtx_free(frontmtx); } if ( newToOldIV ) { IV_free(newToOldIV); } if ( oldToNewIV ) { IV_free(oldToNewIV); } if ( frontETree ) { ETree_free(frontETree); } if ( symbfacIVL ) { IVL_free(symbfacIVL); } if ( mtxmanager ) { SubMtxManager_free(mtxmanager); } if ( graph ) { Graph_free(graph); } }
PetscErrorCode MatDestroy_MPISBAIJSpooles(Mat A) { Mat_Spooles *lu = (Mat_Spooles*)A->spptr; PetscErrorCode ierr; PetscFunctionBegin; if (lu->CleanUpSpooles) { FrontMtx_free(lu->frontmtx); IV_free(lu->newToOldIV); IV_free(lu->oldToNewIV); IV_free(lu->vtxmapIV); InpMtx_free(lu->mtxA); ETree_free(lu->frontETree); IVL_free(lu->symbfacIVL); SubMtxManager_free(lu->mtxmanager); DenseMtx_free(lu->mtxX); DenseMtx_free(lu->mtxY); ierr = MPI_Comm_free(&(lu->comm_spooles));CHKERRQ(ierr); if ( lu->scat ){ ierr = VecDestroy(lu->vec_spooles);CHKERRQ(ierr); ierr = ISDestroy(lu->iden);CHKERRQ(ierr); ierr = ISDestroy(lu->is_petsc);CHKERRQ(ierr); ierr = VecScatterDestroy(lu->scat);CHKERRQ(ierr); } } ierr = MatDestroy_MPISBAIJ(A);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* -------------------------------- purpose -- clear the data fields created -- 95nov15, cca -------------------------------- */ void ETree_clearData ( ETree *etree ) { #if MYTRACE > 0 fprintf(stdout, "\n just inside ETree_clearData(%)", etree) ; fflush(stdout) ; #endif if ( etree == NULL ) { fprintf(stderr, "\n fatal error in ETree_clearData(%p)" "\n etree is NULL\n", etree) ; exit(-1) ; } if ( etree->tree != NULL ) { Tree_free(etree->tree) ; } if ( etree->nodwghtsIV != NULL ) { IV_free(etree->nodwghtsIV) ; } if ( etree->bndwghtsIV != NULL ) { IV_free(etree->bndwghtsIV) ; } if ( etree->vtxToFrontIV != NULL ) { IV_free(etree->vtxToFrontIV) ; } ETree_setDefaultFields(etree) ; #if MYTRACE > 0 fprintf(stdout, "\n leaving ETree_clearData(%)", etree) ; fflush(stdout) ; #endif return ; }
/* ----------------------- clear the data fields return value --- 1 -- normal return -1 -- bridge is NULL created -- 98sep18, cca ----------------------- */ int Bridge_clearData ( Bridge *bridge ) { if ( bridge == NULL ) { fprintf(stderr, "\n fatal error in Bridge_clearData(%p)" "\n bad input\n", bridge) ; return(-1) ; } if ( bridge->frontmtx != NULL ) { FrontMtx_free(bridge->frontmtx) ; } if ( bridge->frontETree != NULL ) { ETree_free(bridge->frontETree) ; } if ( bridge->symbfacIVL != NULL ) { IVL_free(bridge->symbfacIVL) ; } if ( bridge->mtxmanager != NULL ) { SubMtxManager_free(bridge->mtxmanager) ; } if ( bridge->oldToNewIV != NULL ) { IV_free(bridge->oldToNewIV) ; } if ( bridge->newToOldIV != NULL ) { IV_free(bridge->newToOldIV) ; } Bridge_setDefaultFields(bridge) ; return(1) ; }
void spooles_cleanup(void *ptr) { struct factorinfo *pfi_ = ptr; FrontMtx_free(pfi_->frontmtx); IV_free(pfi_->newToOldIV); IV_free(pfi_->oldToNewIV); SubMtxManager_free(pfi_->mtxmanager); if (pfi_->solvemap) SolveMap_free(pfi_->solvemap); ETree_free(pfi_->frontETree); fclose(msgFile); free(ptr); }
/* ------------------------------------------------------ transform an ETree object by (1) merging small fronts into larger fronts using the ETree_mergeFrontsOne() method (2) merging small fronts into larger fronts using the ETree_mergeFrontsAll() method (3) split a large front into a chain of smaller fronts using the ETree_splitFronts() method created -- 96jun27, cca ------------------------------------------------------ */ ETree * ETree_transform2 ( ETree *etree, int vwghts[], int maxzeros, int maxfrontsize, int seed ) { ETree *etree2 ; int nfront, nvtx ; IV *nzerosIV ; /* --------------- check the input --------------- */ if ( etree == NULL || (nfront = etree->nfront) <= 0 || (nvtx = etree->nvtx) <= 0 || maxfrontsize <= 0 ) { fprintf(stderr, "\n fatal error in ETree_transform2(%p,%p,%d,%d,%d)" "\n bad input\n", etree, vwghts, maxzeros, maxfrontsize, seed) ; spoolesFatal(); } nzerosIV = IV_new(); IV_init(nzerosIV, nfront, NULL) ; IV_fill(nzerosIV, 0) ; /* -------------------------- first, merge only children -------------------------- */ etree2 = ETree_mergeFrontsOne(etree, maxzeros, nzerosIV) ; ETree_free(etree) ; etree = etree2 ; /* -------------------------- second, merge all children -------------------------- */ etree2 = ETree_mergeFrontsAll(etree, maxzeros, nzerosIV) ; ETree_free(etree) ; etree = etree2 ; /* ----------------------------------- fourth, split large interior fronts ----------------------------------- */ etree2 = ETree_splitFronts(etree, vwghts, maxfrontsize, seed) ; ETree_free(etree) ; etree = etree2 ; /* ------------------------ free the working storage ------------------------ */ IV_free(nzerosIV) ; return(etree) ; }
PetscErrorCode MatDestroy_SeqAIJSpooles(Mat A) { Mat_Spooles *lu = (Mat_Spooles*)A->spptr; PetscErrorCode ierr; PetscFunctionBegin; if (lu && lu->CleanUpSpooles) { FrontMtx_free(lu->frontmtx); IV_free(lu->newToOldIV); IV_free(lu->oldToNewIV); InpMtx_free(lu->mtxA); ETree_free(lu->frontETree); IVL_free(lu->symbfacIVL); SubMtxManager_free(lu->mtxmanager); Graph_free(lu->graph); } ierr = PetscFree(A->spptr);CHKERRQ(ierr); ierr = MatDestroy_SeqAIJ(A);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* ----------------------- clear the data fields created -- 98aug26, cca ----------------------- */ void PatchAndGoInfo_clearData ( PatchAndGoInfo *info ) { if ( info == NULL ) { fprintf(stderr, "\n fatal error in PatchAndGoInfo_clearData()" "\n bad input\n") ; spoolesFatal(); } if ( info->fudgeIV != NULL ) { IV_free(info->fudgeIV) ; } if ( info->fudgeDV != NULL ) { DV_free(info->fudgeDV) ; } PatchAndGoInfo_setDefaultFields(info) ; return ; }
/* ------------------------------------------------------------------ purpose -- to initialize the semi-implicit matrix using as input a FrontMtx and a map from fronts to domains (map[J] != 0) or the schur complement (map[J] = 0) return value -- 1 -- normal return -1 -- semimtx is NULL -2 -- frontmtx is NULL -3 -- inpmtx is NULL -4 -- frontmapIV is NULL -5 -- frontmapIV is invalid -6 -- unable to create domains' front matrix -7 -- unable to create schur complement front matrix created -- 98oct17, cca ------------------------------------------------------------------ */ int SemiImplMtx_initFromFrontMtx ( SemiImplMtx *semimtx, FrontMtx *frontmtx, InpMtx *inpmtx, IV *frontmapIV, int msglvl, FILE *msgFile ) { FrontMtx *domMtx, *schurMtx ; InpMtx *A12, *A21 ; int ii, J, ncol, nfront, nrow, rc, size ; int *cols, *frontmap, *rows ; IV *domColsIV, *domidsIV, *domRowsIV, *schurColsIV, *schuridsIV, *schurRowsIV ; /* -------------- check the data -------------- */ if ( semimtx == NULL ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n semimtx is NULL\n") ; return(-1) ; } if ( frontmtx == NULL ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n frontmtx is NULL\n") ; return(-2) ; } if ( inpmtx == NULL ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n inpmtx is NULL\n") ; return(-3) ; } if ( frontmapIV == NULL ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n frontmapIV is NULL\n") ; return(-4) ; } nfront = FrontMtx_nfront(frontmtx) ; IV_sizeAndEntries(frontmapIV, &size, &frontmap) ; if ( nfront != size ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n nfront %d, size of front map %d\n", nfront, size) ; return(-5) ; } domidsIV = IV_new() ; schuridsIV = IV_new() ; for ( J = 0 ; J < nfront ; J++ ) { if ( frontmap[J] == 0 ) { IV_push(schuridsIV, J) ; } else if ( frontmap[J] > 0 ) { IV_push(domidsIV, J) ; } else { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n frontmap[%d] = %d, invalid\n", J, frontmap[J]) ; IV_free(domidsIV) ; IV_free(schuridsIV) ; return(-5) ; } } /* ----------------------------------------------------------- clear the data for the semi-implicit matrix and set scalars ----------------------------------------------------------- */ SemiImplMtx_clearData(semimtx) ; semimtx->neqns = frontmtx->neqns ; semimtx->type = frontmtx->type ; semimtx->symmetryflag = frontmtx->symmetryflag ; /* ---------------------------------------------- get the front matrix that contains the domains ---------------------------------------------- */ if ( msglvl > 4 ) { fprintf(msgFile, "\n\n working on domain front matrix") ; fflush(msgFile) ; } domMtx = semimtx->domainMtx = FrontMtx_new() ; domRowsIV = semimtx->domRowsIV = IV_new() ; domColsIV = semimtx->domColsIV = IV_new() ; rc = FrontMtx_initFromSubmatrix(domMtx, frontmtx, domidsIV, domRowsIV, domColsIV, msglvl, msgFile) ; if ( rc != 1 ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n unable to initialize the domains' front matrix" "\n error return = %d\n", rc) ; return(-6) ; } semimtx->ndomeqns = IV_size(domRowsIV) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n---------------------------------------- ") ; fprintf(msgFile, "\n\n submatrix for domains") ; FrontMtx_writeForHumanEye(domMtx, msgFile) ; fflush(msgFile) ; } if ( msglvl > 4 ) { FrontMtx_writeForMatlab(domMtx, "L11", "D11", "U11", msgFile) ; IV_writeForMatlab(domRowsIV, "domrows", msgFile) ; IV_writeForMatlab(domColsIV, "domcols", msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------- get the front matrix that contains the schur complement ------------------------------------------------------- */ if ( msglvl > 4 ) { fprintf(msgFile, "\n\n working on domain front matrix") ; fflush(msgFile) ; } schurMtx = semimtx->schurMtx = FrontMtx_new() ; schurRowsIV = semimtx->schurRowsIV = IV_new() ; schurColsIV = semimtx->schurColsIV = IV_new() ; rc = FrontMtx_initFromSubmatrix(schurMtx, frontmtx, schuridsIV, schurRowsIV, schurColsIV, msglvl, msgFile) ; if ( rc != 1 ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n unable to initialize the schur complement front matrix" "\n error return = %d\n", rc) ; return(-6) ; } semimtx->nschureqns = IV_size(schurRowsIV) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n---------------------------------------- ") ; fprintf(msgFile, "\n\n submatrix for schur complement") ; FrontMtx_writeForHumanEye(schurMtx, msgFile) ; fflush(msgFile) ; } if ( msglvl > 4 ) { FrontMtx_writeForMatlab(schurMtx, "L22", "D22", "U22", msgFile) ; IV_writeForMatlab(schurRowsIV, "schurrows", msgFile) ; IV_writeForMatlab(schurColsIV, "schurcols", msgFile) ; fflush(msgFile) ; } /* ------------------------- get the A12 InpMtx object ------------------------- */ A12 = semimtx->A12 = InpMtx_new() ; rc = InpMtx_initFromSubmatrix(A12, inpmtx, domRowsIV, schurColsIV, semimtx->symmetryflag, msglvl, msgFile) ; if ( rc != 1 ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n unable to create A21 matrix" "\n error return = %d\n", rc) ; return(-6) ; } InpMtx_changeCoordType(A12, INPMTX_BY_ROWS) ; InpMtx_changeStorageMode(A12, INPMTX_BY_VECTORS) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n---------------------------------------- ") ; fprintf(msgFile, "\n\n domRowsIV ") ; IV_writeForHumanEye(domRowsIV, msgFile) ; fprintf(msgFile, "\n\n schurColsIV ") ; IV_writeForHumanEye(schurColsIV, msgFile) ; fprintf(msgFile, "\n\n A12 matrix") ; InpMtx_writeForHumanEye(A12, msgFile) ; fflush(msgFile) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n A12 = zeros(%d,%d) ;", IV_size(domRowsIV), IV_size(schurColsIV)) ; InpMtx_writeForMatlab(A12, "A12", msgFile) ; fflush(msgFile) ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { /* ------------------------- get the A21 InpMtx object ------------------------- */ A21 = semimtx->A21 = InpMtx_new() ; rc = InpMtx_initFromSubmatrix(A21, inpmtx, schurRowsIV, domColsIV, semimtx->symmetryflag, msglvl, msgFile) ; if ( rc != 1 ) { fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()" "\n unable to create A21 matrix" "\n error return = %d\n", rc) ; return(-6) ; } InpMtx_changeCoordType(A21, INPMTX_BY_COLUMNS) ; InpMtx_changeStorageMode(A21, INPMTX_BY_VECTORS) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n--------------------------------------- ") ; fprintf(msgFile, "\n\n schurRowsIV ") ; IV_writeForHumanEye(schurRowsIV, msgFile) ; fprintf(msgFile, "\n\n domColsIV ") ; IV_writeForHumanEye(domColsIV, msgFile) ; fprintf(msgFile, "\n\n A21 matrix") ; InpMtx_writeForHumanEye(A21, msgFile) ; fflush(msgFile) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n A21 = zeros(%d,%d) ;", IV_size(schurRowsIV), IV_size(domColsIV)) ; InpMtx_writeForMatlab(A21, "A21", msgFile) ; fflush(msgFile) ; } } /* ------------------------ free the working storage ------------------------ */ IV_free(domidsIV) ; IV_free(schuridsIV) ; return(1) ; }
/*--------------------------------------------------------------------*/ 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) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* --------------------------------------------------------------- read in a ETree object, create an IV object with the same size, mark the vertices in the top level separator(s), write the IV object to a file created -- 96may02, cca --------------------------------------------------------------- */ { char *inETreeFileName, *outIVfileName ; double t1, t2 ; int msglvl, rc, J, K, ncomp, nfront, nvtx, v ; int *bndwghts, *compids, *fch, *map, *nodwghts, *par, *sib, *vtxToFront ; IV *compidsIV, *mapIV ; ETree *etree ; FILE *msgFile ; Tree *tree ; if ( argc != 5 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile inETreeFile outIVfile" "\n msglvl -- message level" "\n msgFile -- message file" "\n inETreeFile -- input file, must be *.etreef or *.etreeb" "\n outIVfile -- output file, must be *.ivf or *.ivb" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } inETreeFileName = argv[3] ; outIVfileName = argv[4] ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n inETreeFile -- %s" "\n outIVfile -- %s" "\n", argv[0], msglvl, argv[2], inETreeFileName, outIVfileName) ; fflush(msgFile) ; /* ------------------------ read in the ETree object ------------------------ */ if ( strcmp(inETreeFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } etree = ETree_new() ; MARKTIME(t1) ; rc = ETree_readFromFile(etree, inETreeFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in etree from file %s", t2 - t1, inETreeFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)", rc, etree, inETreeFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading ETree object from file %s", inETreeFileName) ; if ( msglvl > 2 ) { ETree_writeForHumanEye(etree, msgFile) ; } else { ETree_writeStats(etree, msgFile) ; } fflush(msgFile) ; nfront = ETree_nfront(etree) ; nvtx = ETree_nvtx(etree) ; bndwghts = ETree_bndwghts(etree) ; vtxToFront = ETree_vtxToFront(etree) ; nodwghts = ETree_nodwghts(etree) ; par = ETree_par(etree) ; fch = ETree_fch(etree) ; sib = ETree_sib(etree) ; tree = ETree_tree(etree) ; /* ----------------------------------------- create the map from fronts to components, top level separator(s) are component zero ----------------------------------------- */ mapIV = IV_new() ; IV_init(mapIV, nfront, NULL) ; map = IV_entries(mapIV) ; ncomp = 0 ; for ( J = Tree_preOTfirst(tree) ; J != -1 ; J = Tree_preOTnext(tree, J) ) { if ( (K = par[J]) == -1 ) { map[J] = 0 ; } else if ( map[K] != 0 ) { map[J] = map[K] ; } else if ( J == fch[K] && sib[J] == -1 && bndwghts[J] == nodwghts[K] + bndwghts[K] ) { map[J] = 0 ; } else { map[J] = ++ncomp ; } } fprintf(msgFile, "\n\n mapIV object") ; if ( msglvl > 2 ) { IV_writeForHumanEye(mapIV, msgFile) ; } else { IV_writeStats(mapIV, msgFile) ; } /* ---------------------------------------- fill the map from vertices to components ---------------------------------------- */ compidsIV = IV_new() ; IV_init(compidsIV, nvtx, NULL) ; compids = IV_entries(compidsIV) ; for ( v = 0 ; v < nvtx ; v++ ) { compids[v] = map[vtxToFront[v]] ; } fprintf(msgFile, "\n\n compidsIV object") ; if ( msglvl > 2 ) { IV_writeForHumanEye(compidsIV, msgFile) ; } else { IV_writeStats(compidsIV, msgFile) ; } fflush(msgFile) ; /* ----------------------- write out the IV object ----------------------- */ if ( strcmp(outIVfileName, "none") != 0 ) { MARKTIME(t1) ; rc = IV_writeToFile(compidsIV, outIVfileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : write etree to file %s", t2 - t1, outIVfileName) ; } if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_writeToFile(%p,%s)", rc, compidsIV, outIVfileName) ; } /* ---------------- free the objects ---------------- */ ETree_free(etree) ; IV_free(mapIV) ; IV_free(compidsIV) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
/* -------------------------------------------------- purpose -- to solve a linear system (A - sigma*B) sol[] = rhs[] data -- pointer to bridge data object *pnrows -- # of rows in x[] and y[] *pncols -- # of columns in x[] and y[] rhs[] -- vector that holds right hand sides NOTE: the rhs[] vector is global, not a portion sol[] -- vector to hold solutions NOTE: the sol[] vector is global, not a portion note: rhs[] and sol[] can be the same array. on return, *perror holds an error code. created -- 98aug28, cca & jcp -------------------------------------------------- */ void JimSolveMPI ( int *pnrows, int *pncols, double rhs[], double sol[], void *data, int *perror ) { BridgeMPI *bridge = (BridgeMPI *) data ; DenseMtx *mtx, *newmtx ; int irow, jj, jcol, kk, myid, ncols = *pncols, neqns, nowned, tag = 0 ; int *vtxmap ; int stats[4] ; IV *mapIV ; #if MYDEBUG > 0 double t1, t2 ; count_JimSolve++ ; MARKTIME(t1) ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) JimSolve() start", count_JimSolve) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) JimSolve() start", count_JimSolve) ; fflush(bridge->msgFile) ; #endif MPI_Barrier(bridge->comm) ; /* --------------------------------------------- slide the owned rows of rhs down in the array --------------------------------------------- */ vtxmap = IV_entries(bridge->vtxmapIV) ; neqns = bridge->neqns ; myid = bridge->myid ; nowned = IV_size(bridge->myownedIV) ; for ( jcol = jj = kk = 0 ; jcol < ncols ; jcol++ ) { for ( irow = 0 ; irow < neqns ; irow++, jj++ ) { if ( vtxmap[irow] == myid ) { sol[kk++] = rhs[jj] ; } } } if ( kk != nowned * ncols ) { fprintf(stderr, "\n proc %d : kk %d, nowned %d, ncols %d", myid, kk, nowned, ncols) ; exit(-1) ; } /* ---------------------------------------- call the method that assumes local input ---------------------------------------- */ if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n calling SolveMPI()") ; fflush(bridge->msgFile) ; } SolveMPI(&nowned, pncols, sol, sol, data, perror) ; if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n return from SolveMPI()") ; fflush(bridge->msgFile) ; } /* ------------------------------------------ gather all the entries onto processor zero ------------------------------------------ */ mtx = DenseMtx_new() ; DenseMtx_init(mtx, SPOOLES_REAL, 0, 0, nowned, ncols, 1, nowned) ; DVcopy (nowned*ncols, DenseMtx_entries(mtx), sol) ; IVcopy(nowned, mtx->rowind, IV_entries(bridge->myownedIV)) ; mapIV = IV_new() ; IV_init(mapIV, neqns, NULL) ; IV_fill(mapIV, 0) ; IVfill(4, stats, 0) ; if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n calling DenseMtx_split()()") ; fflush(bridge->msgFile) ; } newmtx = DenseMtx_MPI_splitByRows(mtx, mapIV, stats, bridge->msglvl, bridge->msgFile, tag, bridge->comm) ; if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n return from DenseMtx_split()()") ; fflush(bridge->msgFile) ; } DenseMtx_free(mtx) ; mtx = newmtx ; IV_free(mapIV) ; if ( myid == 0 ) { DVcopy(neqns*ncols, sol, DenseMtx_entries(mtx)) ; } DenseMtx_free(mtx) ; /* --------------------------------------------- broadcast the entries to the other processors --------------------------------------------- */ if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n calling MPI_Bcast()()") ; fflush(bridge->msgFile) ; } MPI_Bcast((void *) sol, neqns*ncols, MPI_DOUBLE, 0, bridge->comm) ; if ( bridge->msglvl > 1 ) { fprintf(bridge->msgFile, "\n return from MPI_Bcast()()") ; fflush(bridge->msgFile) ; } MPI_Barrier(bridge->comm) ; /* ------------------------------------------------------------------ set the error. (this is simple since when the spooles codes detect a fatal error, they print out a message to stderr and exit.) ------------------------------------------------------------------ */ *perror = 0 ; #if MYDEBUG > 0 MARKTIME(t2) ; time_JimSolve += t2 - t1 ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) JimSolve() end", count_JimSolve) ; fprintf(stdout, ", %8.3f seconds, %8.3f total time", t2 - t1, time_JimSolve) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) JimSolve() end", count_JimSolve) ; fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time", t2 - t1, time_JimSolve) ; fflush(bridge->msgFile) ; #endif return ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) { /* -------------------------------------------------- QR all-in-one program (1) read in matrix entries and form InpMtx object of A and A^TA (2) form Graph object of A^TA (3) order matrix and form front tree (4) get the permutation, permute the matrix and front tree and get the symbolic factorization (5) compute the numeric factorization (6) read in right hand side entries (7) compute the solution created -- 98jun11, cca -------------------------------------------------- */ /*--------------------------------------------------------------------*/ char *matrixFileName, *rhsFileName ; ChvManager *chvmanager ; DenseMtx *mtxB, *mtxX ; double facops, imag, real, value ; double cpus[10] ; ETree *frontETree ; FILE *inputFile, *msgFile ; FrontMtx *frontmtx ; Graph *graph ; int ient, irow, jcol, jrhs, jrow, msglvl, neqns, nedges, nent, nrhs, nrow, seed, type ; InpMtx *mtxA ; IV *newToOldIV, *oldToNewIV ; IVL *adjIVL, *symbfacIVL ; SubMtxManager *mtxmanager ; /*--------------------------------------------------------------------*/ /* -------------------- get input parameters -------------------- */ if ( argc != 7 ) { fprintf(stdout, "\n usage: %s msglvl msgFile type matrixFileName rhsFileName seed" "\n msglvl -- message level" "\n msgFile -- message file" "\n type -- type of entries" "\n 1 (SPOOLES_REAL) -- real entries" "\n 2 (SPOOLES_COMPLEX) -- complex entries" "\n matrixFileName -- matrix file name, format" "\n nrow ncol nent" "\n irow jcol entry" "\n ..." "\n note: indices are zero based" "\n rhsFileName -- right hand side file name, format" "\n nrow " "\n entry[0]" "\n ..." "\n entry[nrow-1]" "\n seed -- random number seed, used for ordering" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } type = atoi(argv[3]) ; matrixFileName = argv[4] ; rhsFileName = argv[5] ; seed = atoi(argv[6]) ; /*--------------------------------------------------------------------*/ /* -------------------------------------------- STEP 1: read the entries from the input file and create the InpMtx object of A -------------------------------------------- */ inputFile = fopen(matrixFileName, "r") ; fscanf(inputFile, "%d %d %d", &nrow, &neqns, &nent) ; mtxA = InpMtx_new() ; InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, 0) ; if ( type == SPOOLES_REAL ) { for ( ient = 0 ; ient < nent ; ient++ ) { fscanf(inputFile, "%d %d %le", &irow, &jcol, &value) ; InpMtx_inputRealEntry(mtxA, irow, jcol, value) ; } } else { for ( ient = 0 ; ient < nent ; ient++ ) { fscanf(inputFile, "%d %d %le %le", &irow, &jcol, &real, &imag) ; InpMtx_inputComplexEntry(mtxA, irow, jcol, real, imag) ; } } fclose(inputFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n input matrix") ; InpMtx_writeForHumanEye(mtxA, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ---------------------------------------- STEP 2: read the right hand side entries ---------------------------------------- */ inputFile = fopen(rhsFileName, "r") ; fscanf(inputFile, "%d %d", &nrow, &nrhs) ; mtxB = DenseMtx_new() ; DenseMtx_init(mtxB, type, 0, 0, nrow, nrhs, 1, nrow) ; DenseMtx_zero(mtxB) ; if ( type == SPOOLES_REAL ) { for ( irow = 0 ; irow < nrow ; irow++ ) { fscanf(inputFile, "%d", &jrow) ; for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) { fscanf(inputFile, "%le", &value) ; DenseMtx_setRealEntry(mtxB, jrow, jrhs, value) ; } } } else { for ( irow = 0 ; irow < nrow ; irow++ ) { fscanf(inputFile, "%d", &jrow) ; for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) { fscanf(inputFile, "%le %le", &real, &imag) ; DenseMtx_setComplexEntry(mtxB, jrow, jrhs, real, imag) ; } } } fclose(inputFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n rhs matrix in original ordering") ; DenseMtx_writeForHumanEye(mtxB, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------- STEP 3 : find a low-fill ordering (1) create the Graph object for A^TA or A^HA (2) order the graph using multiple minimum degree ------------------------------------------------- */ graph = Graph_new() ; adjIVL = InpMtx_adjForATA(mtxA) ; nedges = IVL_tsize(adjIVL) ; Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n graph of A^T A") ; Graph_writeForHumanEye(graph, msgFile) ; fflush(msgFile) ; } frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n front tree from ordering") ; ETree_writeForHumanEye(frontETree, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------------------- STEP 4: get the permutation, permute the matrix and front tree and get the symbolic factorization ----------------------------------------------------- */ oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ; newToOldIV = ETree_newToOldVtxPerm(frontETree) ; InpMtx_permute(mtxA, NULL, IV_entries(oldToNewIV)) ; InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; symbfacIVL = SymbFac_initFromGraph(frontETree, graph) ; IVL_overwrite(symbfacIVL, oldToNewIV) ; IVL_sortUp(symbfacIVL) ; ETree_permuteVertices(frontETree, oldToNewIV) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n old-to-new permutation vector") ; IV_writeForHumanEye(oldToNewIV, msgFile) ; fprintf(msgFile, "\n\n new-to-old permutation vector") ; IV_writeForHumanEye(newToOldIV, msgFile) ; fprintf(msgFile, "\n\n front tree after permutation") ; ETree_writeForHumanEye(frontETree, msgFile) ; fprintf(msgFile, "\n\n input matrix after permutation") ; InpMtx_writeForHumanEye(mtxA, msgFile) ; fprintf(msgFile, "\n\n symbolic factorization") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------ STEP 5: initialize the front matrix object ------------------------------------------ */ frontmtx = FrontMtx_new() ; mtxmanager = SubMtxManager_new() ; SubMtxManager_init(mtxmanager, NO_LOCK, 0) ; if ( type == SPOOLES_REAL ) { FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ; } else { FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, SPOOLES_HERMITIAN, FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------- STEP 6: compute the numeric factorization ----------------------------------------- */ chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, NO_LOCK, 1) ; DVzero(10, cpus) ; facops = 0.0 ; FrontMtx_QR_factor(frontmtx, mtxA, chvmanager, cpus, &facops, msglvl, msgFile) ; ChvManager_free(chvmanager) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n factor matrix") ; fprintf(msgFile, "\n facops = %9.2f", facops) ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* -------------------------------------- STEP 7: post-process the factorization -------------------------------------- */ FrontMtx_postProcess(frontmtx, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n factor matrix after post-processing") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------- STEP 8: solve the linear system ------------------------------- */ mtxX = DenseMtx_new() ; DenseMtx_init(mtxX, type, 0, 0, neqns, nrhs, 1, neqns) ; FrontMtx_QR_solve(frontmtx, mtxA, mtxX, mtxB, mtxmanager, cpus, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n solution matrix in new ordering") ; DenseMtx_writeForHumanEye(mtxX, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------------- STEP 9: permute the solution into the original ordering ------------------------------------------------------- */ DenseMtx_permuteRows(mtxX, newToOldIV) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n\n solution matrix in original ordering") ; DenseMtx_writeForHumanEye(mtxX, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------ free the working storage ------------------------ */ InpMtx_free(mtxA) ; FrontMtx_free(frontmtx) ; Graph_free(graph) ; DenseMtx_free(mtxX) ; DenseMtx_free(mtxB) ; ETree_free(frontETree) ; IV_free(newToOldIV) ; IV_free(oldToNewIV) ; IVL_free(symbfacIVL) ; SubMtxManager_free(mtxmanager) ; /*--------------------------------------------------------------------*/ return(1) ; }
/* -------------------------------------------------- clear the data fields, releasing allocated storage created -- 98may04, cca -------------------------------------------------- */ void FrontMtx_clearData ( FrontMtx *frontmtx ) { SubMtx *mtx ; int ii, J, K, nadj, nfront ; int *adj ; /* --------------- check the input --------------- */ if ( frontmtx == NULL ) { fprintf(stderr, "\n fatal error in FrontMtx_clearData(%p)" "\n bad input\n", frontmtx) ; exit(-1) ; } nfront = frontmtx->nfront ; /* ---------------------- free the owned storage ---------------------- */ if ( frontmtx->frontsizesIV != NULL ) { IV_free(frontmtx->frontsizesIV) ; } if ( frontmtx->rowadjIVL != NULL ) { IVL_free(frontmtx->rowadjIVL) ; } if ( frontmtx->coladjIVL != NULL ) { IVL_free(frontmtx->coladjIVL) ; } if ( frontmtx->p_mtxDJJ != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { if ( (mtx = frontmtx->p_mtxDJJ[J]) != NULL ) { SubMtx_free(mtx) ; } } FREE(frontmtx->p_mtxDJJ) ; } if ( frontmtx->tree != NULL ) { if ( frontmtx->frontETree == NULL || frontmtx->frontETree->tree != frontmtx->tree ) { Tree_free(frontmtx->tree) ; } frontmtx->tree = NULL ; } if ( frontmtx->dataMode == FRONTMTX_1D_MODE ) { if ( frontmtx->p_mtxUJJ != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { if ( (mtx = frontmtx->p_mtxUJJ[J]) != NULL ) { SubMtx_free(mtx) ; } } FREE(frontmtx->p_mtxUJJ) ; } if ( frontmtx->p_mtxUJN != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { if ( (mtx = frontmtx->p_mtxUJN[J]) != NULL ) { SubMtx_free(mtx) ; } } FREE(frontmtx->p_mtxUJN) ; } if ( frontmtx->p_mtxLJJ != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { if ( (mtx = frontmtx->p_mtxLJJ[J]) != NULL ) { SubMtx_free(mtx) ; } } FREE(frontmtx->p_mtxLJJ) ; } if ( frontmtx->p_mtxLNJ != NULL ) { for ( J = 0 ; J < nfront ; J++ ) { if ( (mtx = frontmtx->p_mtxLNJ[J]) != NULL ) { SubMtx_free(mtx) ; } } FREE(frontmtx->p_mtxLNJ) ; } } else if ( frontmtx->dataMode == FRONTMTX_2D_MODE ) { for ( J = 0 ; J < nfront ; J++ ) { FrontMtx_upperAdjFronts(frontmtx, J, &nadj, &adj) ; for ( ii = 0 ; ii < nadj ; ii++ ) { K = adj[ii] ; if ( (mtx = FrontMtx_upperMtx(frontmtx, J, K)) != NULL ) { SubMtx_free(mtx) ; } } } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { for ( J = 0 ; J < nfront ; J++ ) { FrontMtx_lowerAdjFronts(frontmtx, J, &nadj, &adj) ; for ( ii = 0 ; ii < nadj ; ii++ ) { K = adj[ii] ; if ( (mtx = FrontMtx_lowerMtx(frontmtx, K, J)) != NULL ) { SubMtx_free(mtx) ; } } } } if ( frontmtx->lowerblockIVL != NULL ) { IVL_free(frontmtx->lowerblockIVL) ; } if ( frontmtx->upperblockIVL != NULL ) { IVL_free(frontmtx->upperblockIVL) ; } if ( frontmtx->lowerhash != NULL ) { I2Ohash_free(frontmtx->lowerhash) ; } if ( frontmtx->upperhash != NULL ) { I2Ohash_free(frontmtx->upperhash) ; } } if ( frontmtx->lock != NULL ) { /* ------------------------- destroy and free the lock ------------------------- */ Lock_free(frontmtx->lock) ; } /* ---------------------- set the default fields ---------------------- */ FrontMtx_setDefaultFields(frontmtx) ; return ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* --------------------------------------------------- read in a DSTree object, read in a Graph file, read in a DV cutoffs file, get the stages IV object based on domain weight and write it to a file. created -- 97jun12, cca --------------------------------------------------- */ { char *inCutoffDVfileName, *inDSTreeFileName, *inGraphFileName, *outIVfileName ; double t1, t2 ; DV *cutoffDV ; Graph *graph ; int msglvl, rc ; IV *stagesIV ; DSTree *dstree ; FILE *msgFile ; if ( argc != 7 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile inDSTreeFile inGraphFile " "\n inCutoffDVfile outFile" "\n msglvl -- message level" "\n msgFile -- message file" "\n inDSTreeFile -- input file, must be *.dstreef or *.dstreeb" "\n inGraphFile -- input file, must be *.graphf or *.graphb" "\n inCutoffDVfile -- input file, must be *.dvf or *.dvb" "\n outFile -- output file, must be *.ivf or *.ivb" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } inDSTreeFileName = argv[3] ; inGraphFileName = argv[4] ; inCutoffDVfileName = argv[5] ; outIVfileName = argv[6] ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n inDSTreeFileName -- %s" "\n inGraphFileName -- %s" "\n inCutoffDVfileName -- %s" "\n outFile -- %s" "\n", argv[0], msglvl, argv[2], inDSTreeFileName, inGraphFileName, inCutoffDVfileName, outIVfileName) ; fflush(msgFile) ; /* ------------------------- read in the DSTree object ------------------------- */ if ( strcmp(inDSTreeFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; spoolesFatal(); } dstree = DSTree_new() ; MARKTIME(t1) ; rc = DSTree_readFromFile(dstree, inDSTreeFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in dstree from file %s", t2 - t1, inDSTreeFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from DSTree_readFromFile(%p,%s)", rc, dstree, inDSTreeFileName) ; spoolesFatal(); } fprintf(msgFile, "\n\n after reading DSTree object from file %s", inDSTreeFileName) ; if ( msglvl > 2 ) { DSTree_writeForHumanEye(dstree, msgFile) ; } else { DSTree_writeStats(dstree, msgFile) ; } fflush(msgFile) ; /* ------------------------- read in the Graph object ------------------------- */ if ( strcmp(inGraphFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; spoolesFatal(); } graph = Graph_new() ; MARKTIME(t1) ; rc = Graph_readFromFile(graph, inGraphFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s", t2 - t1, inGraphFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from Graph_readFromFile(%p,%s)", rc, graph, inGraphFileName) ; spoolesFatal(); } fprintf(msgFile, "\n\n after reading Graph object from file %s", inGraphFileName) ; if ( msglvl > 2 ) { Graph_writeForHumanEye(graph, msgFile) ; } else { Graph_writeStats(graph, msgFile) ; } fflush(msgFile) ; /* ----------------------------- read in the cutoffs DV object ----------------------------- */ if ( strcmp(inCutoffDVfileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; spoolesFatal(); } cutoffDV = DV_new() ; MARKTIME(t1) ; rc = DV_readFromFile(cutoffDV, inCutoffDVfileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s", t2 - t1, inCutoffDVfileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from DV_readFromFile(%p,%s)", rc, cutoffDV, inCutoffDVfileName) ; spoolesFatal(); } fprintf(msgFile, "\n\n after reading DV object from file %s", inCutoffDVfileName) ; if ( msglvl > 0 ) { DV_writeForHumanEye(cutoffDV, msgFile) ; } else { DV_writeStats(cutoffDV, msgFile) ; } fflush(msgFile) ; /* --------------------- get the stages vector --------------------- */ stagesIV = DSTree_stagesViaDomainWeight(dstree, graph->vwghts, cutoffDV) ; if ( msglvl > 2 ) { IV_writeForHumanEye(stagesIV, msgFile) ; } else { IV_writeStats(stagesIV, msgFile) ; } fflush(msgFile) ; /* --------------------------- write out the DSTree object --------------------------- */ if ( stagesIV != NULL && strcmp(outIVfileName, "none") != 0 ) { MARKTIME(t1) ; rc = IV_writeToFile(stagesIV, outIVfileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : write dstree to file %s", t2 - t1, outIVfileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_writeToFile(%p,%s)", rc, stagesIV, outIVfileName) ; } } /* ---------------------- free the DSTree object ---------------------- */ DSTree_free(dstree) ; if ( stagesIV != NULL ) { IV_free(stagesIV) ; } fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
NM_Status SpoolesSolver :: solve(SparseMtrx *A, FloatArray *b, FloatArray *x) { int errorValue, mtxType, symmetryflag; int seed = 30145, pivotingflag = 0; int *oldToNew, *newToOld; double droptol = 0.0, tau = 1.e300; double cpus [ 10 ]; int stats [ 20 ]; ChvManager *chvmanager; Chv *rootchv; InpMtx *mtxA; DenseMtx *mtxY, *mtxX; // first check whether Lhs is defined if ( !A ) { _error("solveYourselfAt: unknown Lhs"); } // and whether Rhs if ( !b ) { _error("solveYourselfAt: unknown Rhs"); } // and whether previous Solution exist if ( !x ) { _error("solveYourselfAt: unknown solution array"); } if ( x->giveSize() != b->giveSize() ) { _error("solveYourselfAt: size mismatch"); } Timer timer; timer.startTimer(); if ( A->giveType() != SMT_SpoolesMtrx ) { _error("solveYourselfAt: SpoolesSparseMtrx Expected"); } mtxA = ( ( SpoolesSparseMtrx * ) A )->giveInpMtrx(); mtxType = ( ( SpoolesSparseMtrx * ) A )->giveValueType(); symmetryflag = ( ( SpoolesSparseMtrx * ) A )->giveSymmetryFlag(); int i; int neqns = A->giveNumberOfRows(); int nrhs = 1; /* convert right-hand side to DenseMtx */ mtxY = DenseMtx_new(); DenseMtx_init(mtxY, mtxType, 0, 0, neqns, nrhs, 1, neqns); DenseMtx_zero(mtxY); for ( i = 0; i < neqns; i++ ) { DenseMtx_setRealEntry( mtxY, i, 0, b->at(i + 1) ); } if ( ( Lhs != A ) || ( this->lhsVersion != A->giveVersion() ) ) { // // lhs has been changed -> new factorization // Lhs = A; this->lhsVersion = A->giveVersion(); if ( frontmtx ) { FrontMtx_free(frontmtx); } if ( newToOldIV ) { IV_free(newToOldIV); } if ( oldToNewIV ) { IV_free(oldToNewIV); } if ( frontETree ) { ETree_free(frontETree); } if ( symbfacIVL ) { IVL_free(symbfacIVL); } if ( mtxmanager ) { SubMtxManager_free(mtxmanager); } if ( graph ) { Graph_free(graph); } /* * ------------------------------------------------- * STEP 3 : find a low-fill ordering * (1) create the Graph object * (2) order the graph using multiple minimum degree * ------------------------------------------------- */ int nedges; graph = Graph_new(); adjIVL = InpMtx_fullAdjacency(mtxA); nedges = IVL_tsize(adjIVL); Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL); if ( msglvl > 2 ) { fprintf(msgFile, "\n\n graph of the input matrix"); Graph_writeForHumanEye(graph, msgFile); fflush(msgFile); } frontETree = orderViaMMD(graph, seed, msglvl, msgFile); if ( msglvl > 0 ) { fprintf(msgFile, "\n\n front tree from ordering"); ETree_writeForHumanEye(frontETree, msgFile); fflush(msgFile); } /* * ---------------------------------------------------- * STEP 4: get the permutation, permute the front tree, * permute the matrix and right hand side, and * get the symbolic factorization * ---------------------------------------------------- */ oldToNewIV = ETree_oldToNewVtxPerm(frontETree); oldToNew = IV_entries(oldToNewIV); newToOldIV = ETree_newToOldVtxPerm(frontETree); newToOld = IV_entries(newToOldIV); ETree_permuteVertices(frontETree, oldToNewIV); InpMtx_permute(mtxA, oldToNew, oldToNew); if ( symmetryflag == SPOOLES_SYMMETRIC || symmetryflag == SPOOLES_HERMITIAN ) { InpMtx_mapToUpperTriangle(mtxA); } InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS); InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS); symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA); if ( msglvl > 2 ) { fprintf(msgFile, "\n\n old-to-new permutation vector"); IV_writeForHumanEye(oldToNewIV, msgFile); fprintf(msgFile, "\n\n new-to-old permutation vector"); IV_writeForHumanEye(newToOldIV, msgFile); fprintf(msgFile, "\n\n front tree after permutation"); ETree_writeForHumanEye(frontETree, msgFile); fprintf(msgFile, "\n\n input matrix after permutation"); InpMtx_writeForHumanEye(mtxA, msgFile); fprintf(msgFile, "\n\n symbolic factorization"); IVL_writeForHumanEye(symbfacIVL, msgFile); fflush(msgFile); } Tree_writeToFile(frontETree->tree, (char*)"haggar.treef"); /*--------------------------------------------------------------------*/ /* * ------------------------------------------ * STEP 5: initialize the front matrix object * ------------------------------------------ */ frontmtx = FrontMtx_new(); mtxmanager = SubMtxManager_new(); SubMtxManager_init(mtxmanager, NO_LOCK, 0); FrontMtx_init(frontmtx, frontETree, symbfacIVL, mtxType, symmetryflag, FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile); /*--------------------------------------------------------------------*/ /* * ----------------------------------------- * STEP 6: compute the numeric factorization * ----------------------------------------- */ chvmanager = ChvManager_new(); ChvManager_init(chvmanager, NO_LOCK, 1); DVfill(10, cpus, 0.0); IVfill(20, stats, 0); rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol, chvmanager, & errorValue, cpus, stats, msglvl, msgFile); ChvManager_free(chvmanager); if ( msglvl > 0 ) { fprintf(msgFile, "\n\n factor matrix"); FrontMtx_writeForHumanEye(frontmtx, msgFile); fflush(msgFile); } if ( rootchv != NULL ) { fprintf(msgFile, "\n\n matrix found to be singular\n"); exit(-1); } if ( errorValue >= 0 ) { fprintf(msgFile, "\n\n error encountered at front %d", errorValue); exit(-1); } /*--------------------------------------------------------------------*/ /* * -------------------------------------- * STEP 7: post-process the factorization * -------------------------------------- */ FrontMtx_postProcess(frontmtx, msglvl, msgFile); if ( msglvl > 2 ) { fprintf(msgFile, "\n\n factor matrix after post-processing"); FrontMtx_writeForHumanEye(frontmtx, msgFile); fflush(msgFile); } /*--------------------------------------------------------------------*/ } /* * ---------------------------------------------------- * STEP 4: permute the right hand side * ---------------------------------------------------- */ DenseMtx_permuteRows(mtxY, oldToNewIV); if ( msglvl > 2 ) { fprintf(msgFile, "\n\n right hand side matrix after permutation"); DenseMtx_writeForHumanEye(mtxY, msgFile); } /* * ------------------------------- * STEP 8: solve the linear system * ------------------------------- */ mtxX = DenseMtx_new(); DenseMtx_init(mtxX, mtxType, 0, 0, neqns, nrhs, 1, neqns); DenseMtx_zero(mtxX); FrontMtx_solve(frontmtx, mtxX, mtxY, mtxmanager, cpus, msglvl, msgFile); if ( msglvl > 2 ) { fprintf(msgFile, "\n\n solution matrix in new ordering"); DenseMtx_writeForHumanEye(mtxX, msgFile); fflush(msgFile); } /*--------------------------------------------------------------------*/ /* * ------------------------------------------------------- * STEP 9: permute the solution into the original ordering * ------------------------------------------------------- */ DenseMtx_permuteRows(mtxX, newToOldIV); if ( msglvl > 0 ) { fprintf(msgFile, "\n\n solution matrix in original ordering"); DenseMtx_writeForHumanEye(mtxX, msgFile); fflush(msgFile); } // DenseMtx_writeForMatlab(mtxX, "x", msgFile) ; /*--------------------------------------------------------------------*/ /* fetch data to oofem vectors */ double *xptr = x->givePointer(); for ( i = 0; i < neqns; i++ ) { DenseMtx_realEntry(mtxX, i, 0, xptr + i); // printf ("x(%d) = %e\n", i+1, *(xptr+i)); } // DenseMtx_copyRowIntoVector(mtxX, 0, x->givePointer()); timer.stopTimer(); OOFEM_LOG_DEBUG( "SpoolesSolver info: user time consumed by solution: %.2fs\n", timer.getUtime() ); /* * ----------- * free memory * ----------- */ DenseMtx_free(mtxX); DenseMtx_free(mtxY); /*--------------------------------------------------------------------*/ return ( 1 ); }
/* ------------------------------------------------------------- purpose --- to compute a matrix-vector multiply y[] = C * x[] where C is the identity, A or B (depending on *pprbtype). *pnrows -- # of rows in x[] *pncols -- # of columns in x[] *pprbtype -- problem type *pprbtype = 1 --> vibration problem, matrix is A *pprbtype = 2 --> buckling problem, matrix is B *pprbtype = 3 --> matrix is identity, y[] = x[] x[] -- vector to be multiplied NOTE: the x[] vector is global, not a portion y[] -- product vector NOTE: the y[] vector is global, not a portion created -- 98aug28, cca & jcp ------------------------------------------------------------- */ void JimMatMulMPI ( int *pnrows, int *pncols, double x[], double y[], int *pprbtype, void *data ) { BridgeMPI *bridge = (BridgeMPI *) data ; int ncols, nent, nrows ; #if MYDEBUG > 0 double t1, t2 ; count_JimMatMul++ ; MARKTIME(t1) ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) JimMatMulMPI() start", count_JimMatMul) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) JimMatMulMPI() start", count_JimMatMul) ; fflush(bridge->msgFile) ; #endif nrows = *pnrows ; ncols = *pncols ; nent = nrows*ncols ; if ( *pprbtype == 3 ) { /* -------------------------- ... matrix is the identity -------------------------- */ DVcopy(nent, y, x) ; } else { BridgeMPI *bridge = (BridgeMPI *) data ; DenseMtx *mtx, *newmtx ; int irow, jcol, jj, kk, myid, neqns, nowned, tag = 0 ; int *vtxmap ; int stats[4] ; IV *mapIV ; /* --------------------------------------------- slide the owned rows of x[] down in the array --------------------------------------------- */ vtxmap = IV_entries(bridge->vtxmapIV) ; neqns = bridge->neqns ; myid = bridge->myid ; nowned = IV_size(bridge->myownedIV) ; for ( jcol = jj = kk = 0 ; jcol < ncols ; jcol++ ) { for ( irow = 0 ; irow < neqns ; irow++, jj++ ) { if ( vtxmap[irow] == myid ) { y[kk++] = x[jj] ; } } } if ( kk != nowned * ncols ) { fprintf(stderr, "\n proc %d : kk %d, nowned %d, ncols %d", myid, kk, nowned, ncols) ; exit(-1) ; } /* ---------------------------------------- call the method that assumes local input ---------------------------------------- */ if ( bridge->msglvl > 2 ) { fprintf(bridge->msgFile, "\n inside JimMatMulMPI, calling MatMulMpi" "\n prbtype %d, nrows %d, ncols %d, nowned %d", *pprbtype, *pnrows, *pncols, nowned) ; fflush(bridge->msgFile) ; } MatMulMPI(&nowned, pncols, y, y, pprbtype, data) ; /* ------------------------------------------------- gather all the entries of y[] onto processor zero ------------------------------------------------- */ mtx = DenseMtx_new() ; DenseMtx_init(mtx, SPOOLES_REAL, 0, 0, nowned, ncols, 1, nowned) ; DVcopy (nowned*ncols, DenseMtx_entries(mtx), y) ; IVcopy(nowned, mtx->rowind, IV_entries(bridge->myownedIV)) ; mapIV = IV_new() ; IV_init(mapIV, neqns, NULL) ; IV_fill(mapIV, 0) ; IVfill(4, stats, 0) ; if ( bridge->msglvl > 2 ) { fprintf(bridge->msgFile, "\n mtx: %d rows x %d columns", mtx->nrow, mtx->ncol) ; fflush(bridge->msgFile) ; } newmtx = DenseMtx_MPI_splitByRows(mtx, mapIV, stats, bridge->msglvl, bridge->msgFile, tag, bridge->comm) ; if ( bridge->msglvl > 2 ) { fprintf(bridge->msgFile, "\n newmtx: %d rows x %d columns", newmtx->nrow, newmtx->ncol) ; fflush(bridge->msgFile) ; } DenseMtx_free(mtx) ; mtx = newmtx ; IV_free(mapIV) ; if ( myid == 0 ) { if ( mtx->nrow != neqns || mtx->ncol != ncols ) { fprintf(bridge->msgFile, "\n\n WHOA: mtx->nrows %d, mtx->ncols %d" ", neqns %d, ncols %d", mtx->nrow, mtx->ncol, neqns, ncols) ; exit(-1) ; } DVcopy(neqns*ncols, y, DenseMtx_entries(mtx)) ; } DenseMtx_free(mtx) ; /* --------------------------------------------- broadcast the entries to the other processors --------------------------------------------- */ MPI_Bcast((void *) y, neqns*ncols, MPI_DOUBLE, 0, bridge->comm) ; if ( bridge->msglvl > 2 ) { fprintf(bridge->msgFile, "\n after the broadcast") ; fflush(bridge->msgFile) ; } } MPI_Barrier(bridge->comm) ; #if MYDEBUG > 0 MARKTIME(t2) ; time_JimMatMul += t2 - t1 ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) JimMatMulMPI() end", count_JimMatMul) ; fprintf(stdout, ", %8.3f seconds, %8.3f total time", t2 - t1, time_JimMatMul) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) JimMatMulMPI() end", count_JimMatMul) ; fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time", t2 - t1, time_JimMatMul) ; fflush(bridge->msgFile) ; #endif return ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* ------------------------------------------------------- read in an ETree object and an equivalence map, expand the ETree object and optionally write to a file. created -- 98sep05, cca ------------------------------------------------------- */ { char *inEqmapFileName, *inETreeFileName, *outETreeFileName ; double t1, t2 ; ETree *etree, *etree2 ; FILE *msgFile ; int msglvl, rc ; IV *eqmapIV ; if ( argc != 6 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile inETreeFile inEqmapFile outETreeFile" "\n msglvl -- message level" "\n msgFile -- message file" "\n inETreeFile -- input file, must be *.etreef or *.etreeb" "\n inEqmapFile -- input file, must be *.ivf or *.ivb" "\n outETreeFile -- output file, must be *.etreef or *.etreeb" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } inETreeFileName = argv[3] ; inEqmapFileName = argv[4] ; outETreeFileName = argv[5] ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n inETreeFile -- %s" "\n inEqmapFile -- %s" "\n outETreeFile -- %s" "\n", argv[0], msglvl, argv[2], inETreeFileName, inEqmapFileName, outETreeFileName) ; fflush(msgFile) ; /* ------------------------ read in the ETree object ------------------------ */ if ( strcmp(inETreeFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } etree = ETree_new() ; MARKTIME(t1) ; rc = ETree_readFromFile(etree, inETreeFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in etree from file %s", t2 - t1, inETreeFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)", rc, etree, inETreeFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading ETree object from file %s", inETreeFileName) ; if ( msglvl > 2 ) { ETree_writeForHumanEye(etree, msgFile) ; } else { ETree_writeStats(etree, msgFile) ; } fflush(msgFile) ; /* ------------------------------------- read in the equivalence map IV object ------------------------------------- */ if ( strcmp(inEqmapFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } eqmapIV = IV_new() ; MARKTIME(t1) ; rc = IV_readFromFile(eqmapIV, inEqmapFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in eqmapIV from file %s", t2 - t1, inEqmapFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)", rc, eqmapIV, inEqmapFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading IV object from file %s", inEqmapFileName) ; if ( msglvl > 2 ) { IV_writeForHumanEye(eqmapIV, msgFile) ; } else { IV_writeStats(eqmapIV, msgFile) ; } fflush(msgFile) ; /* ----------------------- expand the ETree object ----------------------- */ etree2 = ETree_expand(etree, eqmapIV) ; fprintf(msgFile, "\n\n after expanding the ETree object") ; if ( msglvl > 2 ) { ETree_writeForHumanEye(etree2, msgFile) ; } else { ETree_writeStats(etree2, msgFile) ; } fflush(msgFile) ; /* -------------------------- write out the ETree object -------------------------- */ if ( strcmp(outETreeFileName, "none") != 0 ) { MARKTIME(t1) ; rc = ETree_writeToFile(etree2, outETreeFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : write etree to file %s", t2 - t1, outETreeFileName) ; } if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from ETree_writeToFile(%p,%s)", rc, etree2, outETreeFileName) ; } /* --------------------- free the ETree object --------------------- */ ETree_free(etree) ; IV_free(eqmapIV) ; ETree_free(etree2) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
/* -------------------------------------------------------------------- purpose -- merge the front tree allowing at most maxzeros zero entries inside a front return -- IV object that has the old front to new front map created -- 96jun23, cca modified -- 97dec18, cca bug fixed that incorrectly counted the number of zeros in a front -------------------------------------------------------------------- */ ETree * ETree_mergeFrontsAny ( ETree *etree, int maxzeros, IV *nzerosIV ) { ETree *etree2 ; int J, K, nfront, nvtx, nnew ; int *bndwghts, *cost, *fch, *map, *nodwghts, *nzeros, *par, *place, *rep, *sib, *temp ; IV *mapIV ; Tree *tree ; /* --------------- check the input --------------- */ if ( etree == NULL || (nfront = etree->nfront) <= 0 || (nvtx = etree->nvtx) <= 0 ) { fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d)" "\n bad input\n", etree, maxzeros) ; spoolesFatal(); } if ( IV_size(nzerosIV) != nfront ) { fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d,%p)" "\n size(nzerosIV) = %d, nfront = %d\n", etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ; spoolesFatal(); } nzeros = IV_entries(nzerosIV) ; tree = etree->tree ; nodwghts = IVinit(nfront, 0) ; bndwghts = IVinit(nfront, 0) ; par = IVinit(nfront, -1) ; fch = IVinit(nfront, -1) ; sib = IVinit(nfront, -1) ; IVcopy(nfront, par, tree->par) ; IVcopy(nfront, fch, tree->fch) ; IVcopy(nfront, sib, tree->sib) ; IVcopy(nfront, nodwghts, IV_entries(etree->nodwghtsIV)) ; IVcopy(nfront, bndwghts, IV_entries(etree->bndwghtsIV)) ; /* ---------------------- set up working storage ---------------------- */ rep = IVinit(nfront, -1) ; IVramp(nfront, rep, 0, 1) ; cost = IVinit(nfront, 0) ; /* ------------------------------------------ perform a post-order traversal of the tree ------------------------------------------ */ for ( J = Tree_postOTfirst(tree) ; J != -1 ; J = Tree_postOTnext(tree, J) ) { #if MYDEBUG > 0 fprintf(stdout, "\n\n ##### visiting front %d", J) ; fflush(stdout) ; #endif visitAny(J, par, fch, sib, nodwghts, bndwghts, rep, cost, nzeros, maxzeros) ; } #if MYDEBUG > 0 fprintf(stdout, "\n\n whoa, finished") ; fflush(stdout) ; #endif /* ------------------------------------------------- take the map from fronts to representative fronts and make the map from old fronts to new fronts ------------------------------------------------- */ mapIV = IV_new() ; IV_init(mapIV, nfront, NULL) ; map = IV_entries(mapIV) ; place = IVinit(nfront, -1) ; for ( J = 0, nnew = 0 ; J < nfront ; J++ ) { #if MYDEBUG > 0 fprintf(stdout, "\n rep[%d] = %d", J, rep[J]) ; fflush(stdout) ; #endif if ( rep[J] != J ) { K = J ; while ( rep[K] != K ) { #if MYDEBUG > 0 fprintf(stdout, "\n rep[%d] = %d", K, rep[K]) ; fflush(stdout) ; #endif K = rep[K] ; } rep[J] = K ; #if MYDEBUG > 0 fprintf(stdout, "\n setting rep[%d] = %d", J, rep[J]) ; fflush(stdout) ; #endif } else { place[J] = nnew++ ; } } for ( J = 0 ; J < nfront ; J++ ) { K = rep[J] ; map[J] = place[K] ; } /* ------------------------------- get the compressed ETree object ------------------------------- */ etree2 = ETree_compress(etree, mapIV) ; /* ------------------------- remap the nzeros[] vector ------------------------- */ temp = IVinit(nfront, 0) ; IVcopy(nfront, temp, nzeros) ; IV_setSize(nzerosIV, nnew) ; nzeros = IV_entries(nzerosIV) ; for ( J = 0 ; J < nfront ; J++ ) { if ( rep[J] == J ) { nzeros[map[J]] = temp[J] ; } } IVfree(temp) ; /* ------------------------ free the working storage ------------------------ */ IVfree(par) ; IVfree(fch) ; IVfree(sib) ; IVfree(nodwghts) ; IVfree(bndwghts) ; IVfree(rep) ; IVfree(cost) ; IVfree(place) ; IV_free(mapIV) ; return(etree2) ; }
/* ------------------------------------------------------- purpose -- merge the front tree allowing a parent to absorb all children when that creates at most maxzeros zero entries inside a front return -- IV object that has the old front to new front map created -- 98jan29, cca ------------------------------------------------------- */ ETree * ETree_mergeFrontsAll ( ETree *etree, int maxzeros, IV *nzerosIV ) { ETree *etree2 ; int cost, J, Jall, K, KandBnd, nfront, nvtx, nnew ; int *bndwghts, *fch, *map, *nodwghts, *nzeros, *rep, *sib, *temp ; IV *mapIV ; Tree *tree ; /* --------------- check the input --------------- */ if ( etree == NULL || nzerosIV == NULL || (nfront = etree->nfront) <= 0 || (nvtx = etree->nvtx) <= 0 ) { fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)" "\n bad input\n", etree, maxzeros, nzerosIV) ; if ( etree != NULL ) { fprintf(stderr, "\n nfront = %d, nvtx = %d", etree->nfront, etree->nvtx) ; } spoolesFatal(); } if ( IV_size(nzerosIV) != nfront ) { fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)" "\n size(nzerosIV) = %d, nfront = %d\n", etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ; spoolesFatal(); } nzeros = IV_entries(nzerosIV) ; /* ---------------------- set up working storage ---------------------- */ tree = etree->tree ; fch = ETree_fch(etree) ; sib = ETree_sib(etree) ; nodwghts = IVinit(nfront, 0) ; IVcopy(nfront, nodwghts, ETree_nodwghts(etree)) ; bndwghts = ETree_bndwghts(etree) ; rep = IVinit(nfront, -1) ; IVramp(nfront, rep, 0, 1) ; /* ------------------------------------------ perform a post-order traversal of the tree ------------------------------------------ */ for ( K = Tree_postOTfirst(tree) ; K != -1 ; K = Tree_postOTnext(tree, K) ) { #if MYDEBUG > 0 fprintf(stdout, "\n\n ##### visiting front %d", K) ; fflush(stdout) ; #endif if ( (J = fch[K]) != -1 ) { KandBnd = nodwghts[K] + bndwghts[K] ; Jall = 0 ; cost = 2*nzeros[K] ; for ( J = fch[K] ; J != -1 ; J = sib[J] ) { Jall += nodwghts[J] ; cost -= nodwghts[J]*nodwghts[J] ; cost += 2*nodwghts[J]*(KandBnd - bndwghts[J]) ; cost += 2*nzeros[J] ; } cost += Jall*Jall ; cost = cost/2 ; #if MYDEBUG > 0 fprintf(stdout, "\n cost = %d", cost) ; fflush(stdout) ; #endif if ( cost <= maxzeros ) { for ( J = fch[K] ; J != -1 ; J = sib[J] ) { #if MYDEBUG > 0 fprintf(stdout, "\n merging %d into %d", J, K) ; fflush(stdout) ; #endif rep[J] = K ; nodwghts[K] += nodwghts[J] ; } nzeros[K] = cost ; } } } #if MYDEBUG > 0 fprintf(stdout, "\n\n whoa, finished") ; fflush(stdout) ; #endif /* ------------------------------------------------- take the map from fronts to representative fronts and make the map from old fronts to new fronts ------------------------------------------------- */ mapIV = IV_new() ; IV_init(mapIV, nfront, NULL) ; map = IV_entries(mapIV) ; for ( J = 0, nnew = 0 ; J < nfront ; J++ ) { if ( rep[J] == J ) { map[J] = nnew++ ; } else { K = J ; while ( rep[K] != K ) { K = rep[K] ; } rep[J] = K ; } } for ( J = 0 ; J < nfront ; J++ ) { if ( (K = rep[J]) != J ) { map[J] = map[K] ; } } /* ------------------------------- get the compressed ETree object ------------------------------- */ etree2 = ETree_compress(etree, mapIV) ; /* ------------------------- remap the nzeros[] vector ------------------------- */ temp = IVinit(nfront, 0) ; IVcopy(nfront, temp, nzeros) ; IV_setSize(nzerosIV, nnew) ; nzeros = IV_entries(nzerosIV) ; for ( J = 0 ; J < nfront ; J++ ) { if ( rep[J] == J ) { nzeros[map[J]] = temp[J] ; } } IVfree(temp) ; /* ------------------------ free the working storage ------------------------ */ IVfree(nodwghts) ; IVfree(rep) ; IV_free(mapIV) ; return(etree2) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) { /* -------------------------------------------------- all-in-one program to solve A X = B using a multithreaded factorization and solve We use a patch-and-go strategy for the factorization without pivoting (1) read in matrix entries and form DInpMtx object (2) form Graph object (3) order matrix and form front tree (4) get the permutation, permute the matrix and front tree and get the symbolic factorization (5) compute the numeric factorization (6) read in right hand side entries (7) compute the solution created -- 98jun04, cca -------------------------------------------------- */ /*--------------------------------------------------------------------*/ char *matrixFileName, *rhsFileName ; DenseMtx *mtxB, *mtxX ; Chv *rootchv ; ChvManager *chvmanager ; double fudge, imag, real, tau = 100., toosmall, value ; double cpus[10] ; DV *cumopsDV ; ETree *frontETree ; FrontMtx *frontmtx ; FILE *inputFile, *msgFile ; Graph *graph ; InpMtx *mtxA ; int error, ient, irow, jcol, jrhs, jrow, lookahead, msglvl, ncol, nedges, nent, neqns, nfront, nrhs, nrow, nthread, patchAndGoFlag, seed, storeids, storevalues, symmetryflag, type ; int *newToOld, *oldToNew ; int stats[20] ; IV *newToOldIV, *oldToNewIV, *ownersIV ; IVL *adjIVL, *symbfacIVL ; SolveMap *solvemap ; SubMtxManager *mtxmanager ; /*--------------------------------------------------------------------*/ /* -------------------- get input parameters -------------------- */ if ( argc != 14 ) { fprintf(stdout, "\n" "\n usage: %s msglvl msgFile type symmetryflag patchAndGoFlag" "\n fudge toosmall storeids storevalues" "\n matrixFileName rhsFileName seed" "\n msglvl -- message level" "\n msgFile -- message file" "\n type -- type of entries" "\n 1 (SPOOLES_REAL) -- real entries" "\n 2 (SPOOLES_COMPLEX) -- complex entries" "\n symmetryflag -- type of matrix" "\n 0 (SPOOLES_SYMMETRIC) -- symmetric entries" "\n 1 (SPOOLES_HERMITIAN) -- Hermitian entries" "\n 2 (SPOOLES_NONSYMMETRIC) -- nonsymmetric entries" "\n patchAndGoFlag -- flag for the patch-and-go strategy" "\n 0 -- none, stop factorization" "\n 1 -- optimization strategy" "\n 2 -- structural analysis strategy" "\n fudge -- perturbation parameter" "\n toosmall -- upper bound on a small pivot" "\n storeids -- flag to store ids of small pivots" "\n storevalues -- flag to store perturbations" "\n matrixFileName -- matrix file name, format" "\n nrow ncol nent" "\n irow jcol entry" "\n ..." "\n note: indices are zero based" "\n rhsFileName -- right hand side file name, format" "\n nrow nrhs " "\n ..." "\n jrow entry(jrow,0) ... entry(jrow,nrhs-1)" "\n ..." "\n seed -- random number seed, used for ordering" "\n nthread -- number of threads" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } type = atoi(argv[3]) ; symmetryflag = atoi(argv[4]) ; patchAndGoFlag = atoi(argv[5]) ; fudge = atof(argv[6]) ; toosmall = atof(argv[7]) ; storeids = atoi(argv[8]) ; storevalues = atoi(argv[9]) ; matrixFileName = argv[10] ; rhsFileName = argv[11] ; seed = atoi(argv[12]) ; nthread = atoi(argv[13]) ; /*--------------------------------------------------------------------*/ /* -------------------------------------------- STEP 1: read the entries from the input file and create the InpMtx object -------------------------------------------- */ if ( (inputFile = fopen(matrixFileName, "r")) == NULL ) { fprintf(stderr, "\n unable to open file %s", matrixFileName) ; spoolesFatal(); } fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ; neqns = nrow ; mtxA = InpMtx_new() ; InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, 0) ; if ( type == SPOOLES_REAL ) { for ( ient = 0 ; ient < nent ; ient++ ) { fscanf(inputFile, "%d %d %le", &irow, &jcol, &value) ; InpMtx_inputRealEntry(mtxA, irow, jcol, value) ; } } else { for ( ient = 0 ; ient < nent ; ient++ ) { fscanf(inputFile, "%d %d %le %le", &irow, &jcol, &real, &imag) ; InpMtx_inputComplexEntry(mtxA, irow, jcol, real, imag) ; } } fclose(inputFile) ; InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n input matrix") ; InpMtx_writeForHumanEye(mtxA, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------- STEP 2 : find a low-fill ordering (1) create the Graph object (2) order the graph using multiple minimum degree ------------------------------------------------- */ graph = Graph_new() ; adjIVL = InpMtx_fullAdjacency(mtxA) ; nedges = IVL_tsize(adjIVL) ; Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n graph of the input matrix") ; Graph_writeForHumanEye(graph, msgFile) ; fflush(msgFile) ; } frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n front tree from ordering") ; ETree_writeForHumanEye(frontETree, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------------------- STEP 3: get the permutation, permute the matrix and front tree and get the symbolic factorization ----------------------------------------------------- */ oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ; oldToNew = IV_entries(oldToNewIV) ; newToOldIV = ETree_newToOldVtxPerm(frontETree) ; newToOld = IV_entries(newToOldIV) ; ETree_permuteVertices(frontETree, oldToNewIV) ; InpMtx_permute(mtxA, oldToNew, oldToNew) ; InpMtx_mapToUpperTriangle(mtxA) ; InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ; InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n old-to-new permutation vector") ; IV_writeForHumanEye(oldToNewIV, msgFile) ; fprintf(msgFile, "\n\n new-to-old permutation vector") ; IV_writeForHumanEye(newToOldIV, msgFile) ; fprintf(msgFile, "\n\n front tree after permutation") ; ETree_writeForHumanEye(frontETree, msgFile) ; fprintf(msgFile, "\n\n input matrix after permutation") ; InpMtx_writeForHumanEye(mtxA, msgFile) ; fprintf(msgFile, "\n\n symbolic factorization") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------ STEP 4: initialize the front matrix object and the PatchAndGoInfo object to handle small pivots ------------------------------------------ */ frontmtx = FrontMtx_new() ; mtxmanager = SubMtxManager_new() ; SubMtxManager_init(mtxmanager, LOCK_IN_PROCESS, 0) ; FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, symmetryflag, FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, LOCK_IN_PROCESS, 0, NULL, mtxmanager, msglvl, msgFile) ; if ( patchAndGoFlag == 1 ) { frontmtx->patchinfo = PatchAndGoInfo_new() ; PatchAndGoInfo_init(frontmtx->patchinfo, 1, toosmall, fudge, storeids, storevalues) ; } else if ( patchAndGoFlag == 2 ) { frontmtx->patchinfo = PatchAndGoInfo_new() ; PatchAndGoInfo_init(frontmtx->patchinfo, 2, toosmall, fudge, storeids, storevalues) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------ STEP 5: setup the domain decomposition map ------------------------------------------ */ if ( nthread > (nfront = FrontMtx_nfront(frontmtx)) ) { nthread = nfront ; } cumopsDV = DV_new() ; DV_init(cumopsDV, nthread, NULL) ; ownersIV = ETree_ddMap(frontETree, type, symmetryflag, cumopsDV, 1./(2.*nthread)) ; DV_free(cumopsDV) ; /*--------------------------------------------------------------------*/ /* ----------------------------------------------------- STEP 6: compute the numeric factorization in parallel ----------------------------------------------------- */ chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1) ; DVfill(10, cpus, 0.0) ; IVfill(20, stats, 0) ; lookahead = 0 ; rootchv = FrontMtx_MT_factorInpMtx(frontmtx, mtxA, tau, 0.0, chvmanager, ownersIV, lookahead, &error, cpus, stats, msglvl, msgFile) ; if ( patchAndGoFlag == 1 ) { if ( frontmtx->patchinfo->fudgeIV != NULL ) { fprintf(msgFile, "\n small pivots found at these locations") ; IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ; } PatchAndGoInfo_free(frontmtx->patchinfo) ; } else if ( patchAndGoFlag == 2 ) { if ( frontmtx->patchinfo->fudgeIV != NULL ) { fprintf(msgFile, "\n small pivots found at these locations") ; IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ; } if ( frontmtx->patchinfo->fudgeDV != NULL ) { fprintf(msgFile, "\n perturbations") ; DV_writeForHumanEye(frontmtx->patchinfo->fudgeDV, msgFile) ; } PatchAndGoInfo_free(frontmtx->patchinfo) ; } ChvManager_free(chvmanager) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n factor matrix") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } if ( rootchv != NULL ) { fprintf(msgFile, "\n\n matrix found to be singular\n") ; spoolesFatal(); } if ( error >= 0 ) { fprintf(msgFile, "\n\n fatal error at front %d\n", error) ; spoolesFatal(); } /* -------------------------------------- STEP 7: post-process the factorization -------------------------------------- */ FrontMtx_postProcess(frontmtx, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n factor matrix after post-processing") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------- STEP 8: read the right hand side matrix B ----------------------------------------- */ if ( (inputFile = fopen(rhsFileName, "r")) == NULL ) { fprintf(stderr, "\n unable to open file %s", rhsFileName) ; spoolesFatal(); } fscanf(inputFile, "%d %d", &nrow, &nrhs) ; mtxB = DenseMtx_new() ; DenseMtx_init(mtxB, type, 0, 0, neqns, nrhs, 1, neqns) ; DenseMtx_zero(mtxB) ; if ( type == SPOOLES_REAL ) { for ( irow = 0 ; irow < nrow ; irow++ ) { fscanf(inputFile, "%d", &jrow) ; for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) { fscanf(inputFile, "%le", &value) ; DenseMtx_setRealEntry(mtxB, jrow, jrhs, value) ; } } } else { for ( irow = 0 ; irow < nrow ; irow++ ) { fscanf(inputFile, "%d", &jrow) ; for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) { fscanf(inputFile, "%le %le", &real, &imag) ; DenseMtx_setComplexEntry(mtxB, jrow, jrhs, real, imag) ; } } } fclose(inputFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n rhs matrix in original ordering") ; DenseMtx_writeForHumanEye(mtxB, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* -------------------------------------------------------------- STEP 9: permute the right hand side into the original ordering -------------------------------------------------------------- */ DenseMtx_permuteRows(mtxB, oldToNewIV) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n right hand side matrix in new ordering") ; DenseMtx_writeForHumanEye(mtxB, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* -------------------------------------------------------- STEP 10: get the solve map object for the parallel solve -------------------------------------------------------- */ solvemap = SolveMap_new() ; SolveMap_ddMap(solvemap, type, FrontMtx_upperBlockIVL(frontmtx), FrontMtx_lowerBlockIVL(frontmtx), nthread, ownersIV, FrontMtx_frontTree(frontmtx), seed, msglvl, msgFile) ; /*--------------------------------------------------------------------*/ /* -------------------------------------------- STEP 11: solve the linear system in parallel -------------------------------------------- */ mtxX = DenseMtx_new() ; DenseMtx_init(mtxX, type, 0, 0, neqns, nrhs, 1, neqns) ; DenseMtx_zero(mtxX) ; FrontMtx_MT_solve(frontmtx, mtxX, mtxB, mtxmanager, solvemap, cpus, msglvl, msgFile) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n solution matrix in new ordering") ; DenseMtx_writeForHumanEye(mtxX, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* -------------------------------------------------------- STEP 12: permute the solution into the original ordering -------------------------------------------------------- */ DenseMtx_permuteRows(mtxX, newToOldIV) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n\n solution matrix in original ordering") ; DenseMtx_writeForHumanEye(mtxX, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ /* ----------- free memory ----------- */ FrontMtx_free(frontmtx) ; DenseMtx_free(mtxX) ; DenseMtx_free(mtxB) ; IV_free(newToOldIV) ; IV_free(oldToNewIV) ; InpMtx_free(mtxA) ; ETree_free(frontETree) ; IVL_free(symbfacIVL) ; SubMtxManager_free(mtxmanager) ; Graph_free(graph) ; SolveMap_free(solvemap) ; IV_free(ownersIV) ; /*--------------------------------------------------------------------*/ return(1) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* ----------------------------------------------------- test the factor method for a grid matrix (0) read in matrix from source file (1) conver data matrix to InpMtx object if necessary (2) create Graph and ETree object if necessary (3) read in/create an ETree object (4) create a solution matrix object (5) multiply the solution with the matrix to get a right hand side matrix object (6) factor the matrix (7) solve the system created -- 98dec30, jwu ----------------------------------------------------- */ { char etreeFileName[80], mtxFileName[80], *cpt, rhsFileName[80], srcFileName[80], ctemp[81], msgFileName[80], slnFileName[80] ; Chv *chv, *rootchv ; ChvManager *chvmanager ; DenseMtx *mtxB, *mtxQ, *mtxX, *mtxZ ; double one[2] = { 1.0, 0.0 } ; FrontMtx *frontmtx ; InpMtx *mtxA ; SubMtxManager *mtxmanager ; double cputotal, droptol, conv_tol, factorops ; double cpus[9] ; Drand drand ; double nops, tau, t1, t2 ; ETree *frontETree ; Graph *graph ; FILE *msgFile, *inFile ; int error, loc, msglvl, neqns, nzf, iformat, pivotingflag, rc, seed, sparsityflag, symmetryflag, method[METHODS], type, nrhs, etreeflag ; int stats[6] ; int nnzA, Ik, itermax, zversion, iterout ; IV *newToOldIV, *oldToNewIV ; IVL *symbfacIVL ; int i, j, k, m, n, imethod, maxdomainsize, maxzeros, maxsize; int nouter,ninner ; if ( argc != 2 ) { fprintf(stdout, "\n\n usage : %s inFile" "\n inFile -- input filename" "\n", argv[0]) ; return(-1) ; } /* read input file */ inFile = fopen(argv[1], "r"); if (inFile == (FILE *)NULL) { fprintf(stderr, "\n fatal error in %s: unable to open file %s\n", argv[0], argv[1]) ; return(-1) ; } for (i=0; i<METHODS; i++) method[i]=-1; imethod=0; k=0; while (1) { fgets(ctemp, 80, inFile); if (ctemp[0] != '*') { /*printf("l=%2d:%s\n", strlen(ctemp),ctemp);*/ if (strlen(ctemp)==80) { fprintf(stderr, "\n fatal error in %s: input line contains more than " "80 characters.\n",argv[0]); exit(-1); } if (k==0) { sscanf(ctemp, "%d", &iformat); if (iformat < 0 || iformat > 2) { fprintf(stderr, "\n fatal error in %s: " "invalid source matrix format\n",argv[0]) ; return(-1) ; } } else if (k==1) sscanf(ctemp, "%s", srcFileName); else if (k==2) sscanf(ctemp, "%s", mtxFileName); else if (k==3) { sscanf(ctemp, "%d", &etreeflag); if (etreeflag < 0 || etreeflag > 4) { fprintf(stderr, "\n fatal error in %s: " "invalid etree file status\n",argv[0]) ; return(-1) ; } } else if (k==4) sscanf(ctemp, "%s", etreeFileName); else if (k==5) sscanf(ctemp, "%s", rhsFileName); else if (k==6) sscanf(ctemp, "%s", slnFileName); else if (k==7){ sscanf(ctemp, "%s", msgFileName); if ( strcmp(msgFileName, "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(msgFileName, "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], ctemp) ; return(-1) ; } } else if (k==8) sscanf(ctemp, "%d %d %d %d %d %d", &msglvl, &seed, &nrhs, &Ik, &itermax, &iterout); else if (k==9) sscanf(ctemp, "%d %d %d", &symmetryflag, &sparsityflag, &pivotingflag); else if (k==10) sscanf(ctemp, "%lf %lf %lf", &tau, &droptol, &conv_tol); else if (k==11) { /* for (j=0; j<strlen(ctemp); j++) { printf("j=%2d:%s",j,ctemp+j); if (ctemp[j] == ' ' && ctemp[j+1] != ' ') { sscanf(ctemp+j, "%d", method+imethod); printf("method[%d]=%d\n",imethod,method[imethod]); if (method[imethod] < 0) break; imethod++; } } */ imethod = sscanf(ctemp,"%d %d %d %d %d %d %d %d %d %d", method, method+1, method+2, method+3, method+4, method+5, method+6, method+7, method+8, method+9); /*printf("imethod=%d\n",imethod);*/ for (j=0; j<imethod; j++) { /*printf("method[%d]=%d\n",j,method[j]);*/ if (method[j]<0) { imethod=j; break; } } if (imethod == 0) { fprintf(msgFile,"No method assigned in input file\n"); return(-1); } } k++; } if (k==12) break; } fclose(inFile); /* reset nrhs to 1 */ if (nrhs > 1) { fprintf(msgFile,"*** Multiple right-hand-side vectors is not allowed yet.\n"); fprintf(msgFile,"*** nrhs is reset to 1.\n"); nrhs =1; } fprintf(msgFile, "\n %s " "\n srcFileName -- %s" "\n mtxFileName -- %s" "\n etreeFileName -- %s" "\n rhsFileName -- %s" "\n msglvl -- %d" "\n seed -- %d" "\n symmetryflag -- %d" "\n sparsityflag -- %d" "\n pivotingflag -- %d" "\n tau -- %e" "\n droptol -- %e" "\n conv_tol -- %e" "\n method -- ", argv[0], srcFileName, mtxFileName, etreeFileName, rhsFileName, msglvl, seed, symmetryflag, sparsityflag, pivotingflag, tau, droptol, conv_tol) ; for (k=0; k<imethod; k++) fprintf(msgFile, "%d ", method[k]); fprintf(msgFile, "\n ", method[k]); fflush(msgFile) ; /* -------------------------------------- initialize the random number generator -------------------------------------- */ Drand_setDefaultFields(&drand) ; Drand_init(&drand) ; Drand_setSeed(&drand, seed) ; /*Drand_setUniform(&drand, 0.0, 1.0) ;*/ Drand_setNormal(&drand, 0.0, 1.0) ; /* ---------------------------------------------- read in or convert source to the InpMtx object ---------------------------------------------- */ rc = 1; if ( strcmp(srcFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(-1) ; } mtxA = InpMtx_new() ; MARKTIME(t1) ; if (iformat == 0) { /* InpMtx source format */ rc = InpMtx_readFromFile(mtxA, srcFileName) ; strcpy(mtxFileName, srcFileName); if ( rc != 1 ) fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)", rc, mtxA, srcFileName) ; } else if (iformat == 1) { /* HBF source format */ rc = InpMtx_readFromHBfile(mtxA, srcFileName) ; if ( rc != 1 ) fprintf(msgFile, "\n return value %d from InpMtx_readFromHBfile(%p,%s)", rc, mtxA, srcFileName) ; } else { /* AIJ2 source format */ rc = InpMtx_readFromAIJ2file(mtxA, srcFileName) ; if ( rc != 1 ) fprintf(msgFile, "\n return value %d from InpMtx_readFromAIJ2file(%p,%s)", rc, mtxA, srcFileName) ; } MARKTIME(t2) ; if (iformat>0 && strcmp(mtxFileName, "none") != 0 ) { rc = InpMtx_writeToFile(mtxA, mtxFileName) ; if ( rc != 1 ) fprintf(msgFile, "\n return value %d from InpMtx_writeToFile(%p,%s)", rc, mtxA, mtxFileName) ; } fprintf(msgFile, "\n CPU %8.3f : read in (+ convert to) mtxA from file %s", t2 - t1, mtxFileName) ; if (rc != 1) { goto end_read; } type = mtxA->inputMode ; neqns = 1 + IVmax(mtxA->nent, InpMtx_ivec1(mtxA), &loc) ; if ( INPMTX_IS_BY_ROWS(mtxA) ) { fprintf(msgFile, "\n matrix coordinate type is rows") ; } else if ( INPMTX_IS_BY_COLUMNS(mtxA) ) { fprintf(msgFile, "\n matrix coordinate type is columns") ; } else if ( INPMTX_IS_BY_CHEVRONS(mtxA) ) { fprintf(msgFile, "\n matrix coordinate type is chevrons") ; } else { fprintf(msgFile, "\n\n, error, bad coordinate type") ; rc=-1; goto end_read; } if ( INPMTX_IS_RAW_DATA(mtxA) ) { fprintf(msgFile, "\n matrix storage mode is raw data\n") ; } else if ( INPMTX_IS_SORTED(mtxA) ) { fprintf(msgFile, "\n matrix storage mode is sorted\n") ; } else if ( INPMTX_IS_BY_VECTORS(mtxA) ) { fprintf(msgFile, "\n matrix storage mode is by vectors\n") ; } else { fprintf(msgFile, "\n\n, error, bad storage mode") ; rc=-1; goto end_read; } if ( msglvl > 1 ) { fprintf(msgFile, "\n\n after reading InpMtx object from file %s", mtxFileName) ; if ( msglvl == 2 ) { InpMtx_writeStats(mtxA, msgFile) ; } else { InpMtx_writeForHumanEye(mtxA, msgFile) ; } fflush(msgFile) ; } /* Get the nonzeros in matrix A and print it */ nnzA = InpMtx_nent( mtxA ); fprintf(msgFile, "\n\n Input matrix size %d NNZ %d", neqns, nnzA) ; /* -------------------------------------------------------- generate the linear system 1. generate solution matrix and fill with random numbers 2. generate rhs matrix and fill with zeros 3. compute matrix-matrix multiply -------------------------------------------------------- */ MARKTIME(t1) ; mtxX = DenseMtx_new() ; DenseMtx_init(mtxX, type, 0, -1, neqns, nrhs, 1, neqns) ; mtxB = DenseMtx_new() ; if (strcmp(rhsFileName, "none")) { rc = DenseMtx_readFromFile(mtxB, rhsFileName) ; if ( rc != 1 ) fprintf(msgFile, "\n return value %d from DenseMtx_readFromFile(%p,%s)", rc, mtxB, rhsFileName) ; DenseMtx_zero(mtxX) ; } else { DenseMtx_init(mtxB, type, 1, -1, neqns, nrhs, 1, neqns) ; DenseMtx_fillRandomEntries(mtxX, &drand) ; DenseMtx_zero(mtxB) ; switch ( symmetryflag ) { case SPOOLES_SYMMETRIC : InpMtx_sym_mmm(mtxA, mtxB, one, mtxX) ; break ; case SPOOLES_HERMITIAN : InpMtx_herm_mmm(mtxA, mtxB, one, mtxX) ; break ; case SPOOLES_NONSYMMETRIC : InpMtx_nonsym_mmm(mtxA, mtxB, one, mtxX) ; break ; default : break ; } } MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : set up the solution and rhs ", t2 - t1) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n original mtxX") ; DenseMtx_writeForHumanEye(mtxX, msgFile) ; fprintf(msgFile, "\n\n original mtxB") ; DenseMtx_writeForHumanEye(mtxB, msgFile) ; fflush(msgFile) ; } if (rc != 1) { InpMtx_free(mtxA); DenseMtx_free(mtxX); DenseMtx_free(mtxB); goto end_init; } /* ------------------------ read in/create the ETree object ------------------------ */ MARKTIME(t1) ; if (etreeflag == 0) { /* read in ETree from file */ if ( strcmp(etreeFileName, "none") == 0 ) fprintf(msgFile, "\n no file to read from") ; frontETree = ETree_new() ; rc = ETree_readFromFile(frontETree, etreeFileName) ; if (rc!=1) fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)", rc, frontETree, etreeFileName) ; } else { graph = Graph_new() ; rc = InpMtx_createGraph(mtxA, graph); if (rc!=1) { fprintf(msgFile, "\n return value %d from InpMtx_createGraph(%p,%p)", rc, mtxA, graph) ; Graph_free(graph); goto end_tree; } if (etreeflag == 1) { /* Via BestOfNDandMS */ maxdomainsize = 500; maxzeros = 1000; maxsize = 64 ; frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, maxzeros, maxsize, seed, msglvl, msgFile) ; } else if (etreeflag == 2) { /* Via MMD */ frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ; } else if (etreeflag == 3) { /* Via MS */ maxdomainsize = 500; frontETree = orderViaMS(graph, maxdomainsize, seed, msglvl, msgFile) ; } else if (etreeflag == 4) { /* Via ND */ maxdomainsize = 500; frontETree = orderViaND(graph, maxdomainsize, seed, msglvl, msgFile) ; } Graph_free(graph); /* optionally write out the ETree object */ if ( strcmp(etreeFileName, "none") != 0 ) { fprintf(msgFile, "\n\n writing out ETree to file %s", etreeFileName) ; ETree_writeToFile(frontETree, etreeFileName) ; } } MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : read in/create frontETree from file %s", t2 - t1, etreeFileName) ; if ( rc != 1 ) { ETree_free(frontETree); goto end_tree; } ETree_leftJustify(frontETree) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n after reading ETree object from file %s", etreeFileName) ; if ( msglvl == 2 ) { ETree_writeStats(frontETree, msgFile) ; } else { ETree_writeForHumanEye(frontETree, msgFile) ; } } fflush(msgFile) ; /* -------------------------------------------------- get the permutations, permute the matrix and the front tree, and compute the symbolic factorization -------------------------------------------------- */ MARKTIME(t1) ; oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ; newToOldIV = ETree_newToOldVtxPerm(frontETree) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : get permutations", t2 - t1) ; MARKTIME(t1) ; ETree_permuteVertices(frontETree, oldToNewIV) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : permute front tree", t2 - t1) ; MARKTIME(t1) ; InpMtx_permute(mtxA, IV_entries(oldToNewIV), IV_entries(oldToNewIV)) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : permute mtxA", t2 - t1) ; if ( symmetryflag == SPOOLES_SYMMETRIC || symmetryflag == SPOOLES_HERMITIAN ) { MARKTIME(t1) ; InpMtx_mapToUpperTriangle(mtxA) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : map to upper triangle", t2 - t1) ; } if ( ! INPMTX_IS_BY_CHEVRONS(mtxA) ) { MARKTIME(t1) ; InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : change coordinate type", t2 - t1) ; } if ( INPMTX_IS_RAW_DATA(mtxA) ) { MARKTIME(t1) ; InpMtx_changeStorageMode(mtxA, INPMTX_SORTED) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : sort entries ", t2 - t1) ; } if ( INPMTX_IS_SORTED(mtxA) ) { MARKTIME(t1) ; InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : convert to vectors ", t2 - t1) ; } MARKTIME(t1) ; symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : symbolic factorization", t2 - t1) ; MARKTIME(t1) ; DenseMtx_permuteRows(mtxB, oldToNewIV) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : permute rhs", t2 - t1) ; /* ------------------------------ initialize the FrontMtx object ------------------------------ */ MARKTIME(t1) ; frontmtx = FrontMtx_new() ; mtxmanager = SubMtxManager_new() ; SubMtxManager_init(mtxmanager, NO_LOCK, 0) ; FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, symmetryflag, sparsityflag, pivotingflag, NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ; MARKTIME(t2) ; fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix", t2 - t1) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n nendD = %d, nentL = %d, nentU = %d", frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ; SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n front matrix initialized") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } /* ----------------- factor the matrix ----------------- */ nzf = ETree_nFactorEntries(frontETree, symmetryflag) ; factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ; fprintf(msgFile, "\n %d factor entries, %.0f factor ops, %8.3f ratio", nzf, factorops, factorops/nzf) ; IVzero(6, stats) ; DVzero(9, cpus) ; chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, NO_LOCK, 1) ; MARKTIME(t1) ; rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol, chvmanager, &error, cpus, stats, msglvl, msgFile) ; MARKTIME(t2) ; fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops", t2 - t1, 1.e-6*factorops/(t2-t1)) ; if ( rootchv != NULL ) { fprintf(msgFile, "\n\n factorization did not complete") ; for ( chv = rootchv ; chv != NULL ; chv = chv->next ) { fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d", chv->id, chv->nD, chv->nL, chv->nU) ; } } if ( error >= 0 ) { fprintf(msgFile, "\n\n error encountered at front %d\n", error) ; rc=error ; goto end_front; } fprintf(msgFile, "\n %8d pivots, %8d pivot tests, %8d delayed rows and columns", stats[0], stats[1], stats[2]) ; if ( frontmtx->rowadjIVL != NULL ) { fprintf(msgFile, "\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ; } if ( frontmtx->coladjIVL != NULL ) { fprintf(msgFile, ", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ; } if ( frontmtx->upperblockIVL != NULL ) { fprintf(msgFile, "\n %d fronts, %d entries in upperblockIVL", frontmtx->nfront, frontmtx->upperblockIVL->tsize) ; } if ( frontmtx->lowerblockIVL != NULL ) { fprintf(msgFile, ", %d entries in lowerblockIVL", frontmtx->lowerblockIVL->tsize) ; } fprintf(msgFile, "\n %d entries in D, %d entries in L, %d entries in U", stats[3], stats[4], stats[5]) ; fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ; if ( FRONTMTX_IS_SYMMETRIC(frontmtx) || FRONTMTX_IS_HERMITIAN(frontmtx) ) { int nneg, npos, nzero ; FrontMtx_inertia(frontmtx, &nneg, &nzero, &npos) ; fprintf(msgFile, "\n %d negative, %d zero and %d positive eigenvalues", nneg, nzero, npos) ; fflush(msgFile) ; } cputotal = cpus[8] ; if ( cputotal > 0.0 ) { fprintf(msgFile, "\n initialize fronts %8.3f %6.2f" "\n load original entries %8.3f %6.2f" "\n update fronts %8.3f %6.2f" "\n assemble postponed data %8.3f %6.2f" "\n factor fronts %8.3f %6.2f" "\n extract postponed data %8.3f %6.2f" "\n store factor entries %8.3f %6.2f" "\n miscellaneous %8.3f %6.2f" "\n total time %8.3f", cpus[0], 100.*cpus[0]/cputotal, cpus[1], 100.*cpus[1]/cputotal, cpus[2], 100.*cpus[2]/cputotal, cpus[3], 100.*cpus[3]/cputotal, cpus[4], 100.*cpus[4]/cputotal, cpus[5], 100.*cpus[5]/cputotal, cpus[6], 100.*cpus[6]/cputotal, cpus[7], 100.*cpus[7]/cputotal, cputotal) ; } if ( msglvl > 1 ) { SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ; ChvManager_writeForHumanEye(chvmanager, msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front factor matrix") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; } /* ------------------------------ post-process the factor matrix ------------------------------ */ MARKTIME(t1) ; FrontMtx_postProcess(frontmtx, msglvl, msgFile) ; MARKTIME(t2) ; fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front factor matrix after post-processing") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; } fprintf(msgFile, "\n\n after post-processing") ; if ( msglvl > 1 ) SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ; /* ---------------- solve the system ---------------- */ neqns = mtxB->nrow ; mtxZ = DenseMtx_new() ; DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ; zversion=INPMTX_IS_COMPLEX_ENTRIES(mtxA); for (k=0; k<imethod; k++) { DenseMtx_zero(mtxZ) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n rhs") ; DenseMtx_writeForHumanEye(mtxB, msgFile) ; fflush(stdout) ; } fprintf(msgFile, "\n\n itemax %d", itermax) ; DVzero(6, cpus) ; MARKTIME(t1) ; switch ( method[k] ) { case BiCGStabR : if (zversion) rc=zbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=bicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case BiCGStabL : if (zversion) rc=zbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=bicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case TFQMRR : if (zversion) rc=ztfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=tfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case TFQMRL : if (zversion) rc=ztfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=tfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case PCGR : if (zversion) rc=zpcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=pcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case PCGL : if (zversion) rc=zpcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=pcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); break; case MLBiCGStabR : mtxQ = DenseMtx_new() ; DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ; Drand_setUniform(&drand, 0.0, 1.0) ; DenseMtx_fillRandomEntries(mtxQ, &drand) ; if (zversion) rc=zmlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=mlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); DenseMtx_free(mtxQ) ; break; case MLBiCGStabL : mtxQ = DenseMtx_new() ; DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ; Drand_setUniform(&drand, 0.0, 1.0) ; DenseMtx_fillRandomEntries(mtxQ, &drand) ; if (zversion) rc=zmlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); else rc=mlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ, mtxB, itermax, conv_tol, msglvl, msgFile); DenseMtx_free(mtxQ) ; break; case BGMRESR: if (zversion) fprintf(msgFile, "\n\n *** BGMRESR complex version is not available " "at this moment. ") ; else rc=bgmresr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, iterout, itermax, &nouter, &ninner, conv_tol, msglvl, msgFile); break; case BGMRESL: if (zversion) fprintf(msgFile, "\n\n *** BGMRESR complex version is not available " "at this moment. ") ; else rc=bgmresl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB, iterout, itermax, &nouter, &ninner, conv_tol, msglvl, msgFile); break; default: fprintf(msgFile, "\n\n *** Invalid method number ") ; } MARKTIME(t2) ; fprintf(msgFile, "\n\n CPU %8.3f : solve the system", t2 - t1) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n computed solution") ; DenseMtx_writeForHumanEye(mtxZ, msgFile) ; fflush(stdout) ; } /* ------------------------------------------------------------- permute the computed solution back into the original ordering ------------------------------------------------------------- */ MARKTIME(t1) ; DenseMtx_permuteRows(mtxZ, newToOldIV) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %8.3f : permute solution", t2 - t1) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n permuted solution") ; DenseMtx_writeForHumanEye(mtxZ, msgFile) ; fflush(stdout) ; } /* ------------- save solution ------------- */ if ( strcmp(slnFileName, "none") != 0 ) { DenseMtx_writeToFile(mtxZ, slnFileName) ; } /* ----------------- compute the error ----------------- */ if (!strcmp(rhsFileName, "none")) { DenseMtx_sub(mtxZ, mtxX) ; if (method[k] <8) { mtxQ = DenseMtx_new() ; DenseMtx_init(mtxQ, type, 0, -1, neqns, 1, 1, neqns) ; rc=DenseMtx_initAsSubmatrix (mtxQ, mtxZ, 0, neqns-1, 0, 0); fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxQ)) ; DenseMtx_free(mtxQ) ; } else fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n error") ; DenseMtx_writeForHumanEye(mtxZ, msgFile) ; fflush(stdout) ; } if ( msglvl > 1 ) SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ; } fprintf(msgFile, "\n--------- End of Method %d -------\n",method[k]) ; } /* ------------------------ free the working storage ------------------------ */ DenseMtx_free(mtxZ) ; end_front: ChvManager_free(chvmanager) ; SubMtxManager_free(mtxmanager) ; FrontMtx_free(frontmtx) ; IVL_free(symbfacIVL) ; IV_free(oldToNewIV) ; IV_free(newToOldIV) ; end_tree: ETree_free(frontETree) ; end_init: DenseMtx_free(mtxB) ; DenseMtx_free(mtxX) ; end_read: InpMtx_free(mtxA) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(rc) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* ---------------------------------------- draw the tree created -- 99jan23, cca ---------------------------------------- */ { char coordflag, heightflag ; char *inTagsFileName, *inTreeFileName, *outEPSfileName ; double fontsize, radius, t1, t2 ; double bbox[4], frame[4] ; DV *xDV, *yDV ; int ierr, msglvl, rc, tagsflag ; IV *tagsIV ; Tree *tree ; FILE *msgFile ; if ( argc != 19 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile inTreeFile inTagsFile outEPSfile " "\n heightflag coordflag radius bbox[4] frame[4] tagflag fontsize" "\n msglvl -- message level" "\n msgFile -- message file" "\n inTreeFile -- input file, must be *.treef or *.treeb" "\n inTagsFile -- input file, must be *.ivf or *.ivb or none" "\n outEPSfile -- output file" "\n heightflag -- height flag" "\n 'D' -- use depth metric" "\n 'H' -- use height metric" "\n coordflag -- coordinate flag" "\n 'C' -- use (x,y) Cartesian coordinates" "\n 'P' -- use (r,theta) polar coordinates" "\n radius -- radius of node" "\n bbox[4] -- bounding box" "\n frame[4] -- frame for plot" "\n fontsize -- size of fonts (in points)" "\n tagflag -- if 1, draw labels, otherwise, do not" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } inTreeFileName = argv[3] ; inTagsFileName = argv[4] ; outEPSfileName = argv[5] ; heightflag = argv[6][0] ; coordflag = argv[7][0] ; radius = atof(argv[8]) ; bbox[0] = atof(argv[9]) ; bbox[1] = atof(argv[10]) ; bbox[2] = atof(argv[11]) ; bbox[3] = atof(argv[12]) ; frame[0] = atof(argv[13]) ; frame[1] = atof(argv[14]) ; frame[2] = atof(argv[15]) ; frame[3] = atof(argv[16]) ; fontsize = atof(argv[17]) ; tagsflag = atoi(argv[18]) ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n inTreeFile -- %s" "\n inTagsFile -- %s" "\n outEPSfile -- %s" "\n heightflag -- %c" "\n coordflag -- %d" "\n radius -- %.3g" "\n bbox -- %.3g %.3g %.3g %.3g" "\n frame -- %.3g %.3g %.3g %.3g" "\n fontsize -- %.3g" "\n", argv[0], msglvl, argv[2], inTreeFileName, inTagsFileName, outEPSfileName, heightflag, coordflag, radius, bbox[0], bbox[1], bbox[2], bbox[3], frame[0], frame[1], frame[2], frame[3], fontsize, tagsflag) ; fflush(msgFile) ; /* ------------------------ read in the Tree object ------------------------ */ if ( strcmp(inTreeFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } tree = Tree_new() ; MARKTIME(t1) ; rc = Tree_readFromFile(tree, inTreeFileName) ; /* Tree_setFchSibRoot(tree) ; */ Tree_leftJustify(tree) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in tree from file %s", t2 - t1, inTreeFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from Tree_readFromFile(%p,%s)", rc, tree, inTreeFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading Tree object from file %s", inTreeFileName) ; if ( msglvl > 2 ) { Tree_writeForHumanEye(tree, msgFile) ; } else { Tree_writeStats(tree, msgFile) ; } fflush(msgFile) ; if ( Tree_maxNchild(tree) > 2 ) { fprintf(msgFile, "\n\n maximum number of children = %d", Tree_maxNchild(tree)) ; } if ( strcmp(inTagsFileName, "none") != 0 ) { /* -------------------------- read in the tags IV object -------------------------- */ tagsIV = IV_new() ; MARKTIME(t1) ; rc = IV_readFromFile(tagsIV, inTagsFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in tagsIV from file %s", t2 - t1, inTagsFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)", rc, tagsIV, inTagsFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading IV object from file %s", inTagsFileName) ; if ( msglvl > 2 ) { IV_writeForHumanEye(tagsIV, msgFile) ; } else { IV_writeStats(tagsIV, msgFile) ; } fflush(msgFile) ; if ( IV_size(tagsIV) != tree->n ) { fprintf(stderr, "\n fatal error, IV_size(tagsIV) = %d, tree->n = %d", IV_size(tagsIV), tree->n) ; exit(-1) ; } } else { tagsIV = NULL ; } /* ------------------------------- get the coordinates of the tree ------------------------------- */ xDV = DV_new() ; yDV = DV_new() ; rc = Tree_getSimpleCoords(tree, heightflag, coordflag, xDV, yDV) ; if ( rc != 1 ) { fprintf(stderr, "\n error return %d from Tree_getSimpleCoords()",rc); exit(-1) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n\n x-coordinates") ; DV_writeForHumanEye(xDV, msgFile) ; fprintf(msgFile, "\n\n y-coordinates") ; DV_writeForHumanEye(yDV, msgFile) ; fflush(msgFile) ; } /* ------------- draw the Tree ------------- */ rc = Tree_drawToEPS(tree, outEPSfileName, xDV, yDV, radius, NULL, tagsflag, fontsize, tagsIV, bbox, frame, NULL) ; if ( rc != 1 ) { fprintf(stderr, "\n error return %d from Tree_drawToEPSfile()", rc) ; exit(-1) ; } /* --------------------- free the Tree object --------------------- */ Tree_free(tree) ; if ( tagsIV != NULL ) { IV_free(tagsIV) ; } fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
/* -------------------------------------------------------------------- purpose -- to fill submtx with a submatrix of the front matrix. the fronts that form the submatrix are found in frontidsIV. all information in submtx is local, front #'s are from 0 to one less than the number of fronts in the submatrix, equation #'s are from 0 to one less than the number of rows and columns in the submatrix. the global row and column ids for the submatrix are stored in rowsIV and colsIV on return. return values --- 1 -- normal return -1 -- submtx is NULL -2 -- frontmtx is NULL -3 -- frontmtx is not in 2-D mode -4 -- frontidsIV is NULL -5 -- frontidsIV is invalid -6 -- rowsIV is NULL -7 -- colsIV is NULL -8 -- unable to create front tree -9 -- unable to create symbfacIVL -10 -- unable to create coladjIVL -11 -- unable to create rowadjIVL -12 -- unable to create upperblockIVL -13 -- unable to create lowerblockIVL created -- 98oct17, cca -------------------------------------------------------------------- */ int FrontMtx_initFromSubmatrix ( FrontMtx *submtx, FrontMtx *frontmtx, IV *frontidsIV, IV *rowsIV, IV *colsIV, int msglvl, FILE *msgFile ) { ETree *etreeSub ; int ii, J, Jsub, K, Ksub, ncol, nfront, nfrontSub, neqnSub, nJ, nrow, offset, rc, size, vSub ; int *bndwghts, *colind, *colmap, *cols, *frontSubIds, *list, *nodwghts, *rowind, *rowmap, *rows ; IV *frontsizesIVsub, *vtxIV ; IVL *coladjIVLsub, *lowerblockIVLsub, *rowadjIVLsub, *symbfacIVLsub, *upperblockIVLsub ; SubMtx *mtx ; /* --------------- check the input --------------- */ if ( submtx == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n submtx is NULL\n") ; return(-1) ; } if ( frontmtx == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontmtx is NULL\n") ; return(-2) ; } if ( ! FRONTMTX_IS_2D_MODE(frontmtx) ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontmtx mode is not 2D\n") ; return(-3) ; } if ( frontidsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontidsIV is NULL\n") ; return(-4) ; } nfront = FrontMtx_nfront(frontmtx) ; IV_sizeAndEntries(frontidsIV, &nfrontSub, &frontSubIds) ; if ( nfrontSub < 0 || nfrontSub > nfront ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n invalid frontidsIV" "\n nfrontSub = %d, nfront %d\n", nfrontSub, nfront) ; return(-5) ; } for ( ii = 0 ; ii < nfrontSub ; ii++ ) { if ( (J = frontSubIds[ii]) < 0 || J >= nfront ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n invalid frontidsIV" "\n frontSubIds[%d] = %d, nfront = %d\n", ii, J, nfront) ; return(-5) ; } } if ( rowsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n rowsIV is NULL\n") ; return(-6) ; } if ( colsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n colsIV is NULL\n") ; return(-7) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------------------- clear the data for the submatrix and set the scalar values (some inherited from the global matrix) ----------------------------------------------------- */ FrontMtx_clearData(submtx) ; submtx->nfront = nfrontSub ; submtx->type = frontmtx->type ; submtx->symmetryflag = frontmtx->symmetryflag ; submtx->sparsityflag = frontmtx->sparsityflag ; submtx->pivotingflag = frontmtx->pivotingflag ; submtx->dataMode = FRONTMTX_2D_MODE ; /* --------------------------------------------------------------- initialize the front tree for the submatrix. note: on return, vtxIV is filled with the vertices originally in the submatrix, (pivoting may change this), needed to find symbolic factorization IVL object note: at return, the boundary weights are likely to be invalid, since we have no way of knowing what boundary indices for a front are really in the domain. this will be changed after we have the symbolic factorization. --------------------------------------------------------------- */ etreeSub = submtx->frontETree = ETree_new() ; vtxIV = IV_new() ; rc = ETree_initFromSubtree(etreeSub, frontidsIV, frontmtx->frontETree, vtxIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's front ETree, rc = %d\n", rc) ; return(-8) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix ETree") ; ETree_writeForHumanEye(etreeSub, msgFile) ; fprintf(msgFile, "\n\n submatrix original equations") ; IV_writeForHumanEye(vtxIV, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------ set the # of equations (perhap temporarily if pivoting has delayed some rows and columns), and the tree. ------------------------------------------------------ */ submtx->neqns = neqnSub = IV_size(vtxIV) ; submtx->tree = etreeSub->tree ; /* ----------------------------------------------------- initialize the symbolic factorization for the subtree ----------------------------------------------------- */ symbfacIVLsub = submtx->symbfacIVL = IVL_new() ; rc = IVL_initFromSubIVL(symbfacIVLsub, frontmtx->symbfacIVL, frontidsIV, vtxIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's symbfac, rc = %d\n", rc) ; return(-9) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix symbolic factorizatio") ; IVL_writeForHumanEye(symbfacIVLsub, msgFile) ; fflush(msgFile) ; } /* --------------------------------------------- adjust the boundary weights of the front tree --------------------------------------------- */ nodwghts = ETree_nodwghts(etreeSub) ; bndwghts = ETree_bndwghts(etreeSub) ; for ( J = 0 ; J < nfrontSub ; J++ ) { IVL_listAndSize(symbfacIVLsub, J, &size, &list) ; bndwghts[J] = size - nodwghts[J] ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix ETree after bndweight adjustment") ; ETree_writeForHumanEye(etreeSub, msgFile) ; fflush(msgFile) ; } /* ------------------------------------- set the front sizes for the submatrix ------------------------------------- */ frontsizesIVsub = submtx->frontsizesIV = IV_new() ; IV_init(frontsizesIVsub, nfrontSub, NULL) ; IVgather(nfrontSub, IV_entries(frontsizesIVsub), IV_entries(frontmtx->frontsizesIV), IV_entries(frontidsIV)) ; neqnSub = submtx->neqns = IV_sum(frontsizesIVsub) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n %d equations in submatrix", neqnSub) ; fprintf(msgFile, "\n\n front sizes for submatrix") ; IV_writeForHumanEye(frontsizesIVsub, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------------------- fill rowsIV and colsIV with the row and column ids of the submatrix ------------------------------------------------------------------- */ IV_setSize(rowsIV, neqnSub) ; IV_setSize(colsIV, neqnSub) ; rows = IV_entries(rowsIV) ; cols = IV_entries(colsIV) ; for ( Jsub = offset = 0 ; Jsub < nfrontSub ; Jsub++ ) { if ( (nJ = FrontMtx_frontSize(submtx, Jsub)) > 0 ) { J = frontSubIds[Jsub] ; FrontMtx_columnIndices(frontmtx, J, &size, &list) ; IVcopy(nJ, cols + offset, list) ; FrontMtx_rowIndices(frontmtx, J, &size, &list) ; IVcopy(nJ, rows + offset, list) ; offset += nJ ; } } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n row ids for submatrix") ; IV_writeForHumanEye(rowsIV, msgFile) ; fprintf(msgFile, "\n\n column ids for submatrix") ; IV_writeForHumanEye(colsIV, msgFile) ; fflush(msgFile) ; } /* ---------------------------------- get the row and column adjacencies ---------------------------------- */ if ( FRONTMTX_IS_PIVOTING(frontmtx) ) { submtx->neqns = neqnSub ; coladjIVLsub = submtx->coladjIVL = IVL_new() ; rc = IVL_initFromSubIVL(coladjIVLsub, frontmtx->coladjIVL, frontidsIV, colsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's coladjIVL, rc = %d\n", rc) ; return(-10) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix col adjacency") ; IVL_writeForHumanEye(coladjIVLsub, msgFile) ; fflush(msgFile) ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { rowadjIVLsub = submtx->rowadjIVL = IVL_new() ; rc = IVL_initFromSubIVL(rowadjIVLsub, frontmtx->rowadjIVL, frontidsIV, rowsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's rowadjIVL, rc = %d\n", rc) ; return(-11) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix row adjacency") ; IVL_writeForHumanEye(rowadjIVLsub, msgFile) ; fflush(msgFile) ; } } } IV_free(vtxIV) ; /* ---------------------------------------------- get the rowmap[] and colmap[] vectors, needed to translate indices in the submatrices ---------------------------------------------- */ colmap = IVinit(frontmtx->neqns, -1) ; for ( ii = 0 ; ii < neqnSub ; ii++ ) { colmap[cols[ii]] = ii ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { rowmap = IVinit(frontmtx->neqns, -1) ; for ( ii = 0 ; ii < neqnSub ; ii++ ) { rowmap[rows[ii]] = ii ; } } else { rowmap = colmap ; } /* ----------------------------------------------------------- get the upper and lower block IVL objects for the submatrix ----------------------------------------------------------- */ upperblockIVLsub = submtx->upperblockIVL = IVL_new() ; rc = IVL_initFromSubIVL(upperblockIVLsub, frontmtx->upperblockIVL, frontidsIV, frontidsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create upperblockIVL, rc = %d\n", rc) ; return(-12) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n upper block adjacency IVL object") ; IVL_writeForHumanEye(upperblockIVLsub, msgFile) ; fflush(msgFile) ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { lowerblockIVLsub = submtx->lowerblockIVL = IVL_new() ; rc = IVL_initFromSubIVL(lowerblockIVLsub, frontmtx->lowerblockIVL, frontidsIV, frontidsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create lowerblockIVL, rc = %d\n", rc) ; return(-13) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n lower block adjacency IVL object") ; IVL_writeForHumanEye(lowerblockIVLsub, msgFile) ; fflush(msgFile) ; } } /* ---------------------------------------------------------------- allocate the vector and hash table(s) for the factor submatrices ---------------------------------------------------------------- */ ALLOCATE(submtx->p_mtxDJJ, struct _SubMtx *, nfrontSub) ; for ( J = 0 ; J < nfrontSub ; J++ ) { submtx->p_mtxDJJ[J] = NULL ; } submtx->upperhash = I2Ohash_new() ; I2Ohash_init(submtx->upperhash, nfrontSub, nfrontSub, nfrontSub) ; if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { submtx->lowerhash = I2Ohash_new() ; I2Ohash_init(submtx->lowerhash, nfrontSub, nfrontSub, nfrontSub) ; } /* ----------------------------------------------------------------- remove the diagonal submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values, and the row and column indices must be mapped to local indices. ----------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; if ( (mtx = frontmtx->p_mtxDJJ[J]) != NULL ) { SubMtx_setIds(mtx, Jsub, Jsub) ; SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; submtx->p_mtxDJJ[Jsub] = mtx ; frontmtx->p_mtxDJJ[J] = NULL ; submtx->nentD += mtx->nent ; } } /* ---------------------------------------------------------------- remove the upper triangular submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values. if the matrix is on the diagonal, i.e., U(J,J), its row and column indices must be mapped to local indices. ---------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; FrontMtx_upperAdjFronts(submtx, Jsub, &size, &list) ; for ( ii = 0 ; ii < size ; ii++ ) { Ksub = list[ii] ; K = frontSubIds[Ksub] ; if ( 1 == I2Ohash_remove(frontmtx->upperhash, J, K, (void *) &mtx) ) { SubMtx_setIds(mtx, Jsub, Ksub) ; if ( K == J ) { SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; } I2Ohash_insert(submtx->upperhash, Jsub, Ksub, (void *) mtx) ; submtx->nentU += mtx->nent ; } } } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { /* ---------------------------------------------------------------- remove the lower triangular submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values. if the matrix is on the diagonal, i.e., L(J,J), its row and column indices must be mapped to local indices. ---------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; FrontMtx_lowerAdjFronts(submtx, Jsub, &size, &list) ; for ( ii = 0 ; ii < size ; ii++ ) { Ksub = list[ii] ; K = frontSubIds[Ksub] ; if ( 1 == I2Ohash_remove(frontmtx->lowerhash, K, J, (void *) &mtx) ) { SubMtx_setIds(mtx, Ksub, Jsub) ; if ( K == J ) { SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; } I2Ohash_insert(submtx->lowerhash, Ksub, Jsub, (void *) mtx); submtx->nentL += mtx->nent ; } } } } /* ------------------------ free the working storage ------------------------ */ IVfree(colmap) ; if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { IVfree(rowmap) ; } return(1) ; }
/* ------------------------------------------------------------------ purpose -- return an ETree object for a nested dissection ordering graph -- graph to order maxdomainsize -- used to control the incomplete nested dissection process. any subgraph whose weight is less than maxdomainsize is not split further. seed -- random number seed msglvl -- message level, 0 --> no output, 1 --> timings msgFile -- message file created -- 97nov06, cca ------------------------------------------------------------------ */ ETree * orderViaND ( Graph *graph, int maxdomainsize, int seed, int msglvl, FILE *msgFile ) { double t1, t2 ; DSTree *dstree ; ETree *etree ; int nvtx, Nvtx ; IV *eqmapIV, *stagesIV ; /* --------------- check the input --------------- */ if ( graph == NULL || maxdomainsize <= 0 || (msglvl > 0 && msgFile == NULL) ) { fprintf(stderr, "\n fatal error in orderViaND(%p,%d,%d,%d,%p)" "\n bad input\n", graph, maxdomainsize, seed, msglvl, msgFile) ; exit(-1) ; } /* ------------------------------ compress the graph if worth it ------------------------------ */ nvtx = graph->nvtx ; MARKTIME(t1) ; eqmapIV = Graph_equivMap(graph) ; MARKTIME(t2) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n CPU %8.3f : get equivalence map", t2 - t1) ; fflush(msgFile) ; } Nvtx = 1 + IV_max(eqmapIV) ; if ( Nvtx <= COMPRESS_FRACTION * nvtx ) { MARKTIME(t1) ; graph = Graph_compress2(graph, eqmapIV, 1) ; MARKTIME(t2) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n CPU %8.3f : compress graph", t2 - t1) ; fflush(msgFile) ; } } else { IV_free(eqmapIV) ; eqmapIV = NULL ; } MARKTIME(t1) ; IVL_sortUp(graph->adjIVL) ; MARKTIME(t2) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n CPU %8.3f : sort adjacency", t2 - t1) ; fflush(msgFile) ; } /* ----------------------------- get the domain separator tree ----------------------------- */ { GPart *gpart ; DDsepInfo *info ; info = DDsepInfo_new() ; info->seed = seed ; info->maxcompweight = maxdomainsize ; info->alpha = 0.1 ; gpart = GPart_new() ; GPart_init(gpart, graph) ; GPart_setMessageInfo(gpart, msglvl, msgFile) ; dstree = GPart_RBviaDDsep(gpart, info) ; DSTree_renumberViaPostOT(dstree) ; if ( msglvl > 0 ) { DDsepInfo_writeCpuTimes(info, msgFile) ; } DDsepInfo_free(info) ; GPart_free(gpart) ; } /* --------------------- get the stages vector --------------------- */ stagesIV = DSTree_NDstages(dstree) ; DSTree_free(dstree) ; /* --------------------------------------------- order the vertices and extract the front tree --------------------------------------------- */ { MSMDinfo *info ; MSMD *msmd ; info = MSMDinfo_new() ; info->seed = seed ; info->compressFlag = 2 ; info->msglvl = msglvl ; info->msgFile = msgFile ; msmd = MSMD_new() ; MSMD_order(msmd, graph, IV_entries(stagesIV), info) ; etree = MSMD_frontETree(msmd) ; if ( msglvl > 0 ) { MSMDinfo_print(info, msgFile) ; } MSMDinfo_free(info) ; MSMD_free(msmd) ; IV_free(stagesIV) ; } /* ------------------------------------------------- expand the front tree if the graph was compressed ------------------------------------------------- */ if ( eqmapIV != NULL ) { ETree *etree2 = ETree_expand(etree, eqmapIV) ; ETree_free(etree) ; etree = etree2 ; Graph_free(graph) ; IV_free(eqmapIV) ; } else { MARKTIME(t1) ; IVL_sortUp(graph->adjIVL) ; MARKTIME(t2) ; if ( msglvl > 0 ) { fprintf(msgFile, "\n CPU %8.3f : sort adjacency", t2 - t1) ; fflush(msgFile) ; } } return(etree) ; }
/* -------------------------------------------------------- purpose -- return an ETree object for a multiple minimum degree ordering graph -- graph to order seed -- random number seed msglvl -- message level, 0 --> no output, 1 --> timings msgFile -- message file created -- 97nov08, cca -------------------------------------------------------- */ ETree * orderViaMMD ( Graph *graph, int seed, int msglvl, FILE *msgFile ) { double t1, t2 ; ETree *etree ; int nvtx, Nvtx ; IV *eqmapIV ; /* --------------- check the input --------------- */ if ( graph == NULL || (msglvl > 0 && msgFile == NULL) ) { fprintf(stderr, "\n fatal error in orderViaMMD(%p,%d,%d,%p)" "\n bad input\n", graph, seed, msglvl, msgFile) ; exit(-1) ; } /* ------------------------------ compress the graph if worth it ------------------------------ */ nvtx = graph->nvtx ; MARKTIME(t1) ; eqmapIV = Graph_equivMap(graph) ; MARKTIME(t2) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : get equivalence map", t2 - t1) ; fflush(msgFile) ; } Nvtx = 1 + IV_max(eqmapIV) ; if ( Nvtx <= COMPRESS_FRACTION * nvtx ) { MARKTIME(t1) ; graph = Graph_compress2(graph, eqmapIV, 1) ; MARKTIME(t2) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : compress graph", t2 - t1) ; fflush(msgFile) ; } } else { IV_free(eqmapIV) ; eqmapIV = NULL ; } MARKTIME(t1) ; IVL_sortUp(graph->adjIVL) ; MARKTIME(t2) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : sort adjacency", t2 - t1) ; fflush(msgFile) ; } /* --------------------------------------------- order the vertices and extract the front tree --------------------------------------------- */ { MSMDinfo *info ; MSMD *msmd ; info = MSMDinfo_new() ; info->seed = seed ; info->compressFlag = 2 ; info->msglvl = msglvl ; info->msgFile = msgFile ; msmd = MSMD_new() ; MSMD_order(msmd, graph, NULL, info) ; etree = MSMD_frontETree(msmd) ; if ( msglvl > 1 ) { MSMDinfo_print(info, msgFile) ; } MSMDinfo_free(info) ; MSMD_free(msmd) ; } /* ------------------------------------------------- expand the front tree if the graph was compressed ------------------------------------------------- */ if ( eqmapIV != NULL ) { ETree *etree2 = ETree_expand(etree, eqmapIV) ; ETree_free(etree) ; etree = etree2 ; Graph_free(graph) ; IV_free(eqmapIV) ; } else { MARKTIME(t1) ; IVL_sortUp(graph->adjIVL) ; MARKTIME(t2) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : sort adjacency", t2 - t1) ; fflush(msgFile) ; } } return(etree) ; }
/* ----------------------------------------------------------------- given a domain decomposition, find a bisector 1. construct the domain/segment graph 2. use block kernihan-lin to get an initial bisector alpha -- cost function parameter for BKL seed -- random number seed cpus -- array to store CPU times cpus[0] -- time to find domain/segment map cpus[1] -- time to find domain/segment bipartite graph cpus[2] -- time to find two-set partition return value -- cost of the partition created -- 96mar09, cca ----------------------------------------------------------------- */ double GPart_TwoSetViaBKL ( GPart *gpart, double alpha, int seed, double cpus[] ) { BKL *bkl ; BPG *bpg ; double t1, t2 ; FILE *msgFile ; float bestcost ; Graph *g, *gc ; int c, flag, ierr, msglvl, ndom, nseg, nvtx, v ; int *compids, *cweights, *dscolors, *dsmap, *vwghts ; IV *dsmapIV ; /* --------------- check the input --------------- */ if ( gpart == NULL || cpus == NULL ) { fprintf(stderr, "\n fatal error in GPart_DDsep(%p,%f,%d,%p)" "\n bad input\n", gpart, alpha, seed, cpus) ; exit(-1) ; } g = gpart->g ; nvtx = gpart->nvtx ; compids = IV_entries(&gpart->compidsIV) ; cweights = IV_entries(&gpart->cweightsIV) ; vwghts = g->vwghts ; msglvl = gpart->msglvl ; msgFile = gpart->msgFile ; /* HARDCODE THE ALPHA PARAMETER. */ alpha = 1.0 ; /* ------------------------------ (1) get the domain/segment map (2) get the compressed graph (3) create the bipartite graph ------------------------------ */ MARKTIME(t1) ; dsmapIV = GPart_domSegMap(gpart, &ndom, &nseg) ; dsmap = IV_entries(dsmapIV) ; MARKTIME(t2) ; cpus[0] = t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %9.5f : generate domain-segment map", t2 - t1) ; fprintf(msgFile, "\n ndom = %d, nseg = %d", ndom, nseg) ; fflush(msgFile) ; } /* ----------------------------------------- create the domain/segment bipartite graph ----------------------------------------- */ MARKTIME(t1) ; gc = Graph_compress(gpart->g, dsmap, 1) ; bpg = BPG_new() ; BPG_init(bpg, ndom, nseg, gc) ; MARKTIME(t2) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %9.5f : create domain-segment graph", t2 - t1) ; fflush(msgFile) ; } cpus[1] = t2 - t1 ; if ( msglvl > 2 ) { if ( bpg->graph->vwghts != NULL ) { fprintf(msgFile, "\n domain weights :") ; IVfp80(msgFile, bpg->nX, bpg->graph->vwghts, 17, &ierr) ; fprintf(msgFile, "\n segment weights :") ; IVfp80(msgFile, bpg->nY, bpg->graph->vwghts+bpg->nX, 18, &ierr) ; fflush(msgFile) ; } } if ( msglvl > 3 ) { fprintf(msgFile, "\n dsmapIV ") ; IV_writeForHumanEye(dsmapIV, msgFile) ; fprintf(msgFile, "\n\n domain/segment bipartite graph ") ; BPG_writeForHumanEye(bpg, msgFile) ; fflush(msgFile) ; } /* ------------------------------------ create and initialize the BKL object ------------------------------------ */ MARKTIME(t1) ; flag = 5 ; bkl = BKL_new() ; BKL_init(bkl, bpg, alpha) ; BKL_setInitPart(bkl, flag, seed, NULL) ; bestcost = BKL_evalfcn(bkl) ; gpart->ncomp = 2 ; MARKTIME(t2) ; cpus[2] = t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %9.5f : initialize BKL object", t2 - t1) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n BKL : flag = %d, seed = %d", flag, seed) ; fprintf(msgFile, ", initial cost = %.2f", bestcost) ; fflush(msgFile) ; fprintf(msgFile, ", cweights = < %d %d %d >", bkl->cweights[0], bkl->cweights[1], bkl->cweights[2]) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n colors") ; IVfp80(msgFile, bkl->nreg, bkl->colors, 80, &ierr) ; fflush(msgFile) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n BKL initial weights : ") ; IVfp80(msgFile, 3, bkl->cweights, 25, &ierr) ; fflush(msgFile) ; } /* -------------------------------- improve the partition via fidmat -------------------------------- */ MARKTIME(t1) ; bestcost = BKL_fidmat(bkl) ; MARKTIME(t2) ; cpus[2] += t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %9.5f : improve the partition via fidmat", t2 - t1) ; fflush(msgFile) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n BKL : %d passes", bkl->npass) ; fprintf(msgFile, ", %d flips", bkl->nflips) ; fprintf(msgFile, ", %d gainevals", bkl->ngaineval) ; fprintf(msgFile, ", %d improve steps", bkl->nimprove) ; fprintf(msgFile, ", cost = %9.2f", bestcost) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n BKL STATS < %9d %9d %9d > %9.2f < %4d %4d %4d %4d %4d >", bkl->cweights[0], bkl->cweights[1], bkl->cweights[2], bestcost, bkl->npass, bkl->npatch, bkl->nflips, bkl->nimprove, bkl->ngaineval) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n colors") ; IVfp80(msgFile, bkl->nreg, bkl->colors, 80, &ierr) ; fflush(msgFile) ; } /* ---------------------------- set compids[] and cweights[] ---------------------------- */ MARKTIME(t1) ; dscolors = bkl->colors ; gpart->ncomp = 2 ; IV_setSize(&gpart->cweightsIV, 3) ; cweights = IV_entries(&gpart->cweightsIV) ; cweights[0] = cweights[1] = cweights[2] = 0 ; if ( vwghts == NULL ) { for ( v = 0 ; v < nvtx ; v++ ) { compids[v] = c = dscolors[dsmap[v]] ; cweights[c]++ ; } } else { for ( v = 0 ; v < nvtx ; v++ ) { compids[v] = c = dscolors[dsmap[v]] ; cweights[c] += vwghts[v] ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n BKL partition : < %d %d %d >", cweights[0], cweights[1], cweights[2]) ; fflush(msgFile) ; } /* ------------------------------------ free the BKL object, the BPG object and the domain/segment map IV object ------------------------------------ */ BKL_free(bkl) ; IV_free(dsmapIV) ; BPG_free(bpg) ; MARKTIME(t2) ; cpus[2] += t2 - t1 ; return((double) bestcost) ; }
/* --------------------------------------------------------------------- purpose -- to compute the factorization of A - sigma * B note: all variables in the calling sequence are references to allow call from fortran. input parameters data -- pointer to bridge data object psigma -- shift for the matrix pencil ppvttol -- pivot tolerance *ppvttol = 0.0 --> no pivoting used *ppvttol != 0.0 --> pivoting used, entries in factor are bounded above by 1/pvttol in magnitude output parameters *pinertia -- on return contains the number of negative eigenvalues *perror -- on return contains an error code 1 -- error found during factorization 0 -- normal return -1 -- psigma is NULL -2 -- ppvttol is NULL -3 -- data is NULL -4 -- pinertia is NULL created -- 98aug10, cca & jcp --------------------------------------------------------------------- */ void FactorMPI ( double *psigma, double *ppvttol, void *data, int *pinertia, int *perror ) { BridgeMPI *bridge = (BridgeMPI *) data ; Chv *rootchv ; ChvManager *chvmanager ; double droptol=0.0, tau ; double cpus[20] ; FILE *msgFile ; int recvtemp[3], sendtemp[3], stats[20] ; int msglvl, nnegative, nzero, npositive, pivotingflag, tag ; MPI_Comm comm ; int nproc ; #if MYDEBUG > 0 double t1, t2 ; count_Factor++ ; MARKTIME(t1) ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) FactorMPI()", count_Factor) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) FactorMPI()", count_Factor) ; fflush(bridge->msgFile) ; #endif nproc = bridge->nproc ; /* --------------- check the input --------------- */ if ( psigma == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n psigma is NULL\n") ; *perror = -1 ; return ; } if ( ppvttol == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n ppvttol is NULL\n") ; *perror = -2 ; return ; } if ( data == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n data is NULL\n") ; *perror = -3 ; return ; } if ( pinertia == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n pinertia is NULL\n") ; *perror = -4 ; return ; } if ( perror == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n perror is NULL\n") ; return ; } comm = bridge->comm ; msglvl = bridge->msglvl ; msgFile = bridge->msgFile ; /* ---------------------------------- set the shift in the pencil object ---------------------------------- */ bridge->pencil->sigma[0] = -(*psigma) ; bridge->pencil->sigma[1] = 0.0 ; /* ----------------------------------------- if the matrices are in local coordinates (i.e., this is the first factorization following a matrix-vector multiply) then map the matrix into global coordinates ----------------------------------------- */ if ( bridge->coordFlag == LOCAL ) { if ( bridge->prbtype == 1 ) { MatMul_setGlobalIndices(bridge->info, bridge->B) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n matrix B in local coordinates") ; InpMtx_writeForHumanEye(bridge->B, msgFile) ; fflush(msgFile) ; } } if ( bridge->prbtype == 2 ) { MatMul_setGlobalIndices(bridge->info, bridge->A) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n matrix A in local coordinates") ; InpMtx_writeForHumanEye(bridge->A, msgFile) ; fflush(msgFile) ; } } bridge->coordFlag = GLOBAL ; } /* ----------------------------------------------------- clear the front matrix and submatrix mananger objects ----------------------------------------------------- */ FrontMtx_clearData(bridge->frontmtx); SubMtxManager_clearData(bridge->mtxmanager); SolveMap_clearData(bridge->solvemap) ; if ( bridge->rowmapIV != NULL ) { IV_free(bridge->rowmapIV) ; bridge->rowmapIV = NULL ; } /* ----------------------------------------------------------- set the pivot tolerance. NOTE: spooles's "tau" parameter is a bound on the magnitude of the factor entries, and is the recipricol of that of the pivot tolerance of the lanczos code ----------------------------------------------------------- */ if ( *ppvttol == 0.0 ) { tau = 10.0 ; pivotingflag = SPOOLES_NO_PIVOTING ; } else { tau = (1.0)/(*ppvttol) ; pivotingflag = SPOOLES_PIVOTING ; } /* ---------------------------------- initialize the front matrix object ---------------------------------- */ FrontMtx_init(bridge->frontmtx, bridge->frontETree, bridge->symbfacIVL, SPOOLES_REAL, SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, bridge->myid, bridge->ownersIV, bridge->mtxmanager, bridge->msglvl, bridge->msgFile) ; /* ------------------------- compute the factorization ------------------------- */ tag = 0 ; chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, NO_LOCK, 0); IVfill(20, stats, 0) ; DVfill(20, cpus, 0.0) ; rootchv = FrontMtx_MPI_factorPencil(bridge->frontmtx, bridge->pencil, tau, droptol, chvmanager, bridge->ownersIV, 0, perror, cpus, stats, bridge->msglvl, bridge->msgFile, tag, comm) ; ChvManager_free(chvmanager); tag += 3*FrontMtx_nfront(bridge->frontmtx) + 2 ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n numeric factorization") ; FrontMtx_writeForHumanEye(bridge->frontmtx, bridge->msgFile) ; fflush(bridge->msgFile) ; } /* ---------------------------- if matrix is singular then set error flag and return ---------------------------- */ if ( rootchv != NULL ) { fprintf(msgFile, "\n WHOA NELLY!, matrix is singular") ; fflush(msgFile) ; *perror = 1 ; return ; } /* ------------------------------------------------------------------ post-process the factor matrix, convert from fronts to submatrices ------------------------------------------------------------------ */ FrontMtx_MPI_postProcess(bridge->frontmtx, bridge->ownersIV, stats, bridge->msglvl, bridge->msgFile, tag, comm); tag += 5*bridge->nproc ; /* ------------------- compute the inertia ------------------- */ FrontMtx_inertia(bridge->frontmtx, &nnegative, &nzero, &npositive) ; sendtemp[0] = nnegative ; sendtemp[1] = nzero ; sendtemp[2] = npositive ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n local inertia = < %d, %d, %d >", nnegative, nzero, npositive) ; fflush(bridge->msgFile) ; } MPI_Allreduce((void *) sendtemp, (void *) recvtemp, 3, MPI_INT, MPI_SUM, comm) ; nnegative = recvtemp[0] ; nzero = recvtemp[1] ; npositive = recvtemp[2] ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n global inertia = < %d, %d, %d >", nnegative, nzero, npositive) ; fflush(bridge->msgFile) ; } *pinertia = nnegative; /* --------------------------- create the solve map object --------------------------- */ SolveMap_ddMap(bridge->solvemap, SPOOLES_REAL, FrontMtx_upperBlockIVL(bridge->frontmtx), FrontMtx_lowerBlockIVL(bridge->frontmtx), nproc, bridge->ownersIV, FrontMtx_frontTree(bridge->frontmtx), bridge->seed, bridge->msglvl, bridge->msgFile) ; /* ------------------------------- redistribute the front matrices ------------------------------- */ FrontMtx_MPI_split(bridge->frontmtx, bridge->solvemap, stats, bridge->msglvl, bridge->msgFile, tag, comm) ; if ( *ppvttol != 0.0 ) { /* ------------------------------------------------------------- pivoting for stability may have taken place. create rowmapIV, the map from rows in the factorization to processes. ------------------------------------------------------------- */ bridge->rowmapIV = FrontMtx_MPI_rowmapIV(bridge->frontmtx, bridge->ownersIV, bridge->msglvl, bridge->msgFile, bridge->comm) ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n\n bridge->rowmapIV") ; IV_writeForHumanEye(bridge->rowmapIV, bridge->msgFile) ; fflush(bridge->msgFile) ; } } else { bridge->rowmapIV = NULL ; } /* ------------------------------------------------------------------ set the error. (this is simple since when the spooles codes detect a fatal error, they print out a message to stderr and exit.) ------------------------------------------------------------------ */ *perror = 0 ; #if MYDEBUG > 0 MARKTIME(t2) ; time_Factor += t2 - t1 ; if ( bridge->myid == 0 ) { fprintf(stdout, ", %8.3f seconds, %8.3f total time", t2 - t1, time_Factor) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time", t2 - t1, time_Factor) ; fflush(bridge->msgFile) ; #endif return; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* ------------------------------------------------------------ make ETree objects for nested dissection on a regular grid 1 -- vertex elimination tree 2 -- fundamental supernode front tree 3 -- merge only children if possible 4 -- merge all children if possible 5 -- split large non-leaf fronts created -- 98feb05, cca ------------------------------------------------------------ */ { char *outETreeFileName ; double ops[6] ; double t1, t2 ; EGraph *egraph ; ETree *etree0, *etree1, *etree2, *etree3, *etree4, *etree5 ; FILE *msgFile ; Graph *graph ; int nfronts[6], nfind[6], nzf[6] ; int maxsize, maxzeros, msglvl, n1, n2, n3, nvtx, rc, v ; int *newToOld, *oldToNew ; IV *nzerosIV ; if ( argc != 9 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile n1 n2 n3 maxzeros maxsize outFile" "\n msglvl -- message level" "\n msgFile -- message file" "\n n1 -- number of points in the first direction" "\n n2 -- number of points in the second direction" "\n n3 -- number of points in the third direction" "\n maxzeros -- number of points in the third direction" "\n maxsize -- maximum number of vertices in a front" "\n outFile -- output file, must be *.etreef or *.etreeb" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } n1 = atoi(argv[3]) ; n2 = atoi(argv[4]) ; n3 = atoi(argv[5]) ; maxzeros = atoi(argv[6]) ; maxsize = atoi(argv[7]) ; outETreeFileName = argv[8] ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n n1 -- %d" "\n n2 -- %d" "\n n3 -- %d" "\n maxzeros -- %d" "\n maxsize -- %d" "\n outFile -- %s" "\n", argv[0], msglvl, argv[2], n1, n2, n3, maxzeros, maxsize, outETreeFileName) ; fflush(msgFile) ; /* ---------------------------- create the grid graph object ---------------------------- */ if ( n1 == 1 ) { egraph = EGraph_make9P(n2, n3, 1) ; } else if ( n2 == 1 ) { egraph = EGraph_make9P(n1, n3, 1) ; } else if ( n3 == 1 ) { egraph = EGraph_make9P(n1, n2, 1) ; } else { egraph = EGraph_make27P(n1, n2, n3, 1) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n %d x %d x %d grid EGraph", n1, n2, n3) ; EGraph_writeForHumanEye(egraph, msgFile) ; fflush(msgFile) ; } graph = EGraph_mkAdjGraph(egraph) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n %d x %d x %d grid Graph", n1, n2, n3) ; Graph_writeForHumanEye(graph, msgFile) ; fflush(msgFile) ; } /* ---------------------------------- get the nested dissection ordering ---------------------------------- */ nvtx = n1*n2*n3 ; newToOld = IVinit(nvtx, -1) ; oldToNew = IVinit(nvtx, -1) ; mkNDperm(n1, n2, n3, newToOld, 0, n1-1, 0, n2-1, 0, n3-1) ; for ( v = 0 ; v < nvtx ; v++ ) { oldToNew[newToOld[v]] = v ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n %d x %d x %d nd ordering", n1, n2, n3) ; IVfprintf(msgFile, nvtx, oldToNew) ; fflush(msgFile) ; } /* ------------------------------------------ create the vertex elimination ETree object ------------------------------------------ */ etree0 = ETree_new() ; ETree_initFromGraphWithPerms(etree0, graph, newToOld, oldToNew) ; nfronts[0] = ETree_nfront(etree0) ; nfind[0] = ETree_nFactorIndices(etree0) ; nzf[0] = ETree_nFactorEntries(etree0, SPOOLES_SYMMETRIC) ; ops[0] = ETree_nFactorOps(etree0, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n vtx tree : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[0], nfind[0], nzf[0], ops[0]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n vertex elimination tree") ; ETree_writeForHumanEye(etree0, msgFile) ; fflush(msgFile) ; } /* --------------------------------------------- create the fundamental supernode ETree object --------------------------------------------- */ nzerosIV = IV_new() ; IV_init(nzerosIV, nvtx, NULL) ; IV_fill(nzerosIV, 0) ; etree1 = ETree_mergeFrontsOne(etree0, 0, nzerosIV) ; nfronts[1] = ETree_nfront(etree1) ; nfind[1] = ETree_nFactorIndices(etree1) ; nzf[1] = ETree_nFactorEntries(etree1, SPOOLES_SYMMETRIC) ; ops[1] = ETree_nFactorOps(etree1, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n fs tree : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[1], nfind[1], nzf[1], ops[1]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n fundamental supernode front tree") ; ETree_writeForHumanEye(etree1, msgFile) ; fprintf(msgFile, "\n\n nzerosIV") ; IV_writeForHumanEye(nzerosIV, msgFile) ; fflush(msgFile) ; } /* --------------------------- try to absorb only children --------------------------- */ etree2 = ETree_mergeFrontsOne(etree1, maxzeros, nzerosIV) ; nfronts[2] = ETree_nfront(etree2) ; nfind[2] = ETree_nFactorIndices(etree2) ; nzf[2] = ETree_nFactorEntries(etree2, SPOOLES_SYMMETRIC) ; ops[2] = ETree_nFactorOps(etree2, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n merge one : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[2], nfind[2], nzf[2], ops[2]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front tree after mergeOne") ; ETree_writeForHumanEye(etree2, msgFile) ; fprintf(msgFile, "\n\n nzerosIV") ; IV_writeForHumanEye(nzerosIV, msgFile) ; fflush(msgFile) ; } /* -------------------------- try to absorb all children -------------------------- */ etree3 = ETree_mergeFrontsAll(etree2, maxzeros, nzerosIV) ; nfronts[3] = ETree_nfront(etree3) ; nfind[3] = ETree_nFactorIndices(etree3) ; nzf[3] = ETree_nFactorEntries(etree3, SPOOLES_SYMMETRIC) ; ops[3] = ETree_nFactorOps(etree3, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n merge all : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[3], nfind[3], nzf[3], ops[3]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front tree after mergeAll") ; ETree_writeForHumanEye(etree3, msgFile) ; fprintf(msgFile, "\n\n nzerosIV") ; IV_writeForHumanEye(nzerosIV, msgFile) ; fflush(msgFile) ; } /* -------------------------------- try to absorb any other children -------------------------------- */ etree4 = etree3 ; /* etree4 = ETree_mergeFrontsAny(etree3, maxzeros, nzerosIV) ; nfronts[4] = ETree_nfront(etree4) ; nfind[4] = ETree_nFactorIndices(etree4) ; nzf[4] = ETree_nFactorEntries(etree4, SPOOLES_SYMMETRIC) ; ops[4] = ETree_nFactorOps(etree4, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n merge any : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[4], nfind[4], nzf[4], ops[4]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front tree after mergeAny") ; ETree_writeForHumanEye(etree3, msgFile) ; fprintf(msgFile, "\n\n nzerosIV") ; IV_writeForHumanEye(nzerosIV, msgFile) ; fflush(msgFile) ; } */ /* -------------------- split the front tree -------------------- */ etree5 = ETree_splitFronts(etree4, NULL, maxsize, 0) ; nfronts[5] = ETree_nfront(etree5) ; nfind[5] = ETree_nFactorIndices(etree5) ; nzf[5] = ETree_nFactorEntries(etree5, SPOOLES_SYMMETRIC) ; ops[5] = ETree_nFactorOps(etree5, SPOOLES_REAL, SPOOLES_SYMMETRIC) ; fprintf(msgFile, "\n split : %8d fronts, %8d indices, %8d |L|, %12.0f ops", nfronts[5], nfind[5], nzf[5], ops[5]) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n front tree after split") ; ETree_writeForHumanEye(etree4, msgFile) ; fflush(msgFile) ; } fprintf(msgFile, "\n\n complex symmetric ops %.0f", ETree_nFactorOps(etree5, SPOOLES_COMPLEX, SPOOLES_SYMMETRIC)) ; /* -------------------------- write out the ETree object -------------------------- */ if ( strcmp(outETreeFileName, "none") != 0 ) { MARKTIME(t1) ; rc = ETree_writeToFile(etree5, outETreeFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : write etree to file %s", t2 - t1, outETreeFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from ETree_writeToFile(%p,%s)", rc, etree5, outETreeFileName) ; } } /* ---------------- free the objects ---------------- */ ETree_free(etree0) ; ETree_free(etree1) ; ETree_free(etree2) ; ETree_free(etree3) ; /* ETree_free(etree4) ; */ ETree_free(etree5) ; EGraph_free(egraph) ; Graph_free(graph) ; IVfree(newToOld) ; IVfree(oldToNew) ; IV_free(nzerosIV) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* --------------------------------------------------- read in a Graph and a stages id IV object, replace the stages IV object with wirebasket stages created -- 97jul30, cca --------------------------------------------------- */ { char *inCompidsFileName, *inGraphFileName, *outStagesIVfileName ; double t1, t2 ; Graph *graph ; int msglvl, nvtx, radius, rc, v ; int *compids, *stages ; IV *compidsIV, *stagesIV ; FILE *msgFile ; if ( argc != 7 ) { fprintf(stdout, "\n\n usage : %s msglvl msgFile inGraphFile inStagesFile " "\n outStagesFile radius" "\n msglvl -- message level" "\n msgFile -- message file" "\n inGraphFile -- input file, must be *.graphf or *.graphb" "\n inStagesFile -- output file, must be *.ivf or *.ivb" "\n outStagesFile -- output file, must be *.ivf or *.ivb" "\n radius -- radius to set the stage " "\n of a separator vertex" "\n", argv[0]) ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } inGraphFileName = argv[3] ; inCompidsFileName = argv[4] ; outStagesIVfileName = argv[5] ; radius = atoi(argv[6]) ; fprintf(msgFile, "\n %s " "\n msglvl -- %d" "\n msgFile -- %s" "\n inGraphFile -- %s" "\n inStagesFile -- %s" "\n outStagesFile -- %s" "\n radius -- %d" "\n", argv[0], msglvl, argv[2], inGraphFileName, inCompidsFileName, outStagesIVfileName, radius) ; fflush(msgFile) ; /* ------------------------ read in the Graph object ------------------------ */ if ( strcmp(inGraphFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } graph = Graph_new() ; MARKTIME(t1) ; rc = Graph_readFromFile(graph, inGraphFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in graph from file %s", t2 - t1, inGraphFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from Graph_readFromFile(%p,%s)", rc, graph, inGraphFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading Graph object from file %s", inGraphFileName) ; if ( msglvl > 2 ) { Graph_writeForHumanEye(graph, msgFile) ; } else { Graph_writeStats(graph, msgFile) ; } fflush(msgFile) ; /* --------------------- read in the IV object --------------------- */ if ( strcmp(inCompidsFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ; exit(0) ; } compidsIV = IV_new() ; MARKTIME(t1) ; rc = IV_readFromFile(compidsIV, inCompidsFileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : read in compidsIV from file %s", t2 - t1, inCompidsFileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_readFromFile(%p,%s)", rc, compidsIV, inCompidsFileName) ; exit(-1) ; } fprintf(msgFile, "\n\n after reading IV object from file %s", inCompidsFileName) ; if ( msglvl > 2 ) { IV_writeForHumanEye(compidsIV, msgFile) ; } else { IV_writeStats(compidsIV, msgFile) ; } fflush(msgFile) ; IV_sizeAndEntries(compidsIV, &nvtx, &compids) ; /* ---------------------------- convert to the stages vector ---------------------------- */ stagesIV = IV_new() ; IV_init(stagesIV, nvtx, NULL) ; stages = IV_entries(stagesIV) ; for ( v = 0 ; v < nvtx ; v++ ) { if ( compids[v] == 0 ) { stages[v] = 1 ; } else { stages[v] = 0 ; } } /* for ( v = 0 ; v < nvtx ; v++ ) { if ( compids[v] == 0 ) { stages[v] = 0 ; } else { stages[v] = 1 ; } } */ /* ------------------------- get the wirebasket stages ------------------------- */ Graph_wirebasketStages(graph, stagesIV, radius) ; IV_sizeAndEntries(stagesIV, &nvtx, &stages) ; for ( v = 0 ; v < nvtx ; v++ ) { if ( stages[v] == 2 ) { stages[v] = 1 ; } else if ( stages[v] > 2 ) { stages[v] = 2 ; } } fprintf(msgFile, "\n\n new stages IV object") ; if ( msglvl > 2 ) { IV_writeForHumanEye(stagesIV, msgFile) ; } else { IV_writeStats(stagesIV, msgFile) ; } fflush(msgFile) ; /* --------------------------- write out the stages object --------------------------- */ if ( strcmp(outStagesIVfileName, "none") != 0 ) { MARKTIME(t1) ; IV_writeToFile(stagesIV, outStagesIVfileName) ; MARKTIME(t2) ; fprintf(msgFile, "\n CPU %9.5f : write stagesIV to file %s", t2 - t1, outStagesIVfileName) ; if ( rc != 1 ) { fprintf(msgFile, "\n return value %d from IV_writeToFile(%p,%s)", rc, stagesIV, outStagesIVfileName) ; } } /* ------------------------ free the working storage ------------------------ */ Graph_free(graph) ; IV_free(stagesIV) ; IV_free(compidsIV) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }