Exemple #1
0
static void ssolve_permuteA(IV ** oldToNewIV, IV ** newToOldIV,
			 IVL ** symbfacIVL, ETree * frontETree,
			 InpMtx * mtxA, FILE * msgFile, int symmetryflag)
{
	int *oldToNew;

	*oldToNewIV = ETree_oldToNewVtxPerm(frontETree);
	oldToNew = IV_entries(*oldToNewIV);
	*newToOldIV = ETree_newToOldVtxPerm(frontETree);
	ETree_permuteVertices(frontETree, *oldToNewIV);
	InpMtx_permute(mtxA, oldToNew, oldToNew);
	if(symmetryflag!=2) InpMtx_mapToUpperTriangle(mtxA);
	InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS);
	InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS);
	*symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA);
	if (DEBUG_LVL > 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);
	}
}
Exemple #2
0
/*
   ------------------------------------------------------------------
   create and return a height metric IV object
   input  : vmetricIV -- a metric defined on the vertices
   output : dmetricIV -- a depth metric defined on the vertices
 
   hmetric[v] = vmetric[v] + max{p(u) = v} hmetric[u] if fch[v] != -1
              = vmetric[v]                            if fch[v] == -1

   created -- 96jun23, cca
   ------------------------------------------------------------------
*/
IV *
Tree_setHeightImetric (
   Tree   *tree,
   IV     *vmetricIV
) {
int   u, v, val ;
int   *hmetric, *vmetric ;
IV    *hmetricIV ;
/*
   ---------------
   check the input
   ---------------
*/
if (  tree == NULL || tree->n < 1 
   || vmetricIV == NULL 
   || tree->n != IV_size(vmetricIV)
   || (vmetric = IV_entries(vmetricIV)) == NULL ) {
   fprintf(stderr, "\n fatal error in Tree_setHeightImetric(%p,%p)"
           "\n bad input\n", tree, vmetricIV) ;
   if ( tree != NULL ) {
      Tree_writeForHumanEye(tree, stderr) ;
   }
   if ( vmetricIV != NULL ) {
      IV_writeForHumanEye(vmetricIV, stderr) ;
   }
   exit(-1) ;
}
hmetricIV = IV_new() ; 
IV_init(hmetricIV, tree->n, NULL) ; 
hmetric = IV_entries(hmetricIV) ;
for ( v = Tree_postOTfirst(tree) ; 
      v != -1 ; 
      v = Tree_postOTnext(tree, v) ) {
   for ( u = tree->fch[v], val = 0 ; u != -1 ; u = tree->sib[u] ) {
      if ( val < hmetric[u] ) {
         val = hmetric[u] ;
      }
   }
   hmetric[v] = val + vmetric[v] ;
}
return(hmetricIV) ; }
Exemple #3
0
/*
   ---------------------------------------------------
   purpose -- to write an ETree object for a human eye

   return value -- 1 if success, 0 otherwise

   created -- 95nov15, cca
   ---------------------------------------------------
*/
int
ETree_writeForHumanEye ( 
   ETree    *etree, 
   FILE   *fp 
) {
int   nfront, rc, v ;
int   *bndwghts, *fch, *nodwghts, *par, *sib ;

if ( etree == NULL || fp == NULL || (nfront = etree->nfront) <= 0 ) {
   fprintf(stderr, "\n fatal error in ETree_writeForHumanEye(%p,%p)"
           "\n bad input\n", etree, fp) ;
   exit(-1) ;
}
if ( (rc = ETree_writeStats(etree, fp)) == 0 ) {
   fprintf(stderr, "\n fatal error in ETree_writeForHumanEye(%p,%p)"
           "\n rc = %d, return from ETree_writeStats(%p,%p)\n",
           etree, fp, rc, etree, fp) ;
   return(0) ;
}
par = etree->tree->par ;
fch = etree->tree->fch ;
sib = etree->tree->sib ;
nodwghts = IV_entries(etree->nodwghtsIV) ;
bndwghts = IV_entries(etree->bndwghtsIV) ;
fprintf(fp, 
        "\n front    parent   fchild   sibling   nodwght   bndwght") ;
for ( v = 0 ; v < nfront ; v++ ) {
   fprintf(fp, "\n %5d %9d %9d %9d %9d %9d ", 
          v, par[v], fch[v], sib[v], nodwghts[v], bndwghts[v]) ;
}
fflush(fp) ;
fprintf(fp, "\n\n vtxToFront IV object") ;
IV_writeForHumanEye(etree->vtxToFrontIV, fp) ;
fflush(fp) ;

return(1) ; }
Exemple #4
0
/*
   ----------------------------------------------------------------
   purpose -- 

   if the elimination has halted before all the stages have been 
   eliminated, then create the schur complement graph and the map 
   from the original vertices those in the schur complement graph.

   schurGraph -- Graph object to contain the schur complement graph
   VtoPhi     -- IV object to contain the map from vertices in V
                 to schur complement vertices in Phi

   created -- 97feb01, cca
   ----------------------------------------------------------------
*/
void
MSMD_makeSchurComplement (
   MSMD    *msmd,
   Graph   *schurGraph,
   IV      *VtoPhiIV
) {
int       nedge, nPhi, nvtx, totewght, totvwght ;
int       *mark, *rep, *VtoPhi, *vwghts ;
int       count, *list ;
int       ierr, ii, size, *adj ;
int       phi, psi, tag ;
IP        *ip ;
IVL       *adjIVL ;
MSMDvtx   *u, *v, *vertices, *vfirst, *vlast, *w ;
/*
   ---------------
   check the input
   ---------------
*/
if ( msmd == NULL || schurGraph == NULL || VtoPhiIV == NULL ) {
   fprintf(stderr, 
           "\n\n fatal error in MSMD_makeSchurComplement(%p,%p,%p)"
           "\n bad input\n", msmd, schurGraph, VtoPhiIV) ;
   exit(-1) ;
}
vertices = msmd->vertices ;
nvtx     = msmd->nvtx     ;
/*
   -------------------------------------
   initialize the V-to-Phi map IV object
   -------------------------------------
*/
IV_clearData(VtoPhiIV) ;
IV_setSize(VtoPhiIV, nvtx) ;
IV_fill(VtoPhiIV, -2) ;
VtoPhi = IV_entries(VtoPhiIV) ;
/*
   ---------------------------------------------
   count the number of Schur complement vertices
   ---------------------------------------------
*/
vfirst = vertices ;
vlast  = vfirst + nvtx - 1 ;
nPhi   = 0 ;
for ( v = vfirst ; v <= vlast ; v++ ) {
#if MYDEBUG > 0
   fprintf(stdout, "\n v->id = %d, v->status = %c", v->id, v->status) ;
   fflush(stdout) ;
#endif
   switch ( v->status ) {
   case 'L' :
   case 'E' :
   case 'I' :
      break ;
   case 'B' :
      VtoPhi[v->id] = nPhi++ ;
#if MYDEBUG > 0
      fprintf(stdout, ", VtoPhi[%d] = %d", v->id, VtoPhi[v->id]) ;
      fflush(stdout) ;
#endif
      break ;
   default :
      break ;
   }
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n nPhi = %d", nPhi) ;
fflush(stdout) ;
#endif
/*
   ----------------------------------------------------
   get the representative vertex id for each Phi vertex
   ----------------------------------------------------
*/
rep = IVinit(nPhi, -1) ;
for ( v = vfirst ; v <= vlast ; v++ ) {
   if ( (phi = VtoPhi[v->id]) >= 0 ) {
#if MYDEBUG > 0
      fprintf(stdout, "\n rep[%d] = %d", phi, v->id) ;
      fflush(stdout) ;
#endif
      rep[phi] = v->id ;
   }
}
/*
   ------------------------------------------
   set the map for indistinguishable vertices
   ------------------------------------------
*/
for ( v = vfirst ; v <= vlast ; v++ ) {
   if ( v->status == 'I' ) {
      w = v ;
      while ( w->status == 'I' ) {
         w = w->par ;
      }
#if MYDEBUG > 0
      fprintf(stdout, "\n v = %d, status = %c, w = %d, status = %c", 
              v->id, v->status, w->id, w->status) ;
      fflush(stdout) ;
#endif
      VtoPhi[v->id] = VtoPhi[w->id] ;
   }
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n VtoPhi") ;
IV_writeForHumanEye(VtoPhiIV, stdout) ;
fflush(stdout) ;
#endif
/*
   ---------------------------
   initialize the Graph object
   ---------------------------
*/
Graph_clearData(schurGraph) ;
Graph_init1(schurGraph, 1, nPhi, 0, 0, IVL_CHUNKED, IVL_CHUNKED) ;
adjIVL = schurGraph->adjIVL ;
vwghts = schurGraph->vwghts ;
#if MYDEBUG > 0
fprintf(stdout, "\n\n schurGraph initialized, nvtx = %d",
        schurGraph->nvtx) ;
fflush(stdout) ;
#endif
/*
   -------------------------------
   fill the vertex adjacency lists
   -------------------------------
*/
mark = IVinit(nPhi, -1) ;
list = IVinit(nPhi, -1) ;
nedge = totvwght = totewght = 0 ;
for ( phi = 0 ; phi < nPhi ; phi++ ) {
/*
   -----------------------------
   get the representative vertex
   -----------------------------
*/
   v = vfirst + rep[phi] ; 
#if MYDEBUG > 0
   fprintf(stdout, "\n phi = %d, v = %d", phi, v->id) ;
   fflush(stdout) ;
   MSMDvtx_print(v, stdout) ;
   fflush(stdout) ;
#endif
   count = 0 ;
   tag   = v->id ;
/*
   ---------------------------
   load self in adjacency list
   ---------------------------
*/
   mark[phi] = tag ;
   totewght += v->wght * v->wght ;
#if MYDEBUG > 0
   fprintf(stdout, "\n    mark[%d] = %d", phi, mark[phi]) ;
   fflush(stdout) ;
#endif
   list[count++] = phi ;
/*
   ----------------------------------------
   load boundary lists of adjacent subtrees 
   ----------------------------------------
*/
   for ( ip = v->subtrees ; ip != NULL ; ip = ip->next ) {
      u    = vertices + ip->val ;
      size = u->nadj ;
      adj  = u->adj  ;
#if MYDEBUG > 0
      fprintf(stdout, "\n    subtree %d :", u->id) ;
      IVfp80(stdout, size, adj, 15, &ierr) ;
      fflush(stdout) ;
#endif
      for ( ii = 0 ; ii < size ; ii++ ) {
         w = vertices + adj[ii] ;
#if MYDEBUG > 0
         fprintf(stdout, "\n       w %d, status %c, psi %d",
                 w->id, w->status, VtoPhi[w->id]) ;
         fflush(stdout) ;
#endif
         if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) {
            mark[psi] = tag ;
#if MYDEBUG > 0
            fprintf(stdout, ", mark[%d] = %d", psi, mark[psi]) ;
            fflush(stdout) ;
#endif
            list[count++] = psi ;
            totewght += v->wght * w->wght ;
         }
      }
   }
/*
   ----------------------
   load adjacent vertices 
   ----------------------
*/
   size = v->nadj ;
   adj  = v->adj  ;
   for ( ii = 0 ; ii < size ; ii++ ) {
      w = vertices + adj[ii] ;
      if ( (psi = VtoPhi[w->id]) != -2 && mark[psi] != tag ) {
         mark[psi] = tag ;
         list[count++] = psi ;
         totewght += v->wght * w->wght ;
      }
   }
/*
   ---------------------------------------------
   sort the list and inform adjacency IVL object
   ---------------------------------------------
*/
   IVqsortUp(count, list) ;
   IVL_setList(adjIVL, phi, count, list) ;
/*
   --------------------------------------
   set the vertex weight and increment 
   the total vertex weight and edge count
   --------------------------------------
*/
   vwghts[phi] =  v->wght ;
   totvwght    += v->wght ;
   nedge       += count   ;
}
schurGraph->totvwght = totvwght ;
schurGraph->nedges   = nedge    ;
schurGraph->totewght = totewght ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(list) ;
IVfree(mark) ;
IVfree(rep)  ;

return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------------------
   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) ; }
/*
   ----------------------------------------------------------
   purpose -- to construct the map from fronts to processors,
      and compute operations for each processor.

   maptype -- type of map for parallel factorization
      maptype = 1 --> wrap map
      maptype = 2 --> balanced map
      maptype = 3 --> subtree-subset map
      maptype = 4 --> domain decomposition map
   cutoff -- used when maptype = 4 as upper bound on
      relative domain size

   return value --
      1 -- success
     -1 -- bridge is NULL
     -2 -- front tree is NULL

   created -- 98sep25, cca
   ----------------------------------------------------------
*/
int
BridgeMPI_factorSetup (
    BridgeMPI   *bridge,
    int         maptype,
    double      cutoff
) {
    double   t1, t2 ;
    DV       *cumopsDV ;
    ETree    *frontETree ;
    FILE     *msgFile ;
    int      msglvl, nproc ;
    /*
       ---------------
       check the input
       ---------------
    */
    MARKTIME(t1) ;
    if ( bridge == NULL ) {
        fprintf(stderr, "\n error in BridgeMPI_factorSetup()"
                "\n bridge is NULL") ;
        return(-1) ;
    }
    if ( (frontETree = bridge->frontETree) == NULL ) {
        fprintf(stderr, "\n error in BridgeMPI_factorSetup()"
                "\n frontETree is NULL") ;
        return(-2) ;
    }
    nproc   = bridge->nproc   ;
    msglvl  = bridge->msglvl  ;
    msgFile = bridge->msgFile ;
    /*
       -------------------------------------------
       allocate and initialize the cumopsDV object
       -------------------------------------------
    */
    if ( (cumopsDV = bridge->cumopsDV) == NULL ) {
        cumopsDV = bridge->cumopsDV = DV_new() ;
    }
    DV_setSize(cumopsDV, nproc) ;
    DV_zero(cumopsDV) ;
    /*
       ----------------------------
       create the owners map object
       ----------------------------
    */
    switch ( maptype ) {
    case 1 :
        bridge->ownersIV = ETree_wrapMap(frontETree, bridge->type,
                                         bridge->symmetryflag, cumopsDV) ;
        break ;
    case 2 :
        bridge->ownersIV = ETree_balancedMap(frontETree, bridge->type,
                                             bridge->symmetryflag, cumopsDV) ;
        break ;
    case 3 :
        bridge->ownersIV = ETree_subtreeSubsetMap(frontETree, bridge->type,
                           bridge->symmetryflag, cumopsDV) ;
        break ;
    case 4 :
        bridge->ownersIV = ETree_ddMap(frontETree, bridge->type,
                                       bridge->symmetryflag, cumopsDV, cutoff) ;
        break ;
    default :
        bridge->ownersIV = ETree_ddMap(frontETree, bridge->type,
                                       bridge->symmetryflag, cumopsDV, 1./(2*nproc)) ;
        break ;
    }
    MARKTIME(t2) ;
    bridge->cpus[7] = t2 - t1 ;
    if ( msglvl > 1 ) {
        fprintf(msgFile, "\n\n parallel factor setup") ;
        fprintf(msgFile, "\n type = %d, symmetryflag = %d",
                bridge->type, bridge->symmetryflag) ;
        fprintf(msgFile, "\n total factor operations = %.0f",
                DV_sum(cumopsDV)) ;
        fprintf(msgFile,
                "\n upper bound on speedup due to load balance = %.2f",
                DV_max(cumopsDV)/DV_sum(cumopsDV)) ;
        fprintf(msgFile, "\n operations distributions over threads") ;
        DV_writeForHumanEye(cumopsDV, msgFile) ;
        fflush(msgFile) ;
    }
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n owners map IV object") ;
        IV_writeForHumanEye(bridge->ownersIV, msgFile) ;
        fflush(msgFile) ;
    }
    /*
       ----------------------------
       create the vertex map object
       ----------------------------
    */
    bridge->vtxmapIV = IV_new() ;
    IV_init(bridge->vtxmapIV, bridge->neqns, NULL) ;
    IVgather(bridge->neqns, IV_entries(bridge->vtxmapIV),
             IV_entries(bridge->ownersIV),
             ETree_vtxToFront(bridge->frontETree)) ;
    if ( msglvl > 2 ) {
        fprintf(msgFile, "\n\n vertex map IV object") ;
        IV_writeForHumanEye(bridge->vtxmapIV, msgFile) ;
        fflush(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 );
}
Exemple #8
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #9
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #10
0
/*
   -------------------------------------------------------
   make the map from wide separator vertices Y 
   to components {0, 1, 2, 3}.

   YCmap[y] == 0 --> y is not adjacent to either component
   YCmap[y] == 1 --> y is adjacent to only component 1
   YCmap[y] == 2 --> y is adjacent to only component 2
   YCmap[y] == 3 --> y is adjacent to components 1 and 2

   created -- 96jun09, cca
   -------------------------------------------------------
*/
IV *
GPart_makeYCmap (
   GPart   *gpart,
   IV      *YVmapIV
) {
Graph   *g ;
int     ii, nvtx, nY, v, vsize, w, y ;
int     *compids, *vadj, *VYmap, *YCmap, *YVmap ;
IV      *YCmapIV ;
/*
   ---------------
   check the input
   ---------------
*/
if ( gpart == NULL || (g = gpart->g) == NULL 
   || (nvtx = gpart->nvtx) <= 0
   || YVmapIV == NULL || (nY = IV_size(YVmapIV)) <= 0 
   || (YVmap = IV_entries(YVmapIV)) == NULL ) {
   fprintf(stderr, "\n fatal error in GPart_makeYCmap(%p,%p)"
           "\n bad input\n", gpart, YVmapIV) ;
   if ( YVmapIV != NULL ) {
      fprintf(stderr, "\n YVmapIV") ;
      IV_writeForHumanEye(YVmapIV, stderr) ;
   }
   exit(-1) ;
}
compids = IV_entries(&gpart->compidsIV) ;
/*
   --------------------------------
   generate the inverse V --> Y map 
   --------------------------------
*/
VYmap = IVinit(nvtx, -1) ;
for ( y = 0 ; y < nY ; y++ ) {
   v = YVmap[y] ;
   VYmap[v] = y ;
}
/*
   ------------------------------------
   initialize the Y --> C map IV object
   ------------------------------------
*/
YCmapIV = IV_new();
IV_init(YCmapIV, nY, NULL) ;
YCmap = IV_entries(YCmapIV) ;
/*
   ---------------
   fill the fields
   ---------------
*/
for ( y = 0 ; y < nY ; y++ ) {
   YCmap[y] = 0 ;
   v = YVmap[y] ;
   Graph_adjAndSize(g, v, &vsize, &vadj) ;
   for ( ii = 0 ; ii < vsize ; ii++ ) {
      w = vadj[ii] ;
      if ( w < nvtx && VYmap[w] == -1 ) {
/*
         --------------------------------
         w is not in the wide separator Y
         --------------------------------
*/
         if ( compids[w] == 1 ) {
/*
            ---------------------------------------
            v is adjacent to component 1 setminus Y
            ---------------------------------------
*/
            if ( YCmap[y] == 2 ) {
/*
               ------------------------------------
               v is already adjacent to component 2
               so it is adjacent to both components
               ------------------------------------
*/
               YCmap[y] = 3 ;
               break ;
            } else {
/*
               ----------------------------------
               set map value but keep on checking
               ----------------------------------
*/
               YCmap[y] = 1 ;
            }
         } else if ( compids[w] == 2 ) {
/*
            ---------------------------------------
            v is adjacent to component 2 setminus Y
            ---------------------------------------
*/
            if ( YCmap[y] == 1 ) {
/*
               ------------------------------------
               v is already adjacent to component 1
               so it is adjacent to both components
               ------------------------------------
*/
               YCmap[y] = 3 ;
               break ;
            } else {
/*
               ----------------------------------
               set map value but keep on checking
               ----------------------------------
*/
               YCmap[y] = 2 ;
            }
         }
      }
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(VYmap) ;

return(YCmapIV) ; }
Exemple #11
0
/*
   ----------------------------------------------------------------
   purpose --

   given InpMtx objects that contain A and B, initialize the bridge
   data structure for the serial factor's, solve's and mvm's.

   data -- pointer to a Bridge object
   pprbtype -- pointer to value containing problem type
     *prbtype = 1 --> A X = B X Lambda, vibration problem
     *prbtype = 2 --> A X = B X Lambda, buckling problem
     *prbtype = 3 --> A X = X Lambda, simple eigenvalue problem
   pneqns  -- pointer to value containing number of equations
   pmxbsz  -- pointer to value containing blocksize
   A       -- pointer to InpMtx object containing A
   B       -- pointer to InpMtx object containing B
   pseed   -- pointer to value containing a random number seed
   pmsglvl -- pointer to value containing a message level
   msgFile -- message file pointer

   return value --
      1 -- normal return
     -1 -- data is NULL
     -2 -- pprbtype is NULL
     -3 -- *pprbtype is invalid
     -4 -- pneqns is NULL
     -5 -- *pneqns is invalid
     -6 -- pmxbsz is NULL
     -7 -- *pmxbsz is invalid
     -8 -- A and B are NULL
     -9 -- pseed is NULL
    -10 -- pmsglvl is NULL
    -11 -- *pmsglvl > 0 and msgFile is NULL

   created -- 98aug10, cca
   ----------------------------------------------------------------
*/
int
Setup (
   void     *data,
   int      *pprbtype,
   int      *pneqns,
   int      *pmxbsz,
   InpMtx   *A,
   InpMtx   *B,
   int      *pseed,
   int      *pmsglvl,
   FILE     *msgFile
) {
Bridge   *bridge = (Bridge *) data ;
double   sigma[2] ;
Graph    *graph ;
int      maxdomainsize, maxsize, maxzeros, msglvl, mxbsz, 
         nedges, neqns, prbtype, seed ;
IVL      *adjIVL ;
#if MYDEBUG > 0
double   t1, t2 ;
MARKTIME(t1) ;
count_Setup++ ;
fprintf(stdout, "\n (%d) Setup()", count_Setup) ;
fflush(stdout) ;
#endif
/*
   --------------------
   check the input data
   --------------------
*/
if ( data == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n data is NULL\n") ;
   return(-1) ;
}
if ( pprbtype == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n prbtype is NULL\n") ;
   return(-2) ;
}
prbtype = *pprbtype ;
if ( prbtype < 1 || prbtype > 3 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n prbtype = %d, is invalid\n", prbtype) ;
   return(-3) ;
}
if ( pneqns == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pneqns is NULL\n") ;
   return(-4) ;
}
neqns = *pneqns ;
if ( neqns <= 0 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n neqns = %d, is invalid\n", neqns) ;
   return(-5) ;
}
if ( pmxbsz == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pmxbsz is NULL\n") ;
   return(-6) ;
}
mxbsz = *pmxbsz ;
if ( mxbsz <= 0 ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n *pmxbsz = %d, is invalid\n", mxbsz) ;
   return(-7) ;
}
if ( A == NULL && B == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n A and B are NULL\n") ;
   return(-8) ;
}
if ( pseed == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pseed is NULL\n") ;
   return(-9) ;
}
seed = *pseed ;
if ( pmsglvl == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n pmsglvl is NULL\n") ;
   return(-10) ;
}
msglvl = *pmsglvl ;
if ( msglvl > 0 && msgFile == NULL ) {
   fprintf(stderr, "\n fatal error in Setup()"
           "\n msglvl = %d, msgFile = NULL\n", msglvl) ;
   return(-11) ;
}
bridge->msglvl  = msglvl  ;
bridge->msgFile = msgFile ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n inside Setup()"
           "\n neqns = %d, prbtype = %d, mxbsz = %d, seed = %d",
           neqns, prbtype, mxbsz, seed) ;
   if ( A != NULL ) {
      fprintf(msgFile, "\n\n matrix A") ;
      InpMtx_writeForHumanEye(A, msgFile) ;
   }
   if ( B != NULL ) {
      fprintf(msgFile, "\n\n matrix B") ;
      InpMtx_writeForHumanEye(B, msgFile) ;
   }
   fflush(msgFile) ;
}
bridge->prbtype = prbtype ;
bridge->neqns   = neqns   ;
bridge->mxbsz   = mxbsz   ;
bridge->A       = A       ;
bridge->B       = B       ;
bridge->seed    = seed    ;
/*
   ----------------------------
   create and initialize pencil
   ----------------------------
*/
sigma[0] = 1.0; sigma[1] = 0.0;
bridge->pencil = Pencil_new() ;
Pencil_setDefaultFields(bridge->pencil) ;
Pencil_init(bridge->pencil, SPOOLES_REAL, SPOOLES_SYMMETRIC,
            A, sigma, B) ;
/*
   --------------------------------
   convert to row or column vectors
   --------------------------------
*/
if ( A != NULL ) {
   if ( ! INPMTX_IS_BY_ROWS(A) && ! INPMTX_IS_BY_COLUMNS(A) ) {
      InpMtx_changeCoordType(A, INPMTX_BY_ROWS) ;
   }
   if ( ! INPMTX_IS_BY_VECTORS(A) ) {
      InpMtx_changeStorageMode(A, INPMTX_BY_VECTORS) ;
   }
}
if ( B != NULL ) {
   if ( ! INPMTX_IS_BY_ROWS(B) && ! INPMTX_IS_BY_COLUMNS(B) ) {
      InpMtx_changeCoordType(B, INPMTX_BY_ROWS) ;
   }
   if ( ! INPMTX_IS_BY_VECTORS(B) ) {
      InpMtx_changeStorageMode(B, INPMTX_BY_VECTORS) ;
   }
}
/*
   -------------------------------
   create a Graph object for A + B
   -------------------------------
*/
graph  = Graph_new() ;
adjIVL = Pencil_fullAdjacency(bridge->pencil) ;
nedges = IVL_tsize(adjIVL),
Graph_init2(graph, 0, bridge->neqns, 0, nedges,
            bridge->neqns, nedges, adjIVL, NULL, NULL) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n graph of the input matrix") ;
   Graph_writeForHumanEye(graph, msgFile) ;
   fflush(msgFile) ;
}
/*
   ---------------
   order the graph
   ---------------
*/
maxdomainsize = neqns / 64 ;
if ( maxdomainsize == 0 ) {
   maxdomainsize = 1 ;
}
maxzeros  = (int) (0.01*neqns) ;
maxsize   = 64 ;
bridge->frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, 
                     maxzeros, maxsize, bridge->seed, msglvl, msgFile) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n front tree from ordering") ;
   ETree_writeForHumanEye(bridge->frontETree, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------------------
   get the old-to-new and new-to-old permutations
   ----------------------------------------------
*/
bridge->oldToNewIV = ETree_oldToNewVtxPerm(bridge->frontETree) ;
bridge->newToOldIV = ETree_newToOldVtxPerm(bridge->frontETree) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n old-to-new permutation") ;
   IV_writeForHumanEye(bridge->oldToNewIV, msgFile) ;
   fprintf(msgFile, "\n\n new-to-old permutation") ;
   IV_writeForHumanEye(bridge->newToOldIV, msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------
   permute the vertices in the front tree
   --------------------------------------
*/
ETree_permuteVertices(bridge->frontETree, bridge->oldToNewIV) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n permuted front etree") ;
   ETree_writeForHumanEye(bridge->frontETree, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------------
   permute the entries in the pencil. 
   note, after the permutation the 
   entries are mapped into the upper triangle.
   -------------------------------------------
*/
Pencil_permute(bridge->pencil, bridge->oldToNewIV, bridge->oldToNewIV) ;
Pencil_mapToUpperTriangle(bridge->pencil) ;
Pencil_changeCoordType(bridge->pencil, INPMTX_BY_CHEVRONS) ;
Pencil_changeStorageMode(bridge->pencil, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n permuted pencil") ;
   Pencil_writeForHumanEye(bridge->pencil, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------
   compute the symbolic factorization
   ----------------------------------
*/
bridge->symbfacIVL = SymbFac_initFromPencil(bridge->frontETree, 
                                            bridge->pencil) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n symbolic factorization") ;
   IVL_writeForHumanEye(bridge->symbfacIVL, msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------
   create a FrontMtx object to hold the factorization
   --------------------------------------------------
*/
bridge->frontmtx = FrontMtx_new() ;
/*
   ------------------------------------------------------------
   create a SubMtxManager object to hold the factor submatrices
   ------------------------------------------------------------
*/
bridge->mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(bridge->mtxmanager, NO_LOCK, 0) ;
/*
   ------------------------------------------------------------
   allocate the working objects X and Y for the matrix multiply
   ------------------------------------------------------------
*/
bridge->X = DenseMtx_new() ;
DenseMtx_init(bridge->X, SPOOLES_REAL, 0, 0, neqns, mxbsz, 1, neqns) ;
bridge->Y = DenseMtx_new() ;
DenseMtx_init(bridge->Y, SPOOLES_REAL, 0, 0, neqns, mxbsz, 1, neqns) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Graph_free(graph) ;

#if MYDEBUG > 0
MARKTIME(t2) ;
time_Setup += t2 - t1 ;
fprintf(stdout, ", %8.3f seconds, %8.3f total time", 
        t2 - t1, time_Setup) ;
fflush(stdout) ;
#endif

return(1) ; }
Exemple #12
0
/*
   --------------------------------------------
   purpose -- to solve the linear system
      MPI version
      if permuteflag is 1 then
         rhs is permuted into new ordering
         solution is permuted into old ordering

   return value ---
      1 -- normal return
     -1 -- bridge is NULL
     -2 -- X is NULL
     -3 -- Y is NULL
     -4 -- frontmtx is NULL
     -5 -- mtxmanager is NULL
     -6 -- oldToNewIV not available
     -7 -- newToOldIV not available

   created -- 98sep18, cca
   --------------------------------------------
*/
int
BridgeMPI_solve (
   BridgeMPI  *bridge,
   int        permuteflag,
   DenseMtx   *X,
   DenseMtx   *Y
) {
DenseMtx        *Xloc, *Yloc ;
double          cputotal, t0, t1, t2 ;
double          cpus[6] ;
FILE            *msgFile ;
FrontMtx        *frontmtx ;
int             firsttag, msglvl, myid, nmycol, nrhs, nrow ;
int             *mycolind, *rowind ;
int             stats[4] ;
IV              *mapIV, *ownersIV ;
MPI_Comm        comm ;
SubMtxManager   *mtxmanager ;
/*
   ---------------
   check the input
   ---------------
*/
MARKTIME(t0) ;
if ( bridge == NULL ) {
   fprintf(stderr, "\n error in BridgeMPI_solve"
           "\n bridge is NULL\n") ;
   return(-1) ;
}
if ( (frontmtx = bridge->frontmtx) == NULL ) {
   fprintf(stderr, "\n error in BridgeMPI_solve"
           "\n frontmtx is NULL\n") ;
   return(-4) ;
}
if ( (mtxmanager = bridge->mtxmanager) == NULL ) {
   fprintf(stderr, "\n error in BridgeMPI_solve"
           "\n mtxmanager is NULL\n") ;
   return(-5) ;
}
myid     = bridge->myid     ;
comm     = bridge->comm     ;
msglvl   = bridge->msglvl   ;
msgFile  = bridge->msgFile  ;
frontmtx = bridge->frontmtx ;
ownersIV = bridge->ownersIV ;
Xloc     = bridge->Xloc     ;
Yloc     = bridge->Yloc     ;
if ( myid != 0 ) {
   X = Y = NULL ;
} else {
   if ( X == NULL ) {
      fprintf(stderr, "\n error in BridgeMPI_solve"
              "\n myid 0, X is NULL\n") ;
      return(-2) ;
   }
   if ( Y == NULL ) {
      fprintf(stderr, "\n error in BridgeMPI_solve"
              "\n myid 0, Y is NULL\n") ;
      return(-3) ;
   }
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n inside BridgeMPI_solve()") ;
   fflush(msgFile) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile , "\n\n Xloc") ;
   DenseMtx_writeForHumanEye(Xloc, msgFile) ;
   fprintf(msgFile , "\n\n Yloc") ;
   DenseMtx_writeForHumanEye(Yloc, msgFile) ;
   fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
if ( myid == 0 ) {
/*
   --------------------------
   optionally permute the rhs
   --------------------------
*/
   if ( permuteflag == 1 ) {
      int   rc ;
      IV    *oldToNewIV ;
   
      MARKTIME(t1) ;
      rc = BridgeMPI_oldToNewIV(bridge, &oldToNewIV) ;
      if (rc != 1) {
        fprintf(stderr, "\n error in BridgeMPI_solve()"
                "\n rc = %d from BridgeMPI_oldToNewIV()\n", rc) ;
        return(-6) ;
      }
      DenseMtx_permuteRows(Y, oldToNewIV) ;
      MARKTIME(t2) ;
      bridge->cpus[15] += t2 - t1 ;
      if ( msglvl > 2 ) {
         fprintf(msgFile , "\n\n permuted Y") ;
         DenseMtx_writeForHumanEye(Y, msgFile) ;
         fflush(msgFile) ;
      }
   }
}
/*--------------------------------------------------------------------*/
/*
   -------------------------------------
   distribute the right hand side matrix
   -------------------------------------
*/
MARKTIME(t1) ;
mapIV = bridge->rowmapIV ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n row map IV object") ;
   IV_writeForHumanEye(mapIV, msgFile) ;
   fflush(msgFile) ;
}
if ( myid == 0 ) {
   nrhs = Y->ncol ;
} else {
   nrhs = 0 ;
}
MPI_Bcast((void *) &nrhs, 1, MPI_INT, 0, comm) ;
firsttag = 0 ;
IVfill(4, stats, 0) ;
DenseMtx_MPI_splitFromGlobalByRows(Y, Yloc, mapIV, 0, stats, 
                                   msglvl, msgFile, firsttag, comm) ;
MARKTIME(t2) ;
bridge->cpus[16] += t2 - t1 ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n local matrix Y after the split") ;
   DenseMtx_writeForHumanEye(Yloc, msgFile) ;
   fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
   --------------------------------------
   initialize the local solution X object
   --------------------------------------
*/
MARKTIME(t1) ;
IV_sizeAndEntries(bridge->ownedColumnsIV, &nmycol, &mycolind) ;
DenseMtx_init(Xloc, bridge->type, -1, -1, nmycol, nrhs, 1, nmycol) ;
if ( nmycol > 0 ) {
   DenseMtx_rowIndices(Xloc, &nrow, &rowind) ;
   IVcopy(nmycol, rowind, mycolind) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n local matrix X") ;
      DenseMtx_writeForHumanEye(Xloc, msgFile) ;
      fflush(msgFile) ;
   }
}
MARKTIME(t2) ;
bridge->cpus[17] += t2 - t1 ;
/*--------------------------------------------------------------------*/
/*
   ----------------
   solve the system
   ----------------
*/
MARKTIME(t1) ;
DVzero(6, cpus) ;
FrontMtx_MPI_solve(frontmtx, Xloc, Yloc, mtxmanager, bridge->solvemap,
                   cpus, stats, msglvl, msgFile, firsttag, comm) ;
MARKTIME(t2) ;
bridge->cpus[18] += t2 - t1 ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n CPU %8.3f : solve the system", t2 - t1) ;
}
cputotal = t2 - t1 ;
if ( cputotal > 0.0 ) {
   fprintf(msgFile,
   "\n    set up solves               %8.3f %6.2f"
   "\n    load rhs and store solution %8.3f %6.2f"
   "\n    forward solve               %8.3f %6.2f"
   "\n    diagonal solve              %8.3f %6.2f"
   "\n    backward solve              %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, cputotal) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n\n computed solution") ;
   DenseMtx_writeForHumanEye(Xloc, msgFile) ;
   fflush(stdout) ;
}
/*--------------------------------------------------------------------*/
/*
   -------------------------------------
   gather the solution on processor zero
   -------------------------------------
*/
MARKTIME(t1) ;
DenseMtx_MPI_mergeToGlobalByRows(X, Xloc, 0, stats, msglvl, msgFile,
                                 firsttag, comm) ;
MARKTIME(t2) ;
bridge->cpus[19] += t2 - t1 ;
if ( myid == 0 ) {
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n global matrix X in new ordering") ;
      DenseMtx_writeForHumanEye(X, msgFile) ;
      fflush(msgFile) ;
   }
}
/*--------------------------------------------------------------------*/
/*
   -------------------------------
   optionally permute the solution
   -------------------------------
*/
if ( myid == 0 ) {
   if ( permuteflag == 1 ) {
      int   rc ;
      IV    *newToOldIV ;

      rc = BridgeMPI_newToOldIV(bridge, &newToOldIV) ;
      if (rc != 1) {
        fprintf(stderr, "\n error in BridgeMPI_solve()"
                "\n rc = %d from BridgeMPI_newToOldIV()\n", rc) ;
        return(-7) ;
      }
      DenseMtx_permuteRows(X, newToOldIV) ;
   }
   MARKTIME(t2) ;
   bridge->cpus[20] += t2 - t1 ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n global matrix X in old ordering") ;
      DenseMtx_writeForHumanEye(X, msgFile) ;
      fflush(msgFile) ;
   }
}
MARKTIME(t2) ;
bridge->cpus[21] += t2 - t0 ;

return(1) ; }
Exemple #13
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #14
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #15
0
/*
   ----------------------------------------------------
   convert from sorted and compressed triples to vector

   created -- 98jan28, cca
   ----------------------------------------------------
*/
void
InpMtx_convertToVectors (
   InpMtx   *inpmtx 
) {
int      *ivec1, *ivec2, *offsets, *sizes, *vecids ;
int      first, id, ient, jj, nent, nvector, value ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_convertToVectors(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( INPMTX_IS_BY_VECTORS(inpmtx) || (nent = inpmtx->nent) == 0 ) {
   inpmtx->storageMode = INPMTX_BY_VECTORS ;
   return ;
}
if ( INPMTX_IS_RAW_DATA(inpmtx) ) {
   InpMtx_sortAndCompress(inpmtx) ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
/*
   -----------------------------------
   find the number of distinct vectors
   -----------------------------------
*/
value = -1 ;
nvector = 0 ;
for ( ient = 0 ; ient < nent ; ient++ ) {
   if ( ivec1[ient] >= 0 && value != ivec1[ient] ) {
      value = ivec1[ient] ;
      nvector++ ;
#if MYDEBUG > 0
      fprintf(stdout, "\n ient %d, value %d, nvector %d", 
              ient, value, nvector) ;
      fflush(stdout) ;
#endif
   }
}
#if MYDEBUG > 0
fprintf(stdout, "\n %d vectors", nvector) ;
fflush(stdout) ;
#endif
/*
   -----------------------------------------------------------------
   adjust the sizes of the sizes[] and offsets[] arrays if necessary
   -----------------------------------------------------------------
*/
InpMtx_setNvector(inpmtx, nvector) ;
if ( nvector <= 0 ) {
/*
   -----------------------------
   matrix has no entries, return
   -----------------------------
*/
   inpmtx->storageMode = INPMTX_RAW_DATA ;
   InpMtx_setNent(inpmtx, 0) ;
   return ;
}
vecids  = InpMtx_vecids(inpmtx)  ;
sizes   = InpMtx_sizes(inpmtx)   ;
offsets = InpMtx_offsets(inpmtx) ;
/*
   ------------------------------------------------------------
   set the vector sizes and offsets
   note: we skip all entries whose first coordinate is negative
   ------------------------------------------------------------
*/
for ( first = 0 ; first < nent ; first++ ) {
   if ( ivec1[first] >= 0 ) {
      break ;
   }
}
id = 0 ;
if ( first < nent ) {
   value = ivec1[first] ;
   for ( jj = first + 1 ; jj < nent ; jj++ ) {
      if ( ivec1[jj] != value ) {
         vecids[id]  = value      ;
         sizes[id]   = jj - first ;
         offsets[id] = first      ;
#if MYDEBUG > 0
         fprintf(stdout, 
                 "\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
                 id, vecids[id], id, sizes[id], id, offsets[id]) ;
         fflush(stdout) ;
#endif
         first       = jj         ;
         value       = ivec1[jj]  ;
         id++ ;
      }
   }
   vecids[id]  = value      ;
   sizes[id]   = jj - first ;
   offsets[id] = first      ;
#if MYDEBUG > 0
   fprintf(stdout, 
           "\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
           id, vecids[id], id, sizes[id], id, offsets[id]) ;
   fflush(stdout) ;
#endif
}
inpmtx->storageMode = INPMTX_BY_VECTORS ;
#if MYDEBUG > 0
fprintf(stdout, "\n vecidsIV") ;
IV_writeForHumanEye(&inpmtx->vecidsIV, stdout) ;
fprintf(stdout, "\n sizesIV") ;
IV_writeForHumanEye(&inpmtx->sizesIV, stdout) ;
fprintf(stdout, "\n offsetsIV") ;
IV_writeForHumanEye(&inpmtx->offsetsIV, stdout) ;
fflush(stdout) ;
#endif

return ; }
Exemple #16
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #17
0
/*
   -----------------------------------------------------------------
   purpose -- 

   the IV objects objIV and ownersIV are found on each process.
   the ownersIV object is identical over all the processes, and
   owners[ii] tells which processes owns location ii of the obj[]
   vector. on return from this entry, the obj[] vector is replicated
   over all the processes. each process sends the (ii,obj[ii]) pairs
   that it owns to all the other processes.

   created -- 98apr02, cca
   -----------------------------------------------------------------
*/
void
IV_MPI_allgather (
   IV         *objIV,
   IV         *ownersIV,
   int        stats[],
   int        msglvl,
   FILE       *msgFile,
   int        firsttag,
   MPI_Comm   comm
) {
int          count, destination, ii, incount, iproc, jj, lasttag, left, 
             maxcount, myid, nowners, nproc, nvec, offset, 
             outcount, right, source, tag, tagbound, value ;
int          *counts, *inbuffer, *outbuffer, *owners, *vec ;
MPI_Status   status ;
/*
   ---------------
   check the input
   ---------------
*/
if ( objIV == NULL || ownersIV == NULL ) {
   fprintf(stderr, "\n fatal error in IV_MPI_allgather()"
           "\n objIV = %p, ownersIV = %p\n",
           objIV, ownersIV) ;
   spoolesFatal();
}
/*
   ----------------------------------------------
   get id of self, # of processes and # of fronts
   ----------------------------------------------
*/
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
IV_sizeAndEntries(objIV, &nvec, &vec) ;
IV_sizeAndEntries(ownersIV, &nowners, &owners) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n inside IV_MPI_allgather"
           "\n nproc = %d, myid = %d, nvec = %d, nowners = %d",
           nproc, myid, nvec, nowners) ;
   fflush(msgFile) ;
}
if ( nvec != nowners || vec == NULL || owners == NULL ) {
   fprintf(stderr, "\n fatal error in IV_MPI_allgather()"
           "\n nvec = %d, nowners = %d, vec = %p, owners = %p\n",
           nvec, nowners, vec, owners) ;
   spoolesFatal();
}
/*
   -------------------
   check the tag range
   -------------------
*/
lasttag = firsttag + nproc ;
tagbound = maxTagMPI(comm) ;
if ( firsttag < 0 || lasttag > tagbound ) {
   fprintf(stderr, "\n fatal error in IV_MPI_allgather()"
           "\n firsttag = %d, lasttag = %d, tagbound = %d\n",
           firsttag, lasttag, tagbound) ;
   spoolesFatal();
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n objIV") ;
   IV_writeForHumanEye(objIV, msgFile) ;
   fprintf(msgFile, "\n\n ownersIV") ;
   IV_writeForHumanEye(ownersIV, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------------------------------
   step 1 : determine the number of entries owned by each vector
   -------------------------------------------------------------
*/
counts = IVinit(nproc, 0) ;
for ( ii = 0 ; ii < nvec ; ii++ ) {
   if ( owners[ii] < 0 || owners[ii] >= nproc ) {
      fprintf(stderr, "\n owners[%d] = %d", ii, owners[ii]) ;
      spoolesFatal();
   }
   counts[owners[ii]]++ ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n counts") ;
   IVfprintf(msgFile, nproc, counts) ;
   fflush(msgFile) ;
}
/*
   -----------------------------
   set up the in and out buffers
   -----------------------------
*/
if ( counts[myid] > 0 ) {
   outbuffer = IVinit(2*counts[myid], -1) ;
   for ( ii = jj = 0 ; ii < nvec ; ii++ ) {
      if ( owners[ii] == myid ) {
         outbuffer[jj++] = ii ;
         outbuffer[jj++] = vec[ii] ;
      }
   }
   if ( jj != 2*counts[myid] ) {
      fprintf(msgFile, "\n jj = %d, 2*counts[%d] = %d",
              jj, myid, 2*counts[myid]) ;
      fprintf(stderr, "\n jj = %d, 2*counts[%d] = %d",
              jj, myid, 2*counts[myid]) ;
      spoolesFatal();
   }
} else {
   outbuffer = NULL ;
}
maxcount = IVmax(nproc, counts, &iproc) ;
if ( maxcount > 0 ) {
   inbuffer = IVinit(2*maxcount, -1) ;
} else {
   inbuffer = NULL ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n outbuffer %p, maxcount %d, inbuffer %p",
           outbuffer, maxcount, inbuffer) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------
   step 2: loop over the other processes
      send and receive information
   -------------------------------------
*/
outcount = 2*counts[myid] ;
for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) {
   right = (myid + offset) % nproc ;
   if ( offset <= myid ) {
      left = myid - offset ;
   } else {
      left = nproc + myid - offset ;
   }
   if ( outcount > 0 ) {
      destination = right ;
      stats[0]++ ;
      stats[2] += outcount*sizeof(int) ;
   } else {
      destination = MPI_PROC_NULL ;
   }
   incount = 2*counts[left] ;
   if ( incount > 0 ) {
      source = left ;
      stats[1]++ ;
      stats[3] += incount*sizeof(int) ;
   } else {
      source = MPI_PROC_NULL ;
   }
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n offset %d, source %d, destination %d",
              offset, source, destination) ;
      fflush(msgFile) ;
   }
/*
   -----------------
   do a send/receive
   -----------------
*/
   MPI_Sendrecv(outbuffer, outcount, MPI_INT, destination, tag,
                inbuffer,  incount,  MPI_INT, source,      tag,
                comm, &status) ;
   if ( source != MPI_PROC_NULL ) {
      MPI_Get_count(&status, MPI_INT, &count) ;
      if ( count != incount ) {
         fprintf(stderr,
                 "\n 1. fatal error in IV_MPI_allgather()"
                 "\n proc %d : source = %d, count = %d, incount = %d\n",
                 myid, source, count, incount) ;
         spoolesFatal();
      }
   }
/*
   ----------------------------
   set the values in the vector
   ----------------------------
*/
   for ( jj = 0 ; jj < incount ; jj += 2 ) {
      ii    = inbuffer[jj] ;
      value = inbuffer[jj+1] ;
      vec[ii] = value ;
   }
   if ( jj != incount ) {
      fprintf(msgFile, "\n jj = %d, incount = %d", jj, incount) ;
      fprintf(stderr, "\n jj = %d, incount = %d", jj, incount) ;
      spoolesFatal();
   }
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n after setting values") ;
      IVfprintf(msgFile, nvec, vec) ;
      fflush(msgFile) ;
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(counts) ;
if ( outbuffer != NULL ) {
   IVfree(outbuffer) ;
}
if ( inbuffer != NULL ) {
   IVfree(inbuffer) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n leaving IV_MPI_gatherall()") ;
   fflush(msgFile) ;
}
return ; }
Exemple #18
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #19
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) ; }
Exemple #20
0
/*
   ------------------------------------------------------------------
   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) ; }
Exemple #21
0
/*
   --------------------------------------------------------------
   identify the wide separator
 
   return -- IV object that holds the nodes in the wide separator

   created -- 96oct21, cca
   --------------------------------------------------------------
*/
IV *
GPart_identifyWideSep (
   GPart   *gpart,
   int     nlevel1,
   int     nlevel2
) {
FILE    *msgFile ;
Graph   *g ;
int     count, first, ierr, ii, ilevel, last, msglvl,
        nfirst, now, nsecond, nsep, nvtx, v, vsize, w ;
int     *compids, *list, *mark, *vadj ;
IV      *sepIV ;
/*
   ---------------
   check the input
   ---------------
*/
if (  gpart == NULL || (g = gpart->g) == NULL 
   || nlevel1 < 0 || nlevel2 < 0 ) {
  fprintf(stderr, "\n fatal error in GPart_identifyWideSep(%p,%d,%d)"
           "\n bad input\n", gpart, nlevel1, nlevel2) ;
   exit(-1) ;
}
g       = gpart->g ;
compids = IV_entries(&gpart->compidsIV) ;
nvtx    = g->nvtx ;
mark    = IVinit(nvtx, -1) ;
list    = IVinit(nvtx, -1) ;
msglvl  = gpart->msglvl ;
msgFile = gpart->msgFile ;
/*
   --------------------------------------
   load the separator nodes into the list
   --------------------------------------
*/
nsep = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
   if ( compids[v] == 0 ) {
      list[nsep++] = v ;
      mark[v] = 0 ;
   }
}
count = nsep ;
if ( msglvl > 1 ) {
   fprintf(msgFile, 
           "\n GPart_identifyWideSep : %d separator nodes loaded", 
           count) ;
   fflush(msgFile) ;
}
if ( msglvl > 2 ) {
   IVfp80(msgFile, nsep, list, 80, &ierr) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------------------
   loop over the number of levels out that form 
   the wide separator towards the first component
   ----------------------------------------------
*/
if ( nlevel1 >= 1 ) {
   first = count ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
      fflush(msgFile) ;
   }
   for ( now = 0 ; now < nsep ; now++ ) {
      v = list[now] ;
      Graph_adjAndSize(g, v, &vsize, &vadj) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n %d : ", v) ;
         IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
         fflush(msgFile) ;
      }
      for ( ii = 0 ; ii < vsize ; ii++ ) {
         w = vadj[ii] ;
         if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, "\n    adding %d to list", w) ;
               fflush(msgFile) ;
            }
            list[count++] = w ;
            mark[w] = 1 ;
         }
      }
   }
   now = first ;
   for ( ilevel = 2 ; ilevel <= nlevel1 ; ilevel++ ) {
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
         fflush(msgFile) ;
      }
      last = count - 1 ;
      while ( now <= last ) {
         v = list[now++] ;
         Graph_adjAndSize(g, v, &vsize, &vadj) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n %d : ", v) ;
            IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
            fflush(msgFile) ;
         }
         for ( ii = 0 ; ii < vsize ; ii++ ) {
            w = vadj[ii] ;
            if ( w < nvtx && mark[w] == -1 && compids[w] == 1 ) {
               if ( msglvl > 2 ) {
                  fprintf(msgFile, "\n    adding %d to list", w) ;
                  fflush(msgFile) ;
               }
               mark[w] = 1 ;
               list[count++] = w ;
            }
         }
      }
   }
}
nfirst = count - nsep ;
if ( msglvl > 2 ) {
   fprintf(msgFile, 
           "\n %d nodes added from the first component", nfirst) ;
   fflush(msgFile) ;
}
if ( msglvl > 3 ) {
   IVfp80(msgFile, nfirst, &list[nsep], 80, &ierr) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------------------
   loop over the number of levels out that form 
   the wide separator towards the second component
   ----------------------------------------------
*/
if ( nlevel2 >= 1 ) {
   first = count ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n level = %d, first = %d", 1, first) ;
      fflush(msgFile) ;
   }
   for ( now = 0 ; now < nsep ; now++ ) {
      v = list[now] ;
      Graph_adjAndSize(g, v, &vsize, &vadj) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n %d : ", v) ;
         IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
         fflush(msgFile) ;
      }
      for ( ii = 0 ; ii < vsize ; ii++ ) {
         w = vadj[ii] ;
         if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, "\n    adding %d to list", w) ;
               fflush(msgFile) ;
            }
            list[count++] = w ;
            mark[w] = 2 ;
         }
      }
   }
   now = first ;
   for ( ilevel = 2 ; ilevel <= nlevel2 ; ilevel++ ) {
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n\n level = %d, first = %d", ilevel, first);
         fflush(msgFile) ;
      }
      last = count - 1 ;
      while ( now <= last ) {
         v = list[now++] ;
         Graph_adjAndSize(g, v, &vsize, &vadj) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n %d : ", v) ;
            IVfp80(msgFile, vsize, vadj, 80, &ierr) ;
            fflush(msgFile) ;
         }
         for ( ii = 0 ; ii < vsize ; ii++ ) {
            w = vadj[ii] ;
            if ( w < nvtx && mark[w] == -1 && compids[w] == 2 ) {
               if ( msglvl > 2 ) {
                  fprintf(msgFile, "\n    adding %d to list", w) ;
                  fflush(msgFile) ;
               }
               mark[w] = 2 ;
               list[count++] = w ;
            }
         }
      }
   }
}
nsecond = count - nsep - nfirst ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n %d nodes added from the second component", 
           nsecond) ;
   fflush(msgFile) ;
}
if ( msglvl > 3 ) {
   IVfp80(msgFile, nsecond, &list[nsep + nfirst], 80, &ierr) ;
   fflush(msgFile) ;
}
IVqsortUp(count, list) ;
/*
   --------------------
   create the IV object
   --------------------
*/
sepIV = IV_new() ;
IV_init(sepIV, count, NULL) ;
IVcopy(count, IV_entries(sepIV), list) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n separator has %d nodes", IV_size(sepIV)) ;
   fflush(msgFile) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n sepIV") ;
   IV_writeForHumanEye(sepIV, msgFile) ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(mark) ;
IVfree(list) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n return from GPart_identifyWideSep") ;
   fflush(msgFile) ;
}
 
return(sepIV) ; }
Exemple #22
0
/*
   --------------------------------------------------------------------
   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) ; }
Exemple #23
0
PetscErrorCode MatFactorNumeric_SeqSpooles(Mat F,Mat A,const MatFactorInfo *info)
{  
  Mat_Spooles        *lu = (Mat_Spooles*)(F)->spptr;
  ChvManager         *chvmanager ;
  Chv                *rootchv ;
  IVL                *adjIVL;
  PetscErrorCode     ierr;
  PetscInt           nz,nrow=A->rmap->n,irow,nedges,neqns=A->cmap->n,*ai,*aj,i,*diag=0,fierr;
  PetscScalar        *av;
  double             cputotal,facops;
#if defined(PETSC_USE_COMPLEX)
  PetscInt           nz_row,*aj_tmp;
  PetscScalar        *av_tmp;
#else
  PetscInt           *ivec1,*ivec2,j;
  double             *dvec;
#endif
  PetscBool          isSeqAIJ,isMPIAIJ;
  
  PetscFunctionBegin;
  if (lu->flg == DIFFERENT_NONZERO_PATTERN) { /* first numeric factorization */      
    (F)->ops->solve   = MatSolve_SeqSpooles;
    (F)->assembled    = PETSC_TRUE; 
    
    /* set Spooles options */
    ierr = SetSpoolesOptions(A, &lu->options);CHKERRQ(ierr); 

    lu->mtxA = InpMtx_new();
  }

  /* copy A to Spooles' InpMtx object */
  ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isSeqAIJ);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isMPIAIJ);CHKERRQ(ierr);
  if (isSeqAIJ){
    Mat_SeqAIJ   *mat = (Mat_SeqAIJ*)A->data;
    ai=mat->i; aj=mat->j; av=mat->a;
    if (lu->options.symflag == SPOOLES_NONSYMMETRIC) {
      nz=mat->nz;
    } else { /* SPOOLES_SYMMETRIC || SPOOLES_HERMITIAN */
      nz=(mat->nz + A->rmap->n)/2;
      diag=mat->diag;
    }
  } else { /* A is SBAIJ */
      Mat_SeqSBAIJ *mat = (Mat_SeqSBAIJ*)A->data;
      ai=mat->i; aj=mat->j; av=mat->a;
      nz=mat->nz;
  } 
  InpMtx_init(lu->mtxA, INPMTX_BY_ROWS, lu->options.typeflag, nz, 0);
 
#if defined(PETSC_USE_COMPLEX)
    for (irow=0; irow<nrow; irow++) {
      if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !(isSeqAIJ || isMPIAIJ)){
        nz_row = ai[irow+1] - ai[irow];
        aj_tmp = aj + ai[irow];
        av_tmp = av + ai[irow];
      } else {
        nz_row = ai[irow+1] - diag[irow];
        aj_tmp = aj + diag[irow];
        av_tmp = av + diag[irow];
      }
      for (i=0; i<nz_row; i++){
        InpMtx_inputComplexEntry(lu->mtxA, irow, *aj_tmp++,PetscRealPart(*av_tmp),PetscImaginaryPart(*av_tmp));
        av_tmp++;
      }
    }
#else
    ivec1 = InpMtx_ivec1(lu->mtxA); 
    ivec2 = InpMtx_ivec2(lu->mtxA);
    dvec  = InpMtx_dvec(lu->mtxA);
    if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !isSeqAIJ){
      for (irow = 0; irow < nrow; irow++){
        for (i = ai[irow]; i<ai[irow+1]; i++) ivec1[i] = irow;
      }
      IVcopy(nz, ivec2, aj);
      DVcopy(nz, dvec, av);
    } else { 
      nz = 0;
      for (irow = 0; irow < nrow; irow++){
        for (j = diag[irow]; j<ai[irow+1]; j++) {
          ivec1[nz] = irow;
          ivec2[nz] = aj[j];
          dvec[nz]  = av[j];
          nz++;
        }
      }
    }
    InpMtx_inputRealTriples(lu->mtxA, nz, ivec1, ivec2, dvec); 
#endif

  InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS); 
  if ( lu->options.msglvl > 0 ) {
    int err;
    printf("\n\n input matrix");
    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix");CHKERRQ(ierr);
    InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  if ( lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */  
    /*---------------------------------------------------
    find a low-fill ordering
         (1) create the Graph object
         (2) order the graph 
    -------------------------------------------------------*/  
    if (lu->options.useQR){
      adjIVL = InpMtx_adjForATA(lu->mtxA);
    } else {
      adjIVL = InpMtx_fullAdjacency(lu->mtxA);
    }
    nedges = IVL_tsize(adjIVL);

    lu->graph = Graph_new();
    Graph_init2(lu->graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL);
    if ( lu->options.msglvl > 2 ) {
      int err;

      if (lu->options.useQR){
        ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of A^T A");CHKERRQ(ierr);
      } else {
        ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of the input matrix");CHKERRQ(ierr);
      }
      Graph_writeForHumanEye(lu->graph, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }

    switch (lu->options.ordering) {
    case 0:
      lu->frontETree = orderViaBestOfNDandMS(lu->graph,
                     lu->options.maxdomainsize, lu->options.maxzeros, lu->options.maxsize,
                     lu->options.seed, lu->options.msglvl, lu->options.msgFile); break;
    case 1:
      lu->frontETree = orderViaMMD(lu->graph,lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    case 2:
      lu->frontETree = orderViaMS(lu->graph, lu->options.maxdomainsize,
                     lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    case 3:
      lu->frontETree = orderViaND(lu->graph, lu->options.maxdomainsize, 
                     lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    default:
      SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown Spooles's ordering");
    }

    if ( lu->options.msglvl > 0 ) {
      int err;

      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree from ordering");CHKERRQ(ierr);
      ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }
  
    /* get the permutation, permute the front tree */
    lu->oldToNewIV = ETree_oldToNewVtxPerm(lu->frontETree);
    lu->oldToNew   = IV_entries(lu->oldToNewIV);
    lu->newToOldIV = ETree_newToOldVtxPerm(lu->frontETree);
    if (!lu->options.useQR) ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);

    /* permute the matrix */
    if (lu->options.useQR){
      InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
    } else {
      InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); 
      if ( lu->options.symflag == SPOOLES_SYMMETRIC) {
        InpMtx_mapToUpperTriangle(lu->mtxA); 
      }
#if defined(PETSC_USE_COMPLEX)
      if ( lu->options.symflag == SPOOLES_HERMITIAN ) {
        InpMtx_mapToUpperTriangleH(lu->mtxA); 
      }
#endif
      InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
    }
    InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);

    /* get symbolic factorization */
    if (lu->options.useQR){
      lu->symbfacIVL = SymbFac_initFromGraph(lu->frontETree, lu->graph);
      IVL_overwrite(lu->symbfacIVL, lu->oldToNewIV);
      IVL_sortUp(lu->symbfacIVL);
      ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);
    } else {
      lu->symbfacIVL = SymbFac_initFromInpMtx(lu->frontETree, lu->mtxA);
    }
    if ( lu->options.msglvl > 2 ) {
      int err;

      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n old-to-new permutation vector");CHKERRQ(ierr);
      IV_writeForHumanEye(lu->oldToNewIV, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n new-to-old permutation vector");CHKERRQ(ierr);
      IV_writeForHumanEye(lu->newToOldIV, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree after permutation");CHKERRQ(ierr);
      ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
      InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n symbolic factorization");CHKERRQ(ierr);
      IVL_writeForHumanEye(lu->symbfacIVL, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }  

    lu->frontmtx   = FrontMtx_new();
    lu->mtxmanager = SubMtxManager_new();
    SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);

  } else { /* new num factorization using previously computed symbolic factor */ 

    if (lu->options.pivotingflag) { /* different FrontMtx is required */
      FrontMtx_free(lu->frontmtx);   
      lu->frontmtx   = FrontMtx_new();
    } else {
      FrontMtx_clearData (lu->frontmtx); 
    }

    SubMtxManager_free(lu->mtxmanager);  
    lu->mtxmanager = SubMtxManager_new();
    SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);

    /* permute mtxA */
    if (lu->options.useQR){
      InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
    } else {
      InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); 
      if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
        InpMtx_mapToUpperTriangle(lu->mtxA); 
      }
      InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
    }
    InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);
    if ( lu->options.msglvl > 2 ) {
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
      InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile); 
    } 
  } /* end of if( lu->flg == DIFFERENT_NONZERO_PATTERN) */
  
  if (lu->options.useQR){
    FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, 
                 SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, 
                 SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL,
                 lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);
  } else {
    FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, lu->options.symflag, 
                FRONTMTX_DENSE_FRONTS, lu->options.pivotingflag, NO_LOCK, 0, NULL, 
                lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);   
  }

  if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {  /* || SPOOLES_HERMITIAN ? */
    if ( lu->options.patchAndGoFlag == 1 ) {
      lu->frontmtx->patchinfo = PatchAndGoInfo_new();
      PatchAndGoInfo_init(lu->frontmtx->patchinfo, 1, lu->options.toosmall, lu->options.fudge,
                       lu->options.storeids, lu->options.storevalues);
    } else if ( lu->options.patchAndGoFlag == 2 ) {
      lu->frontmtx->patchinfo = PatchAndGoInfo_new();
      PatchAndGoInfo_init(lu->frontmtx->patchinfo, 2, lu->options.toosmall, lu->options.fudge,
                       lu->options.storeids, lu->options.storevalues);
    }   
  }

  /* numerical factorization */
  chvmanager = ChvManager_new();
  ChvManager_init(chvmanager, NO_LOCK, 1);
  DVfill(10, lu->cpus, 0.0);
  if (lu->options.useQR){
    facops = 0.0 ; 
    FrontMtx_QR_factor(lu->frontmtx, lu->mtxA, chvmanager, 
                   lu->cpus, &facops, lu->options.msglvl, lu->options.msgFile);
    if ( lu->options.msglvl > 1 ) {
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n facops = %9.2f", facops);CHKERRQ(ierr);
    }
  } else {
    IVfill(20, lu->stats, 0);
    rootchv = FrontMtx_factorInpMtx(lu->frontmtx, lu->mtxA, lu->options.tau, 0.0, 
            chvmanager, &fierr, lu->cpus,lu->stats,lu->options.msglvl,lu->options.msgFile); 
    if (rootchv) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"\n matrix found to be singular");    
    if (fierr >= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"\n error encountered at front %D", fierr);
    
    if(lu->options.FrontMtxInfo){
      ierr = PetscPrintf(PETSC_COMM_SELF,"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns\n",lu->stats[0], lu->stats[1], lu->stats[2]);CHKERRQ(ierr);
      cputotal = lu->cpus[8] ;
      if ( cputotal > 0.0 ) {
        ierr = PetscPrintf(PETSC_COMM_SELF,
           "\n                               cpus   cpus/totaltime"
           "\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 \n",
           lu->cpus[0], 100.*lu->cpus[0]/cputotal,
           lu->cpus[1], 100.*lu->cpus[1]/cputotal,
           lu->cpus[2], 100.*lu->cpus[2]/cputotal,
           lu->cpus[3], 100.*lu->cpus[3]/cputotal,
           lu->cpus[4], 100.*lu->cpus[4]/cputotal,
           lu->cpus[5], 100.*lu->cpus[5]/cputotal,
           lu->cpus[6], 100.*lu->cpus[6]/cputotal,
	   lu->cpus[7], 100.*lu->cpus[7]/cputotal, cputotal);CHKERRQ(ierr);
      }
    }
  }
  ChvManager_free(chvmanager);

  if ( lu->options.msglvl > 0 ) {
    int err;

    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
    FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */
    if ( lu->options.patchAndGoFlag == 1 ) {
      if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
        if (lu->options.msglvl > 0 ){
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
          IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
        }
      }
      PatchAndGoInfo_free(lu->frontmtx->patchinfo);
    } else if ( lu->options.patchAndGoFlag == 2 ) {
      if (lu->options.msglvl > 0 ){
        if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
          IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
        }
        if ( lu->frontmtx->patchinfo->fudgeDV != NULL ) {
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n perturbations");CHKERRQ(ierr);
          DV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeDV, lu->options.msgFile);
        }
      }
      PatchAndGoInfo_free(lu->frontmtx->patchinfo);
    }
  }

  /* post-process the factorization */
  FrontMtx_postProcess(lu->frontmtx, lu->options.msglvl, lu->options.msgFile);
  if ( lu->options.msglvl > 2 ) {
    int err;

    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix after post-processing");CHKERRQ(ierr);
    FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  lu->flg = SAME_NONZERO_PATTERN;
  lu->CleanUpSpooles = PETSC_TRUE;
  PetscFunctionReturn(0);
}
Exemple #24
0
/*--------------------------------------------------------------------*/
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) ; }
Exemple #25
0
/*
   -------------------------------------------
   purpose -- to write an IV object to a file

   input --

      fn -- filename
        *.ivb -- binary
        *.ivf -- formatted
        anything else -- for human eye

   return value -- 1 if success, 0 otherwise

   created -- 95oct06, cca
   -------------------------------------------
*/
int
IV_writeToFile ( 
   IV    *iv, 
   char   *fn 
) {
FILE   *fp ;
int    fnlength, rc, sulength ;
/*
   ---------------
   check the input
   ---------------
*/
if ( iv == NULL || fn == NULL ) {
   fprintf(stderr, "\n fatal error in IV_writeToFile(%p,%s)"
    "\n bad input\n", iv, fn) ; 
}
/*
   ------------------
   write out the file
   ------------------
*/
fnlength = strlen(fn) ;
sulength = strlen(suffixb) ;
if ( fnlength > sulength ) {
   if ( strcmp(&fn[fnlength-sulength], suffixb) == 0 ) {
      if ( (fp = fopen(fn, "wb")) == NULL ) {
         fprintf(stderr, "\n error in IV_writeToFile(%p,%s)"
                 "\n unable to open file %s", iv, fn, fn) ;
         rc = 0 ;
      } else {
         rc = IV_writeToBinaryFile(iv, fp) ;
         fclose(fp) ;
      }
   } else if ( strcmp(&fn[fnlength-sulength], suffixf) == 0 ) {
      if ( (fp = fopen(fn, "w")) == NULL ) {
         fprintf(stderr, "\n error in IV_writeToFile(%p,%s)"
                 "\n unable to open file %s", iv, fn, fn) ;
         rc = 0 ;
      } else {
         rc = IV_writeToFormattedFile(iv, fp) ;
         fclose(fp) ;
      }
   } else {
      if ( (fp = fopen(fn, "a")) == NULL ) {
         fprintf(stderr, "\n error in IV_writeToFile(%p,%s)"
                 "\n unable to open file %s", iv, fn, fn) ;
         rc = 0 ;
      } else {
         rc = IV_writeForHumanEye(iv, fp) ;
         fclose(fp) ;
      }
   }
} else {
   if ( (fp = fopen(fn, "a")) == NULL ) {
      fprintf(stderr, "\n error in IV_writeToFile(%p,%s)"
              "\n unable to open file %s", iv, fn, fn) ;
      rc = 0 ;
   } else {
      rc = IV_writeForHumanEye(iv, fp) ;
      fclose(fp) ;
   }
}
return(rc) ; }
/*
   -----------------------------------------------------------------
   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) ;
}
Exemple #27
0
/*
   -------------------------------------------------------------
   purpose -- 

   the IVL object ivl and IV object ownersIV are both found on 
   each process.  the ownersIV object is identical over all the 
   processes, and owners[ii] tells which processes owns list ii 
   of the ivl object. on return from this method, the ivl object 
   is replicated over all the processes. each process sends 
   the lists that it owns to all the other processes.

   created -- 98apr03, cca
   -------------------------------------------------------------
*/
void
IVL_MPI_allgather (
   IVL        *ivl,
   IV         *ownersIV,
   int        stats[],
   int        msglvl,
   FILE       *msgFile,
   int        firsttag,
   MPI_Comm   comm
) {
int          count, destination, ii, ilist, incount, jlist, 
             jproc, left, maxcount, myid, nlist, nmylists, 
             notherlists, nowners, nproc, offset, outcount, 
             right, size, source, tag ;
int          *counts, *inbuffer, *list, *outbuffer, *owners ;
MPI_Status   status ;
/*
   ---------------
   check the input
   ---------------
*/
if ( ivl == NULL || ownersIV == NULL ) {
   fprintf(stderr, "\n fatal error in IVL_MPI_allgather()"
           "\n ivl = %p, ownersIV = %p\n",
           ivl, ownersIV) ;
   exit(-1) ;
}
/*
   ----------------------------------------------
   get id of self, # of processes and # of fronts
   ----------------------------------------------
*/
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
nlist = ivl->nlist ;
IV_sizeAndEntries(ownersIV, &nowners, &owners) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n inside IVL_MPI_allgather()"
           "\n nproc = %d, myid = %d, nlist = %d, nowners = %d",
           nproc, myid, nlist, nowners) ;
   fflush(msgFile) ;
}
if ( nlist != nowners || owners == NULL ) {
   fprintf(stderr, "\n fatal error in IVL_MPI_allgather()"
           "\n nlist = %d, nowners = %d, owners = %p\n",
           nlist, nowners, owners) ;
   exit(-1) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n ivl") ;
   IVL_writeForHumanEye(ivl, msgFile) ;
   fprintf(msgFile, "\n\n ownersIV") ;
   IV_writeForHumanEye(ownersIV, msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------------------------------------
   step 1 : determine the size of the message that
            this process will send to the others
   -----------------------------------------------
*/
for ( ilist = 0, outcount = 1 ; ilist < nlist ; ilist++ ) {
   if ( owners[ilist] < 0 || owners[ilist] >= nproc ) {
      fprintf(stderr, "\n owners[%d] = %d", ilist, owners[ilist]) ;
      exit(-1) ;
   }
   if ( owners[ilist] == myid ) {
      outcount += 2 ;
      IVL_listAndSize(ivl, ilist, &size, &list) ;
      outcount += size ;
   }
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n outcount = %d", outcount) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------------------------
   do an all-to-all gather/scatter
   counts[jproc] = # of int's in the message from jproc
   ----------------------------------------------------
*/
counts = IVinit(nproc, 0) ;
counts[myid] = outcount ;
MPI_Allgather((void *) &counts[myid], 1, MPI_INT,
              (void *) counts,  1, MPI_INT, comm) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n counts") ;
   IVfprintf(msgFile, nproc, counts) ;
   fflush(msgFile) ;
}
/*
   -----------------------------
   set up the in and out buffers
   -----------------------------
*/
if ( outcount > 0 ) {
   outbuffer = IVinit(outcount, -1) ;
   for ( ilist = nmylists = 0, ii = 1 ; ilist < nlist ; ilist++ ) {
      if ( owners[ilist] == myid ) {
         nmylists++ ;
         IVL_listAndSize(ivl, ilist, &size, &list) ;
         outbuffer[ii++] = ilist ;
         outbuffer[ii++] = size  ;
         if ( size > 0 ) {
            IVcopy(size, &outbuffer[ii], list) ;
            ii += size ;
         }
      }
   }
   outbuffer[0] = nmylists ;
   if ( ii != outcount ) {
      fprintf(stderr, "\n myid = %d, ii = %d, outcount = %d",
              myid, ii, outcount) ;
      fprintf(msgFile, "\n myid = %d, ii = %d, outcount = %d",
              myid, ii, outcount) ;
      exit(-1) ;
   }
} else {
   outbuffer = NULL ;
}
maxcount = IVmax(nproc, counts, &jproc) ;
if ( maxcount > 0 ) {
   inbuffer = IVinit(maxcount, -1) ;
} else {
   inbuffer = NULL ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n outbuffer %p, maxcount %d, inbuffer %p",
           outbuffer, maxcount, inbuffer) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------
   step 2: loop over the other processes
      send and receive information
   -------------------------------------
*/
for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) {
   right = (myid + offset) % nproc ;
   if ( offset <= myid ) {
      left = myid - offset ;
   } else {
      left = nproc + myid - offset ;
   }
   if ( outcount > 0 ) {
      destination = right ;
      stats[0]++ ;
      stats[2] += outcount*sizeof(int) ;
   } else {
      destination = MPI_PROC_NULL ;
   }
   incount = counts[left] ;
   if ( incount > 0 ) {
      source = left ;
      stats[1]++ ;
      stats[3] += incount*sizeof(int) ;
   } else {
      source = MPI_PROC_NULL ;
   }
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n offset %d, source %d, destination %d",
              offset, source, destination) ;
      fflush(msgFile) ;
   }
/*
   -----------------
   do a send/receive
   -----------------
*/
   MPI_Sendrecv(outbuffer, outcount, MPI_INT, destination, tag,
                inbuffer,  incount,  MPI_INT, source,      tag,
                comm, &status) ;
   if ( source != MPI_PROC_NULL ) {
      MPI_Get_count(&status, MPI_INT, &count) ;
      if ( count != incount ) {
         fprintf(stderr,
                 "\n 1. fatal error in IVL_MPI_allgather()"
                 "\n proc %d : source = %d, count = %d, incount = %d\n",
                 myid, source, count, incount) ;
         exit(-1) ;
      }
   }
/*
   ----------------------------
   set the values in the vector
   ----------------------------
*/
   notherlists = inbuffer[0] ;
   for ( ilist = 0, ii = 1 ; ilist < notherlists ; ilist++ ) {
      jlist = inbuffer[ii++] ;
      size  = inbuffer[ii++] ;
      if ( size > 0 ) {
         IVL_setList(ivl, jlist, size, &inbuffer[ii]) ;
         ii += size ;
      }
   }
   if ( ii != incount ) {
      fprintf(msgFile, "\n ii = %d, incount = %d", ii, incount) ;
      fprintf(stderr, "\n ii = %d, incount = %d", ii, incount) ;
      exit(-1) ;
   }
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n after setting values") ;
      IVL_writeForHumanEye(ivl, msgFile) ;
      fflush(msgFile) ;
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(counts) ;
if ( outbuffer != NULL ) {
   IVfree(outbuffer) ;
}
if ( inbuffer != NULL ) {
   IVfree(inbuffer) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n leaving IVL_MPI_gatherall()") ;
   fflush(msgFile) ;
}
return ; }
Exemple #28
0
/*
   ---------------------------------------------------------------------
   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; }
Exemple #29
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------------------
   (1) read in an ETree object.
   (2) read in an Graph object.
   (3) find the optimal domain/schur complement partition
       for a semi-implicit factorization
   
   created -- 96oct03, cca
   ------------------------------------------------------
*/
{
char     *inETreeFileName, *inGraphFileName, *outIVfileName ;
double   alpha, nA21, nfent1, nfops1, nL11, nL22, nPhi, nV, t1, t2 ;
Graph    *graph ;
int      ii, inside, J, K, msglvl, nfind1, nfront, nJ, nleaves1, 
         nnode1, nvtx, rc, sizeJ, totalgain, vsize, v, w ;
int      *adjJ, *compids, *nodwghts, *vadj, *vtxToFront, *vwghts ;
IV       *compidsIV ;
IVL      *symbfacIVL ;
ETree    *etree ;
FILE     *msgFile ;
Tree     *tree ;

if ( argc != 7 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile inETreeFile inGraphFile alpha"
"\n         outIVfile "
"\n    msglvl       -- message level"
"\n    msgFile      -- message file"
"\n    inETreeFile  -- input file, must be *.etreef or *.etreeb"
"\n    inGraphFile  -- input file, must be *.graphf or *.graphb"
"\n    alpha        -- weight parameter"
"\n       alpha = 0 --> minimize storage"
"\n       alpha = 1 --> minimize solve ops"
"\n    outIVfile    -- output file for oldToNew vector,"
"\n                    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] ;
inGraphFileName  = argv[4] ;
alpha            = atof(argv[5]) ;
outIVfileName    = argv[6] ;
fprintf(msgFile, 
        "\n %s "
        "\n msglvl        -- %d" 
        "\n msgFile       -- %s" 
        "\n inETreeFile   -- %s" 
        "\n inGraphFile   -- %s" 
        "\n alpha         -- %f" 
        "\n outIVfile     -- %s" 
        "\n",
        argv[0], msglvl, argv[2], 
        inETreeFileName, inGraphFileName, alpha, outIVfileName) ;
fflush(msgFile) ;
/*
   ------------------------
   read in the ETree object
   ------------------------
*/
if ( strcmp(inETreeFileName, "none") == 0 ) {
   fprintf(msgFile, "\n no file to read from") ;
   spoolesFatal();
}
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) ;
   spoolesFatal();
}
ETree_leftJustify(etree) ;
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) ;
tree       = ETree_tree(etree) ;
nodwghts   = ETree_nodwghts(etree) ;
vtxToFront = ETree_vtxToFront(etree) ;
/*
   ------------------------
   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) ;
nvtx = graph->nvtx ;
vwghts = graph->vwghts ;
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) ;
/*
   ----------------------
   compute the statistics
   ----------------------
*/
nnode1 = etree->tree->n ;
nfind1 = ETree_nFactorIndices(etree) ;
nfent1 = ETree_nFactorEntries(etree, SPOOLES_SYMMETRIC) ;
nfops1 = ETree_nFactorOps(etree, SPOOLES_REAL, SPOOLES_SYMMETRIC) ;
nleaves1 = Tree_nleaves(etree->tree) ;
fprintf(stdout, "\n root front %d has %d vertices",
        etree->tree->root,
        etree->nodwghtsIV->vec[etree->tree->root]) ;
/*
   ---------------------------------
   create the symbolic factorization
   ---------------------------------
*/
symbfacIVL = SymbFac_initFromGraph(etree, graph) ;
if ( msglvl > 2 ) {
   IVL_writeForHumanEye(symbfacIVL, msgFile) ;
} else {
   IVL_writeStats(symbfacIVL, msgFile) ;
}
fflush(msgFile) ;
/*
   --------------------------
   find the optimal partition
   --------------------------
*/
compidsIV = ETree_optPart(etree, graph, symbfacIVL, alpha,
                          &totalgain, msglvl, msgFile) ;
if ( msglvl > 2 ) {
   IV_writeForHumanEye(compidsIV, msgFile) ;
} else {
   IV_writeStats(compidsIV, msgFile) ;
}
fflush(msgFile) ;
compids = IV_entries(compidsIV) ;
/*
   ------------------------------------------------------
   compute the number of vertices in the schur complement
   ------------------------------------------------------
*/
for ( J = 0, nPhi = nV = 0. ; J < nfront ; J++ ) {
   if ( compids[J] == 0 ) {
      nPhi += nodwghts[J] ;
   }
   nV += nodwghts[J] ;
}
/*
   --------------------------------------------
   compute the number of entries in L11 and L22
   --------------------------------------------
*/
nL11 = nL22 = 0 ;
for ( J = Tree_postOTfirst(tree) ;
      J != -1 ;
      J = Tree_postOTnext(tree, J) ) {
   nJ = nodwghts[J] ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n\n front %d, nJ = %d", J, nJ) ;
   }
   IVL_listAndSize(symbfacIVL, J, &sizeJ, &adjJ) ;
   for ( ii = 0, inside = 0 ; ii < sizeJ ; ii++ ) {
      w = adjJ[ii] ;
      K = vtxToFront[w] ;
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n    w = %d, K = %d", w, K) ;
      }
      if ( K > J && compids[K] == compids[J] ) {
         inside += (vwghts == NULL) ? 1 : vwghts[w] ;
         if ( msglvl > 3 ) {
            fprintf(msgFile, ", inside") ;
         }
      }
   }
   if ( compids[J] != 0 ) {
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n    inside = %d, adding %d to L11",
                 inside, nJ*nJ + 2*nJ*inside) ;
      }
      nL11 += (nJ*(nJ+1))/2 + nJ*inside ;
   } else {
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n    inside = %d, adding %d to L22",
                 inside, (nJ*(nJ+1))/2 + nJ*inside) ;
      }
      nL22 += (nJ*(nJ+1))/2 + nJ*inside ;
   }
}
if ( msglvl > 0 ) {
   fprintf(msgFile, "\n |L| = %.0f, |L11| = %.0f, |L22| = %.0f",
           nfent1, nL11, nL22) ;
}
/*
   ------------------------------------
   compute the number of entries in A21
   ------------------------------------
*/
nA21 = 0 ;
if ( vwghts != NULL ) {
   for ( v = 0 ; v < nvtx ; v++ ) {
      J = vtxToFront[v] ;
      if ( compids[J] != 0 ) {
         Graph_adjAndSize(graph, v, &vsize, &vadj) ;
         for ( ii = 0 ; ii < vsize ; ii++ ) {
            w = vadj[ii] ;
            K = vtxToFront[w] ;
            if ( compids[K] == 0 ) {
               if ( msglvl > 3 ) {
                  fprintf(msgFile, "\n A21 : v = %d, w = %d", v, w) ;
               }
               nA21 += vwghts[v] * vwghts[w] ;
            }
         }
      }
   }
} else {
   for ( v = 0 ; v < nvtx ; v++ ) {
      J = vtxToFront[v] ;
      if ( compids[J] != 0 ) {
         Graph_adjAndSize(graph, v, &vsize, &vadj) ;
         for ( ii = 0 ; ii < vsize ; ii++ ) {
            w = vadj[ii] ;
            K = vtxToFront[w] ;
            if ( compids[K] == 0 ) {
               if ( msglvl > 3 ) {
                  fprintf(msgFile, "\n A21 : v = %d, w = %d", v, w) ;
               }
               nA21++ ;
            }
         }
      }
   }
}
if ( msglvl > 0 ) {
   fprintf(msgFile,
           "\n |L| = %.0f, |L11| = %.0f, |L22| = %.0f, |A21| = %.0f",
           nfent1, nL11, nL22, nA21) ;
   fprintf(msgFile,
      "\n storage: explicit = %.0f, semi-implicit = %.0f, ratio = %.3f"
      "\n opcount: explicit = %.0f, semi-implicit = %.0f, ratio = %.3f",
      nfent1, nL11 + nA21 + nL22,
      nfent1/(nL11 + nA21 + nL22),
      2*nfent1, 4*nL11 + 2*nA21 + 2*nL22,
      2*nfent1/(4*nL11 + 2*nA21 + 2*nL22)) ;
   fprintf(msgFile, "\n ratios %8.3f %8.3f %8.3f",
           nPhi/nV,
           nfent1/(nL11 + nA21 + nL22),
           2*nfent1/(4*nL11 + 2*nA21 + 2*nL22)) ;
}
/*
   ----------------
   free the objects
   ----------------
*/
ETree_free(etree) ;
Graph_free(graph) ;
IVL_free(symbfacIVL) ;

fprintf(msgFile, "\n") ;
fclose(msgFile) ;

return(1) ; }
Exemple #30
0
//static void factor_MT(struct factorinfo *pfi, InpMtx *mtxA, int size, FILE *msgFile, int symmetryflag)
void factor_MT(struct factorinfo *pfi, InpMtx *mtxA, int size, FILE *msgFile, int symmetryflag)
{
	Graph *graph;
	IV *ownersIV;
	IVL *symbfacIVL;
	Chv *rootchv;

	/* Initialize pfi: */
	pfi->size = size;
	pfi->msgFile = msgFile;
	DVfill(10, pfi->cpus, 0.0);

	/*
	 * STEP 1 : find a low-fill ordering
	 * (1) create the Graph object
	 */
	ssolve_creategraph(&graph, &pfi->frontETree, mtxA, size, msgFile);

	/*
	 * STEP 2: get the permutation, permute the matrix and 
	 *      front tree and get the symbolic factorization
	 */
	ssolve_permuteA(&pfi->oldToNewIV, &pfi->newToOldIV, &symbfacIVL, pfi->frontETree,
		     mtxA, msgFile, symmetryflag);

	/*
	 * STEP 3: Prepare distribution to multiple threads/cpus
	 */
	{
		DV *cumopsDV;
		int nfront;

		nfront = ETree_nfront(pfi->frontETree);

		pfi->nthread = num_cpus;
		if (pfi->nthread > nfront)
			pfi->nthread = nfront;

		cumopsDV = DV_new();
		DV_init(cumopsDV, pfi->nthread, NULL);
		ownersIV = ETree_ddMap(pfi->frontETree, SPOOLES_REAL, symmetryflag,
				       cumopsDV, 1. / (2. * pfi->nthread));
		if (DEBUG_LVL > 1) {
			fprintf(msgFile,
				"\n\n map from fronts to threads");
			IV_writeForHumanEye(ownersIV, msgFile);
			fprintf(msgFile,
				"\n\n factor operations for each front");
			DV_writeForHumanEye(cumopsDV, msgFile);
			fflush(msgFile);
		} else {
			fprintf(msgFile, "\n\n Using %d threads\n",
				pfi->nthread);
		}
		DV_free(cumopsDV);
	}

	/*
	 * STEP 4: initialize the front matrix object
	 */
	{
		pfi->frontmtx = FrontMtx_new();
		pfi->mtxmanager = SubMtxManager_new();
		SubMtxManager_init(pfi->mtxmanager, LOCK_IN_PROCESS, 0);
		FrontMtx_init(pfi->frontmtx, pfi->frontETree, symbfacIVL, SPOOLES_REAL,
			      symmetryflag, FRONTMTX_DENSE_FRONTS,
			      SPOOLES_PIVOTING, LOCK_IN_PROCESS, 0, NULL,
			      pfi->mtxmanager, DEBUG_LVL, pfi->msgFile);
	}

	/*
	 * STEP 5: compute the numeric factorization in parallel
	 */
	{
		ChvManager *chvmanager;
		int stats[20];
		int error;

		chvmanager = ChvManager_new();
		ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1);
		IVfill(20, stats, 0);
		rootchv = FrontMtx_MT_factorInpMtx(pfi->frontmtx, mtxA, MAGIC_TAU, MAGIC_DTOL,
						   chvmanager, ownersIV, 0,
						   &error, pfi->cpus, stats, DEBUG_LVL,
						   pfi->msgFile);
		ChvManager_free(chvmanager);
		if (DEBUG_LVL > 1) {
			fprintf(msgFile, "\n\n factor matrix");
			FrontMtx_writeForHumanEye(pfi->frontmtx, pfi->msgFile);
			fflush(pfi->msgFile);
		}
		if (rootchv != NULL) {
			fprintf(pfi->msgFile, "\n\n matrix found to be singular\n");
			exit(-1);
		}
		if (error >= 0) {
			fprintf(pfi->msgFile, "\n\n fatal error at front %d", error);
			exit(-1);
		}
	}

	/*
	 * STEP 6: post-process the factorization
	 */
	ssolve_postfactor(pfi->frontmtx, pfi->msgFile);

	/*
	 * STEP 7: get the solve map object for the parallel solve
	 */
	{
		pfi->solvemap = SolveMap_new();
		SolveMap_ddMap(pfi->solvemap, symmetryflag,
			       FrontMtx_upperBlockIVL(pfi->frontmtx),
			       FrontMtx_lowerBlockIVL(pfi->frontmtx), pfi->nthread, ownersIV,
			       FrontMtx_frontTree(pfi->frontmtx), RNDSEED, DEBUG_LVL,
			       pfi->msgFile);
	}

	/* cleanup: */
	InpMtx_free(mtxA);
	IVL_free(symbfacIVL);
	Graph_free(graph);
	IV_free(ownersIV);
}