/*
----------------------------------------------------
purpose -- to write a Pencil object for a human eye
return value -- 1 if success, 0 otherwise
created -- 97jul18, cca
----------------------------------------------------
*/
int
Pencil_writeForHumanEye (
Pencil *pencil,
FILE *fp
) {
if ( pencil == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Pencil_writeForHumanEye(%p,%p)"
"\n bad input\n", pencil, fp) ;
exit(-1) ;
}
/*
------------------------
write out the statistics
------------------------
*/
Pencil_writeStats(pencil, fp) ;
if ( pencil->inpmtxA != NULL ) {
fprintf(fp, "\n\n inpmtxA") ;
InpMtx_writeForHumanEye(pencil->inpmtxA, fp) ;
}
if ( pencil->inpmtxB != NULL ) {
fprintf(fp, "\n\n inpmtxB") ;
InpMtx_writeForHumanEye(pencil->inpmtxB, fp) ;
}
return(1) ; }
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);
}
}
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
--------------------------------------------------------------------
this program tests the Graph_MPI_Bcast() method
(1) process root generates a random Graph object
and computes its checksum
(2) process root broadcasts the Graph object to the other processors
(3) each process computes the checksum of its Graph object
(4) the checksums are compared on root
created -- 98sep10, cca
--------------------------------------------------------------------
*/
{
char *buffer ;
double chksum, t1, t2 ;
double *sums ;
Drand drand ;
int iproc, length, loc, msglvl, myid, nitem, nproc,
nvtx, root, seed, size, type, v ;
int *list ;
FILE *msgFile ;
Graph *graph ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of graph"
"\n nvtx -- # of vertices"
"\n nitem -- # of items used to generate graph"
"\n root -- root processor for broadcast"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
type = atoi(argv[3]) ;
nvtx = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n type -- %d"
"\n nvtx -- %d"
"\n nitem -- %d"
"\n root -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
-----------------------
set up the Graph object
-----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
InpMtx *inpmtx ;
int nedges, totewght, totvwght, v ;
int *adj, *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
-----------------------
generate a random graph
-----------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nvtx) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
InpMtx_setNent(inpmtx, nitem) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n full adjacency structure") ;
IVL_writeForHumanEye(adjIVL, msgFile) ;
fflush(msgFile) ;
}
nedges = adjIVL->tsize ;
if ( type == 1 || type == 3 ) {
Drand_setUniform(&drand, 1, 10) ;
vwghts = IVinit(nvtx, 0) ;
Drand_fillIvector(&drand, nvtx, vwghts) ;
totvwght = IVsum(nvtx, vwghts) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex weights") ;
IVfprintf(msgFile, nvtx, vwghts) ;
fflush(msgFile) ;
}
} else {
vwghts = NULL ;
totvwght = nvtx ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
fflush(msgFile) ;
}
if ( type == 2 || type == 3 ) {
ewghtIVL = IVL_new() ;
IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
Drand_setUniform(&drand, 1, 100) ;
totewght = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(adjIVL, v, &size, &adj) ;
IVL_setList(ewghtIVL, v, size, NULL) ;
IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
Drand_fillIvector(&drand, size, adj) ;
totewght += IVsum(size, adj) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ewghtIVL") ;
IVL_writeForHumanEye(ewghtIVL, msgFile) ;
fflush(msgFile) ;
}
} else {
ewghtIVL = NULL ;
totewght = nedges ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totewght %d", totewght) ;
fflush(msgFile) ;
}
Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile,
"\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
}
/*
--------------------------
broadcast the Graph object
--------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
---------------------------------------
gather the checksums from the processes
---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE,
(void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile, "\n\n sums") ;
DVfprintf(msgFile, nproc, sums) ;
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
sums[iproc] -= chksum ;
}
fprintf(msgFile, "\n\n errors") ;
DVfprintf(msgFile, nproc, sums) ;
fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
----------------
free the objects
----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------
test InpMtx_readFromFile and InpMtx_writeToFile,
useful for translating between formatted *.inpmtxf
and binary *.inpmtxb files.
created -- 95dec17, cca
---------------------------------------------------
*/
{
int msglvl, rc ;
InpMtx *inpmtx ;
FILE *msgFile ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : testIO msglvl msgFile inFile outFile"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inFile -- input file, must be *.inpmtxf or *.inpmtxb"
"\n outFile -- output file, must be *.inpmtxf or *.inpmtxb"
"\n") ;
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) ;
}
fprintf(msgFile,
"\n testIO "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inFile -- %s"
"\n outFile -- %s"
"\n",
msglvl, argv[2], argv[3], argv[4]) ;
fflush(msgFile) ;
/*
----------------------
set the default fields
----------------------
*/
inpmtx = InpMtx_new() ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n after setting default fields") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------
read in the InpMtx object
--------------------------
*/
if ( strcmp(argv[3], "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
spoolesFatal();
}
rc = InpMtx_readFromFile(inpmtx, argv[3]) ;
fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)",
rc, inpmtx, argv[3]) ;
if ( rc != 1 ) {
spoolesFatal();
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after reading InpMtx object from file %s",
argv[3]) ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------------
change the storage mode to vectors
----------------------------------
*/
InpMtx_changeCoordType(inpmtx, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after changing storage mode") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
write out the InpMtx object
---------------------------
*/
if ( strcmp(argv[4], "none") != 0 ) {
rc = InpMtx_writeToFile(inpmtx, argv[4]) ;
fprintf(msgFile,
"\n return value %d from InpMtx_writeToFile(%p,%s)",
rc, inpmtx, argv[4]) ;
}
/*
---------------
free the object
---------------
*/
InpMtx_free(inpmtx) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
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);
}
int
main ( int argc, char *argv[] )
/*
-----------------------------------------------------
test the factor method for a grid matrix
(1) construct a linear system for a nested dissection
ordering on a regular grid
(2) create a solution matrix object
(3) multiply the solution with the matrix
to get a right hand side matrix object
(4) factor the matrix
(5) solve the system
created -- 98may16, cca
-----------------------------------------------------
*/
{
Chv *chv, *rootchv ;
ChvManager *chvmanager ;
DenseMtx *mtxB, *mtxX, *mtxZ ;
FrontMtx *frontmtx ;
InpMtx *mtxA ;
SubMtxManager *mtxmanager ;
double cputotal, droptol, factorops ;
double cpus[9] ;
Drand drand ;
double nops, tau, t1, t2 ;
ETree *frontETree ;
FILE *msgFile ;
int error, lockflag, maxsize, maxzeros, msglvl, neqns,
n1, n2, n3, nrhs, nzf, pivotingflag,
seed, sparsityflag, symmetryflag, type ;
int stats[6] ;
IVL *symbfacIVL ;
if ( argc != 17 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile n1 n2 n3 maxzeros maxsize"
"\n seed type symmetryflag sparsityflag "
"\n pivotingflag tau droptol lockflag nrhs"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n n1 -- number of grid points in the first direction"
"\n n2 -- number of grid points in the second direction"
"\n n3 -- number of grid points in the third direction"
"\n maxzeros -- max number of zeroes in a front"
"\n maxsize -- max number of internal nodes in a front"
"\n seed -- random number seed"
"\n type -- type of entries"
"\n 1 --> real"
"\n 2 --> complex"
"\n symmetryflag -- symmetry flag"
"\n 0 --> symmetric "
"\n 1 --> hermitian"
"\n 2 --> nonsymmetric"
"\n sparsityflag -- sparsity flag"
"\n 0 --> store dense fronts"
"\n 1 --> store sparse fronts, use droptol to drop entries"
"\n pivotingflag -- pivoting flag"
"\n 0 --> do not pivot"
"\n 1 --> enable pivoting"
"\n tau -- upper bound on factor entries"
"\n used only with pivoting"
"\n droptol -- lower bound on factor entries"
"\n used only with sparse fronts"
"\n lockflag -- flag to specify lock status"
"\n 0 --> mutex lock is not allocated or initialized"
"\n 1 --> mutex lock is allocated and it can synchronize"
"\n only threads in this process."
"\n 2 --> mutex lock is allocated and it can synchronize"
"\n only threads in this and other processes."
"\n nrhs -- # of right hand sides"
"\n", argv[0]) ;
return(-1) ;
}
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]) ;
seed = atoi(argv[8]) ;
type = atoi(argv[9]) ;
symmetryflag = atoi(argv[10]) ;
sparsityflag = atoi(argv[11]) ;
pivotingflag = atoi(argv[12]) ;
tau = atof(argv[13]) ;
droptol = atof(argv[14]) ;
lockflag = atoi(argv[15]) ;
nrhs = atoi(argv[16]) ;
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 seed -- %d"
"\n type -- %d"
"\n symmetryflag -- %d"
"\n sparsityflag -- %d"
"\n pivotingflag -- %d"
"\n tau -- %e"
"\n droptol -- %e"
"\n lockflag -- %d"
"\n nrhs -- %d"
"\n",
argv[0], msglvl, argv[2], n1, n2, n3, maxzeros, maxsize,
seed, type, symmetryflag, sparsityflag, pivotingflag,
tau, droptol, lockflag, nrhs) ;
fflush(msgFile) ;
neqns = n1 * n2 * n3 ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
/*
Drand_setUniform(&drand, 0.0, 1.0) ;
*/
Drand_setNormal(&drand, 0.0, 1.0) ;
/*
--------------------------
generate the linear system
--------------------------
*/
mkNDlinsys(n1, n2, n3, maxzeros, maxsize, type,
symmetryflag, nrhs, seed, msglvl, msgFile,
&frontETree, &symbfacIVL, &mtxA, &mtxX, &mtxB) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n mtxA") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fprintf(msgFile, "\n mtxX") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fprintf(msgFile, "\n mtxB") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*
fprintf(msgFile, "\n neqns = %d ;", n1*n2*n3) ;
fprintf(msgFile, "\n nrhs = %d ;", nrhs) ;
fprintf(msgFile, "\n A = zeros(neqns, neqns) ;") ;
fprintf(msgFile, "\n X = zeros(neqns, nrhs) ;") ;
fprintf(msgFile, "\n B = zeros(neqns, nrhs) ;") ;
InpMtx_writeForMatlab(mtxA, "A", msgFile) ;
DenseMtx_writeForMatlab(mtxX, "X", msgFile) ;
DenseMtx_writeForMatlab(mtxB, "B", msgFile) ;
{
int *ivec1 = InpMtx_ivec1(mtxA) ;
int *ivec2 = InpMtx_ivec2(mtxA) ;
double *dvec = InpMtx_dvec(mtxA) ;
int ichv, ii, col, offset, row, nent = InpMtx_nent(mtxA) ;
fprintf(msgFile, "\n coordType = %d", mtxA->coordType) ;
fprintf(msgFile, "\n start of matrix output file") ;
fprintf(msgFile, "\n %d %d %d", n1*n2*n3, n1*n2*n3, nent) ;
for ( ii = 0 ; ii < nent ; ii++ ) {
ichv = ivec1[ii] ;
if ( (offset = ivec2[ii]) >= 0 ) {
row = ichv, col = row + offset ;
} else {
col = ichv, row = col - offset ;
}
fprintf(msgFile, "\n %d %d %24.16e %24.16e",
row, col, dvec[2*ii], dvec[2*ii+1]) ;
}
}
{
int ii, jj ;
double imag, real ;
fprintf(msgFile, "\n start of rhs output file") ;
fprintf(msgFile, "\n %d %d", n1*n2*n3, nrhs) ;
for ( ii = 0 ; ii < n1*n2*n3 ; ii++ ) {
fprintf(msgFile, "\n %d ", ii) ;
for ( jj = 0 ; jj < nrhs ; jj++ ) {
DenseMtx_complexEntry(mtxB, ii, jj, &real, &imag) ;
fprintf(msgFile, " %24.16e %24.16e", real, imag) ;
}
}
}
*/
/*
------------------------------
initialize the FrontMtx object
------------------------------
*/
MARKTIME(t1) ;
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, lockflag, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL,
type, symmetryflag, sparsityflag, pivotingflag,
lockflag, 0, NULL, mtxmanager, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n nendD = %d, nentL = %d, nentU = %d",
frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front matrix initialized") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
/*
-----------------
factor the matrix
-----------------
*/
nzf = ETree_nFactorEntries(frontETree, symmetryflag) ;
factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ;
fprintf(msgFile,
"\n %d factor entries, %.0f factor ops, %8.3f ratio",
nzf, factorops, factorops/nzf) ;
IVzero(6, stats) ;
DVzero(9, cpus) ;
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, lockflag, 1) ;
MARKTIME(t1) ;
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol,
chvmanager, &error, cpus,
stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops",
t2 - t1, 1.e-6*factorops/(t2-t1)) ;
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n factorization did not complete") ;
for ( chv = rootchv ; chv != NULL ; chv = chv->next ) {
fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d",
chv->id, chv->nD, chv->nL, chv->nU) ;
}
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n error encountered at front %d\n", error) ;
exit(-1) ;
}
fprintf(msgFile,
"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns",
stats[0], stats[1], stats[2]) ;
if ( frontmtx->rowadjIVL != NULL ) {
fprintf(msgFile,
"\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ;
}
if ( frontmtx->coladjIVL != NULL ) {
fprintf(msgFile,
", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
fprintf(msgFile,
"\n %d fronts, %d entries in upperblockIVL",
frontmtx->nfront, frontmtx->upperblockIVL->tsize) ;
}
if ( frontmtx->lowerblockIVL != NULL ) {
fprintf(msgFile,
", %d entries in lowerblockIVL",
frontmtx->lowerblockIVL->tsize) ;
}
fprintf(msgFile,
"\n %d entries in D, %d entries in L, %d entries in U",
stats[3], stats[4], stats[5]) ;
fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ;
cputotal = cpus[8] ;
if ( cputotal > 0.0 ) {
fprintf(msgFile,
"\n initialize fronts %8.3f %6.2f"
"\n load original entries %8.3f %6.2f"
"\n update fronts %8.3f %6.2f"
"\n assemble postponed data %8.3f %6.2f"
"\n factor fronts %8.3f %6.2f"
"\n extract postponed data %8.3f %6.2f"
"\n store factor entries %8.3f %6.2f"
"\n miscellaneous %8.3f %6.2f"
"\n total time %8.3f",
cpus[0], 100.*cpus[0]/cputotal,
cpus[1], 100.*cpus[1]/cputotal,
cpus[2], 100.*cpus[2]/cputotal,
cpus[3], 100.*cpus[3]/cputotal,
cpus[4], 100.*cpus[4]/cputotal,
cpus[5], 100.*cpus[5]/cputotal,
cpus[6], 100.*cpus[6]/cputotal,
cpus[7], 100.*cpus[7]/cputotal, cputotal) ;
}
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
ChvManager_writeForHumanEye(chvmanager, msgFile) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n %% MATLAB file: front factor matrix") ;
FrontMtx_writeForMatlab(frontmtx, "L", "D", "U", msgFile) ;
}
/*
------------------------------
post-process the factor matrix
------------------------------
*/
MARKTIME(t1) ;
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
fprintf(msgFile, "\n\n after post-processing") ;
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
code to test out the IO methods.
write the matrix to a file, free it,
then read it back in.
note: formatted files do not have much accuracy.
*/
/*
FrontMtx_writeToFile(frontmtx, "temp.frontmtxb") ;
FrontMtx_free(frontmtx) ;
frontmtx = FrontMtx_new() ;
FrontMtx_readFromFile(frontmtx, "temp.frontmtxb") ;
frontmtx->manager = mtxmanager ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
*/
/*
----------------
solve the system
----------------
*/
neqns = mtxB->nrow ;
nrhs = mtxB->ncol ;
mtxZ = DenseMtx_new() ;
DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxZ) ;
if ( type == SPOOLES_REAL ) {
nops = frontmtx->nentD + 2*frontmtx->nentU ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
nops += 2*frontmtx->nentL ;
} else {
nops += 2*frontmtx->nentU ;
}
} else if ( type == SPOOLES_COMPLEX ) {
nops = 8*frontmtx->nentD + 8*frontmtx->nentU ;
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
nops += 8*frontmtx->nentL ;
} else {
nops += 8*frontmtx->nentU ;
}
}
nops *= nrhs ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rhs") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(stdout) ;
}
DVzero(6, cpus) ;
MARKTIME(t1) ;
FrontMtx_solve(frontmtx, mtxZ, mtxB, mtxmanager,
cpus, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : solve the system, %.3f mflops",
t2 - t1, 1.e-6*nops/(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) ;
}
/*
fprintf(msgFile, "\n Z = zeros(neqns, nrhs) ;") ;
DenseMtx_writeForMatlab(mtxZ, "Z", msgFile) ;
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n computed solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
DenseMtx_sub(mtxZ, mtxX) ;
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n error") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
fprintf(msgFile, "\n\n after solve") ;
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
------------------------
free the working storage
------------------------
*/
InpMtx_free(mtxA) ;
DenseMtx_free(mtxX) ;
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxZ) ;
FrontMtx_free(frontmtx) ;
ETree_free(frontETree) ;
IVL_free(symbfacIVL) ;
ChvManager_free(chvmanager) ;
SubMtxManager_free(mtxmanager) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
----------------------------------------------------
read in a InpMtx object and create the Graph object
created -- 97feb14, cca
----------------------------------------------------
*/
{
InpMtx *inpmtx ;
FILE *msgFile ;
Graph *graph ;
int count, msglvl, nvtx, rc ;
IVL *adjIVL ;
if ( argc != 5 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile inFile outFile"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n inFile -- input file, must be *.inpmtxf or *.inpmtxb"
"\n outFile -- output file, must be *.graphf or *.graphb"
"\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) ;
}
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n inFile -- %s"
"\n outFile -- %s"
"\n",
argv[0], msglvl, argv[2], argv[3], argv[4]) ;
fflush(msgFile) ;
/*
--------------------------
read in the InpMtx object
--------------------------
*/
inpmtx = InpMtx_new() ;
if ( strcmp(argv[3], "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
rc = InpMtx_readFromFile(inpmtx, argv[3]) ;
fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)",
rc, inpmtx, argv[3]) ;
if ( rc != 1 ) {
exit(-1) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n after reading InpMtx object from file %s",
argv[3]) ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
InpMtx_changeStorageMode(inpmtx, 3) ;
nvtx = 1 + IV_max(&inpmtx->ivec1IV) ;
count = 1 + IV_max(&inpmtx->ivec2IV) ;
if ( nvtx < count ) {
nvtx = count ;
}
/*
------------------------------------
create the full adjacency IVL object
------------------------------------
*/
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
/*
---------------------
fill the Graph object
---------------------
*/
graph = Graph_new() ;
Graph_init2(graph, 0, nvtx, 0, adjIVL->tsize, nvtx, adjIVL->tsize,
adjIVL, NULL, NULL) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n Graph object") ;
Graph_writeForHumanEye(graph, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------------
check that the graph is symmetric
---------------------------------
*/
if ( (rc = Graph_isSymmetric(graph)) == 1 ) {
fprintf(msgFile, "\n\n graph is symmetric\n") ;
} else {
fprintf(msgFile, "\n\n graph is not symmetric\n") ;
}
/*
---------------------------
write out the Graph object
---------------------------
*/
if ( strcmp(argv[4], "none") != 0 ) {
rc = Graph_writeToFile(graph, argv[4]) ;
fprintf(msgFile,
"\n return value %d from Graph_writeToFile(%p,%s)",
rc, graph, argv[4]) ;
}
/*
------------------------
free the working storage
------------------------
*/
Graph_free(graph) ;
InpMtx_free(inpmtx) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
NM_Status
SpoolesSolver :: solve(SparseMtrx *A, FloatArray *b, FloatArray *x)
{
int errorValue, mtxType, symmetryflag;
int seed = 30145, pivotingflag = 0;
int *oldToNew, *newToOld;
double droptol = 0.0, tau = 1.e300;
double cpus [ 10 ];
int stats [ 20 ];
ChvManager *chvmanager;
Chv *rootchv;
InpMtx *mtxA;
DenseMtx *mtxY, *mtxX;
// first check whether Lhs is defined
if ( !A ) {
_error("solveYourselfAt: unknown Lhs");
}
// and whether Rhs
if ( !b ) {
_error("solveYourselfAt: unknown Rhs");
}
// and whether previous Solution exist
if ( !x ) {
_error("solveYourselfAt: unknown solution array");
}
if ( x->giveSize() != b->giveSize() ) {
_error("solveYourselfAt: size mismatch");
}
Timer timer;
timer.startTimer();
if ( A->giveType() != SMT_SpoolesMtrx ) {
_error("solveYourselfAt: SpoolesSparseMtrx Expected");
}
mtxA = ( ( SpoolesSparseMtrx * ) A )->giveInpMtrx();
mtxType = ( ( SpoolesSparseMtrx * ) A )->giveValueType();
symmetryflag = ( ( SpoolesSparseMtrx * ) A )->giveSymmetryFlag();
int i;
int neqns = A->giveNumberOfRows();
int nrhs = 1;
/* convert right-hand side to DenseMtx */
mtxY = DenseMtx_new();
DenseMtx_init(mtxY, mtxType, 0, 0, neqns, nrhs, 1, neqns);
DenseMtx_zero(mtxY);
for ( i = 0; i < neqns; i++ ) {
DenseMtx_setRealEntry( mtxY, i, 0, b->at(i + 1) );
}
if ( ( Lhs != A ) || ( this->lhsVersion != A->giveVersion() ) ) {
//
// lhs has been changed -> new factorization
//
Lhs = A;
this->lhsVersion = A->giveVersion();
if ( frontmtx ) {
FrontMtx_free(frontmtx);
}
if ( newToOldIV ) {
IV_free(newToOldIV);
}
if ( oldToNewIV ) {
IV_free(oldToNewIV);
}
if ( frontETree ) {
ETree_free(frontETree);
}
if ( symbfacIVL ) {
IVL_free(symbfacIVL);
}
if ( mtxmanager ) {
SubMtxManager_free(mtxmanager);
}
if ( graph ) {
Graph_free(graph);
}
/*
* -------------------------------------------------
* STEP 3 : find a low-fill ordering
* (1) create the Graph object
* (2) order the graph using multiple minimum degree
* -------------------------------------------------
*/
int nedges;
graph = Graph_new();
adjIVL = InpMtx_fullAdjacency(mtxA);
nedges = IVL_tsize(adjIVL);
Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL,
NULL, NULL);
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n graph of the input matrix");
Graph_writeForHumanEye(graph, msgFile);
fflush(msgFile);
}
frontETree = orderViaMMD(graph, seed, msglvl, msgFile);
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n front tree from ordering");
ETree_writeForHumanEye(frontETree, msgFile);
fflush(msgFile);
}
/*
* ----------------------------------------------------
* STEP 4: get the permutation, permute the front tree,
* permute the matrix and right hand side, and
* get the symbolic factorization
* ----------------------------------------------------
*/
oldToNewIV = ETree_oldToNewVtxPerm(frontETree);
oldToNew = IV_entries(oldToNewIV);
newToOldIV = ETree_newToOldVtxPerm(frontETree);
newToOld = IV_entries(newToOldIV);
ETree_permuteVertices(frontETree, oldToNewIV);
InpMtx_permute(mtxA, oldToNew, oldToNew);
if ( symmetryflag == SPOOLES_SYMMETRIC ||
symmetryflag == SPOOLES_HERMITIAN ) {
InpMtx_mapToUpperTriangle(mtxA);
}
InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS);
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS);
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA);
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n old-to-new permutation vector");
IV_writeForHumanEye(oldToNewIV, msgFile);
fprintf(msgFile, "\n\n new-to-old permutation vector");
IV_writeForHumanEye(newToOldIV, msgFile);
fprintf(msgFile, "\n\n front tree after permutation");
ETree_writeForHumanEye(frontETree, msgFile);
fprintf(msgFile, "\n\n input matrix after permutation");
InpMtx_writeForHumanEye(mtxA, msgFile);
fprintf(msgFile, "\n\n symbolic factorization");
IVL_writeForHumanEye(symbfacIVL, msgFile);
fflush(msgFile);
}
Tree_writeToFile(frontETree->tree, (char*)"haggar.treef");
/*--------------------------------------------------------------------*/
/*
* ------------------------------------------
* STEP 5: initialize the front matrix object
* ------------------------------------------
*/
frontmtx = FrontMtx_new();
mtxmanager = SubMtxManager_new();
SubMtxManager_init(mtxmanager, NO_LOCK, 0);
FrontMtx_init(frontmtx, frontETree, symbfacIVL, mtxType, symmetryflag,
FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, 0, NULL,
mtxmanager, msglvl, msgFile);
/*--------------------------------------------------------------------*/
/*
* -----------------------------------------
* STEP 6: compute the numeric factorization
* -----------------------------------------
*/
chvmanager = ChvManager_new();
ChvManager_init(chvmanager, NO_LOCK, 1);
DVfill(10, cpus, 0.0);
IVfill(20, stats, 0);
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol,
chvmanager, & errorValue, cpus, stats, msglvl, msgFile);
ChvManager_free(chvmanager);
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n factor matrix");
FrontMtx_writeForHumanEye(frontmtx, msgFile);
fflush(msgFile);
}
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n matrix found to be singular\n");
exit(-1);
}
if ( errorValue >= 0 ) {
fprintf(msgFile, "\n\n error encountered at front %d", errorValue);
exit(-1);
}
/*--------------------------------------------------------------------*/
/*
* --------------------------------------
* STEP 7: post-process the factorization
* --------------------------------------
*/
FrontMtx_postProcess(frontmtx, msglvl, msgFile);
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n factor matrix after post-processing");
FrontMtx_writeForHumanEye(frontmtx, msgFile);
fflush(msgFile);
}
/*--------------------------------------------------------------------*/
}
/*
* ----------------------------------------------------
* STEP 4: permute the right hand side
* ----------------------------------------------------
*/
DenseMtx_permuteRows(mtxY, oldToNewIV);
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n right hand side matrix after permutation");
DenseMtx_writeForHumanEye(mtxY, msgFile);
}
/*
* -------------------------------
* STEP 8: solve the linear system
* -------------------------------
*/
mtxX = DenseMtx_new();
DenseMtx_init(mtxX, mtxType, 0, 0, neqns, nrhs, 1, neqns);
DenseMtx_zero(mtxX);
FrontMtx_solve(frontmtx, mtxX, mtxY, mtxmanager,
cpus, msglvl, msgFile);
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n solution matrix in new ordering");
DenseMtx_writeForHumanEye(mtxX, msgFile);
fflush(msgFile);
}
/*--------------------------------------------------------------------*/
/*
* -------------------------------------------------------
* STEP 9: permute the solution into the original ordering
* -------------------------------------------------------
*/
DenseMtx_permuteRows(mtxX, newToOldIV);
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n solution matrix in original ordering");
DenseMtx_writeForHumanEye(mtxX, msgFile);
fflush(msgFile);
}
// DenseMtx_writeForMatlab(mtxX, "x", msgFile) ;
/*--------------------------------------------------------------------*/
/* fetch data to oofem vectors */
double *xptr = x->givePointer();
for ( i = 0; i < neqns; i++ ) {
DenseMtx_realEntry(mtxX, i, 0, xptr + i);
// printf ("x(%d) = %e\n", i+1, *(xptr+i));
}
// DenseMtx_copyRowIntoVector(mtxX, 0, x->givePointer());
timer.stopTimer();
OOFEM_LOG_DEBUG( "SpoolesSolver info: user time consumed by solution: %.2fs\n", timer.getUtime() );
/*
* -----------
* free memory
* -----------
*/
DenseMtx_free(mtxX);
DenseMtx_free(mtxY);
/*--------------------------------------------------------------------*/
return ( 1 );
}
/*--------------------------------------------------------------------*/
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) ; }
/*
---------------------------------------------------------------------
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; }
void main ( int argc, char *argv[] )
/*
----------------------------------------------------------
read in Harwell-Boeing matrices, use serial factor, solve,
and multiply routines based on spooles, invoke eigensolver
created -- 98mar31 jcp
modified -- 98dec18, cca
----------------------------------------------------------
*/
{
Bridge bridge ;
char *inFileName_A, *inFileName_B, *outFileName,
*parmFileName, *type ;
char buffer[20], pbtype[4], which[4] ;
double lftend, rhtend, center, shfscl, t1, t2 ;
double c__1 = 1.0, c__4 = 4.0, tolact = 2.309970868130169e-11 ;
double eigval[1000], sigma[2];
double *evec;
int error, fstevl, lfinit, lstevl, mxbksz, msglvl, ncol, ndiscd,
neig, neigvl, nfound, nnonzeros, nrhs, nrow, prbtyp, rc,
retc, rfinit, seed, warnng ;
int c__5 = 5, output = 6 ;
int *lanczos_wksp;
InpMtx *inpmtxA, *inpmtxB ;
FILE *msgFile, *parmFile;
/*--------------------------------------------------------------------*/
if ( argc != 7 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile parmFile seed inFileA inFileB"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n parmFile -- input parameters file"
"\n seed -- random number seed, used for ordering"
"\n inFileA -- stiffness matrix in Harwell-Boeing format"
"\n inFileB -- mass matrix in Harwell-Boeing format"
"\n used for prbtyp = 1 or 2"
"\n", argv[0]) ;
return ;
}
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]) ;
exit(-1) ;
}
parmFileName = argv[3] ;
seed = atoi(argv[4]) ;
inFileName_A = argv[5] ;
inFileName_B = argv[6] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n parmFile -- %s"
"\n seed -- %d"
"\n stiffness file -- %s"
"\n mass file -- %s"
"\n",
argv[0], msglvl, argv[2], parmFileName, seed,
inFileName_A, inFileName_B) ;
fflush(msgFile) ;
/*
---------------------------------------------
read in the Harwell-Boeing matrix information
---------------------------------------------
*/
if ( strcmp(inFileName_A, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
readHB_info (inFileName_A, &nrow, &ncol, &nnonzeros, &type, &nrhs) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in header information for A",
t2 - t1) ;
/*--------------------------------------------------------------------*/
/*
---------------------------------------------------------------
read in eigenvalue problem data
neigvl -- # of desired eigenvalues
which -- which eigenvalues to compute
'l' or 'L' lowest (smallest magnitude)
'h' or 'H' highest (largest magnitude)
'n' or 'N' nearest to central value
'c' or 'C' nearest to central value
'a' or 'A' all eigenvalues in interval
pbtype -- type of problem
'v' or 'V' generalized symmetric problem (K,M)
with M positive semidefinite (vibration problem)
'b' or 'B' generalized symmetric problem (K,K_s)
with K positive semidefinite
with K_s posibly indefinite (buckling problem)
'o' or 'O' ordinary symmetric eigenproblem
lfinit -- if true, lftend is restriction on lower bound of
eigenvalues. if false, no restriction on lower bound
lftend -- left endpoint of interval
rfinit -- if true, rhtend is restriction on upper bound of
eigenvalues. if false, no restriction on upper bound
rhtend -- right endpoint of interval
center -- center of interval
mxbksz -- upper bound on block size for Lanczos recurrence
shfscl -- shift scaling parameter, an estimate on the magnitude
of the smallest nonzero eigenvalues
---------------------------------------------------------------
*/
MARKTIME(t1) ;
parmFile = fopen(parmFileName, "r");
fscanf(parmFile, "%d %s %s %d %le %d %le %le %d %le",
&neigvl, which, pbtype, &lfinit, &lftend,
&rfinit, &rhtend, ¢er, &mxbksz, &shfscl) ;
fclose(parmFile);
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in eigenvalue problem data",
t2 - t1) ;
/*
----------------------------------------
check and set the problem type parameter
----------------------------------------
*/
switch ( pbtype[1] ) {
case 'v' : case 'V' : prbtyp = 1 ; break ;
case 'b' : case 'B' : prbtyp = 2 ; break ;
case 'o' : case 'O' : prbtyp = 3 ; break ;
default :
fprintf(stderr, "\n invalid problem type %s", pbtype) ;
exit(-1) ;
}
/*
----------------------------
Initialize Lanczos workspace
----------------------------
*/
MARKTIME(t1) ;
lanczos_init_ ( &lanczos_wksp ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize lanczos workspace",
t2 - t1) ;
/*
----------------------------------
initialize communication structure
----------------------------------
*/
MARKTIME(t1) ;
lanczos_set_parm( &lanczos_wksp, "order-of-problem", &nrow, &retc );
lanczos_set_parm( &lanczos_wksp, "accuracy-tolerance", &tolact, &retc );
lanczos_set_parm( &lanczos_wksp, "max-block-size", &mxbksz, &retc );
lanczos_set_parm( &lanczos_wksp, "shift-scale", &shfscl, &retc );
lanczos_set_parm( &lanczos_wksp, "message_level", &msglvl, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : init lanczos communication structure",
t2 - t1) ;
/*--------------------------------------------------------------------*/
/*
---------------------------------------------
create the InpMtx objects for matrix A and B
---------------------------------------------
*/
if ( strcmp(inFileName_A, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
inpmtxA = InpMtx_new() ;
InpMtx_readFromHBfile ( inpmtxA, inFileName_A ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in A", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n InpMtx A object after loading") ;
InpMtx_writeForHumanEye(inpmtxA, msgFile) ;
fflush(msgFile) ;
}
MARKTIME(t1) ;
lanczos_set_parm( &lanczos_wksp, "matrix-type", &c__1, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set A's parameters", t2 - t1) ;
if ( prbtyp != 3 ) {
if ( strcmp(inFileName_B, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
inpmtxB = InpMtx_new() ;
InpMtx_readFromHBfile ( inpmtxB, inFileName_B ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in B", t2 - t1) ;
} else {
MARKTIME(t1) ;
inpmtxB = NULL ;
lanczos_set_parm( &lanczos_wksp, "matrix-type", &c__4, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set B's parameters", t2 - t1) ;
}
if ( msglvl > 2 && prbtyp != 3 ) {
fprintf(msgFile, "\n\n InpMtx B object after loading") ;
InpMtx_writeForHumanEye(inpmtxB, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------
set up the solver environment
-----------------------------
*/
MARKTIME(t1) ;
rc = Setup((void *) &bridge, &prbtyp, &nrow, &mxbksz, inpmtxA, inpmtxB,
&seed, &msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set up solver environment", t2 - t1) ;
if ( rc != 1 ) {
fprintf(stderr, "\n fatal error %d from Setup()", rc) ;
exit(-1) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------
invoke eigensolver
nfound -- # of eigenvalues found and kept
ndisc -- # of additional eigenvalues discarded
-----------------------------------------------
*/
MARKTIME(t1) ;
lanczos_run(&neigvl, &which[1] , &pbtype[1], &lfinit, &lftend,
&rfinit, &rhtend, ¢er, &lanczos_wksp, &bridge, &nfound,
&ndiscd, &warnng, &error, Factor, MatMul, Solve ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : time for lanczos run", t2 - t1) ;
/*
-------------------------
get eigenvalues and print
-------------------------
*/
MARKTIME(t1) ;
neig = nfound + ndiscd ;
lstevl = nfound ;
lanczos_eigenvalues (&lanczos_wksp, eigval, &neig, &retc);
fstevl = 1 ;
if ( nfound == 0 ) fstevl = -1 ;
if ( ndiscd > 0 ) lstevl = -ndiscd ;
hdslp5_ ("computed eigenvalues returned by hdserl",
&neig, eigval, &output, 39L ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get and print eigenvalues ", t2 - t1) ;
/*
-------------------------
get eigenvectors and print
-------------------------
*/
/*
MARKTIME(t1) ;
neig = min ( 50, nrow );
Lncz_ALLOCATE(evec, double, nrow, retc);
for ( i = 1 ; i <= nfound ; i++ ) {
lanczos_eigenvector ( &lanczos_wksp, &i, &i, newToOld,
evec, &nrow, &retc ) ;
hdslp5_ ( "computed eigenvector returned by hdserc",
&neig, evec, &output, 39L ) ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get and print eigenvectors ", t2 - t1) ;
*/
/*
------------------------
free the working storage
------------------------
*/
MARKTIME(t1) ;
lanczos_free( &lanczos_wksp ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : free lanczos workspace ", t2 - t1) ;
MARKTIME(t1) ;
rc = Cleanup(&bridge) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : free solver workspace ", t2 - t1) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error return %d from Cleanup()", rc) ;
exit(-1) ;
}
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return ; }
/*
------------------------------------------------------------------
purpose -- to initialize the semi-implicit matrix using as input a
FrontMtx and a map from fronts to domains (map[J] != 0)
or the schur complement (map[J] = 0)
return value --
1 -- normal return
-1 -- semimtx is NULL
-2 -- frontmtx is NULL
-3 -- inpmtx is NULL
-4 -- frontmapIV is NULL
-5 -- frontmapIV is invalid
-6 -- unable to create domains' front matrix
-7 -- unable to create schur complement front matrix
created -- 98oct17, cca
------------------------------------------------------------------
*/
int
SemiImplMtx_initFromFrontMtx (
SemiImplMtx *semimtx,
FrontMtx *frontmtx,
InpMtx *inpmtx,
IV *frontmapIV,
int msglvl,
FILE *msgFile
) {
FrontMtx *domMtx, *schurMtx ;
InpMtx *A12, *A21 ;
int ii, J, ncol, nfront, nrow, rc, size ;
int *cols, *frontmap, *rows ;
IV *domColsIV, *domidsIV, *domRowsIV,
*schurColsIV, *schuridsIV, *schurRowsIV ;
/*
--------------
check the data
--------------
*/
if ( semimtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n semimtx is NULL\n") ;
return(-1) ;
}
if ( frontmtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmtx is NULL\n") ;
return(-2) ;
}
if ( inpmtx == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n inpmtx is NULL\n") ;
return(-3) ;
}
if ( frontmapIV == NULL ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmapIV is NULL\n") ;
return(-4) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
IV_sizeAndEntries(frontmapIV, &size, &frontmap) ;
if ( nfront != size ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n nfront %d, size of front map %d\n", nfront, size) ;
return(-5) ;
}
domidsIV = IV_new() ;
schuridsIV = IV_new() ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( frontmap[J] == 0 ) {
IV_push(schuridsIV, J) ;
} else if ( frontmap[J] > 0 ) {
IV_push(domidsIV, J) ;
} else {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n frontmap[%d] = %d, invalid\n", J, frontmap[J]) ;
IV_free(domidsIV) ;
IV_free(schuridsIV) ;
return(-5) ;
}
}
/*
-----------------------------------------------------------
clear the data for the semi-implicit matrix and set scalars
-----------------------------------------------------------
*/
SemiImplMtx_clearData(semimtx) ;
semimtx->neqns = frontmtx->neqns ;
semimtx->type = frontmtx->type ;
semimtx->symmetryflag = frontmtx->symmetryflag ;
/*
----------------------------------------------
get the front matrix that contains the domains
----------------------------------------------
*/
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n working on domain front matrix") ;
fflush(msgFile) ;
}
domMtx = semimtx->domainMtx = FrontMtx_new() ;
domRowsIV = semimtx->domRowsIV = IV_new() ;
domColsIV = semimtx->domColsIV = IV_new() ;
rc = FrontMtx_initFromSubmatrix(domMtx, frontmtx, domidsIV,
domRowsIV, domColsIV, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to initialize the domains' front matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
semimtx->ndomeqns = IV_size(domRowsIV) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n submatrix for domains") ;
FrontMtx_writeForHumanEye(domMtx, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
FrontMtx_writeForMatlab(domMtx, "L11", "D11", "U11", msgFile) ;
IV_writeForMatlab(domRowsIV, "domrows", msgFile) ;
IV_writeForMatlab(domColsIV, "domcols", msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------------
get the front matrix that contains the schur complement
-------------------------------------------------------
*/
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n working on domain front matrix") ;
fflush(msgFile) ;
}
schurMtx = semimtx->schurMtx = FrontMtx_new() ;
schurRowsIV = semimtx->schurRowsIV = IV_new() ;
schurColsIV = semimtx->schurColsIV = IV_new() ;
rc = FrontMtx_initFromSubmatrix(schurMtx, frontmtx, schuridsIV,
schurRowsIV, schurColsIV, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to initialize the schur complement front matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
semimtx->nschureqns = IV_size(schurRowsIV) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n submatrix for schur complement") ;
FrontMtx_writeForHumanEye(schurMtx, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
FrontMtx_writeForMatlab(schurMtx, "L22", "D22", "U22", msgFile) ;
IV_writeForMatlab(schurRowsIV, "schurrows", msgFile) ;
IV_writeForMatlab(schurColsIV, "schurcols", msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------
get the A12 InpMtx object
-------------------------
*/
A12 = semimtx->A12 = InpMtx_new() ;
rc = InpMtx_initFromSubmatrix(A12, inpmtx, domRowsIV, schurColsIV,
semimtx->symmetryflag, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to create A21 matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
InpMtx_changeCoordType(A12, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(A12, INPMTX_BY_VECTORS) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n---------------------------------------- ") ;
fprintf(msgFile, "\n\n domRowsIV ") ;
IV_writeForHumanEye(domRowsIV, msgFile) ;
fprintf(msgFile, "\n\n schurColsIV ") ;
IV_writeForHumanEye(schurColsIV, msgFile) ;
fprintf(msgFile, "\n\n A12 matrix") ;
InpMtx_writeForHumanEye(A12, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n A12 = zeros(%d,%d) ;",
IV_size(domRowsIV), IV_size(schurColsIV)) ;
InpMtx_writeForMatlab(A12, "A12", msgFile) ;
fflush(msgFile) ;
}
if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
/*
-------------------------
get the A21 InpMtx object
-------------------------
*/
A21 = semimtx->A21 = InpMtx_new() ;
rc = InpMtx_initFromSubmatrix(A21, inpmtx, schurRowsIV, domColsIV,
semimtx->symmetryflag, msglvl, msgFile) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error in SemiImplMtx_initFromFrontMtx()"
"\n unable to create A21 matrix"
"\n error return = %d\n", rc) ;
return(-6) ;
}
InpMtx_changeCoordType(A21, INPMTX_BY_COLUMNS) ;
InpMtx_changeStorageMode(A21, INPMTX_BY_VECTORS) ;
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n--------------------------------------- ") ;
fprintf(msgFile, "\n\n schurRowsIV ") ;
IV_writeForHumanEye(schurRowsIV, msgFile) ;
fprintf(msgFile, "\n\n domColsIV ") ;
IV_writeForHumanEye(domColsIV, msgFile) ;
fprintf(msgFile, "\n\n A21 matrix") ;
InpMtx_writeForHumanEye(A21, msgFile) ;
fflush(msgFile) ;
}
if ( msglvl > 4 ) {
fprintf(msgFile, "\n\n A21 = zeros(%d,%d) ;",
IV_size(schurRowsIV), IV_size(domColsIV)) ;
InpMtx_writeForMatlab(A21, "A21", msgFile) ;
fflush(msgFile) ;
}
}
/*
------------------------
free the working storage
------------------------
*/
IV_free(domidsIV) ;
IV_free(schuridsIV) ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-----------------------------------------------------
test the factor method for a grid matrix
(0) read in matrix from source file
(1) conver data matrix to InpMtx object if necessary
(2) create Graph and ETree object if necessary
(3) read in/create an ETree object
(4) create a solution matrix object
(5) multiply the solution with the matrix
to get a right hand side matrix object
(6) factor the matrix
(7) solve the system
created -- 98dec30, jwu
-----------------------------------------------------
*/
{
char etreeFileName[80], mtxFileName[80], *cpt, rhsFileName[80],
srcFileName[80], ctemp[81], msgFileName[80], slnFileName[80] ;
Chv *chv, *rootchv ;
ChvManager *chvmanager ;
DenseMtx *mtxB, *mtxQ, *mtxX, *mtxZ ;
double one[2] = { 1.0, 0.0 } ;
FrontMtx *frontmtx ;
InpMtx *mtxA ;
SubMtxManager *mtxmanager ;
double cputotal, droptol, conv_tol, factorops ;
double cpus[9] ;
Drand drand ;
double nops, tau, t1, t2 ;
ETree *frontETree ;
Graph *graph ;
FILE *msgFile, *inFile ;
int error, loc, msglvl, neqns, nzf, iformat,
pivotingflag, rc, seed, sparsityflag, symmetryflag,
method[METHODS], type, nrhs, etreeflag ;
int stats[6] ;
int nnzA, Ik, itermax, zversion, iterout ;
IV *newToOldIV, *oldToNewIV ;
IVL *symbfacIVL ;
int i, j, k, m, n, imethod, maxdomainsize, maxzeros, maxsize;
int nouter,ninner ;
if ( argc != 2 ) {
fprintf(stdout,
"\n\n usage : %s inFile"
"\n inFile -- input filename"
"\n", argv[0]) ;
return(-1) ;
}
/* read input file */
inFile = fopen(argv[1], "r");
if (inFile == (FILE *)NULL) {
fprintf(stderr, "\n fatal error in %s: unable to open file %s\n",
argv[0], argv[1]) ;
return(-1) ;
}
for (i=0; i<METHODS; i++) method[i]=-1;
imethod=0;
k=0;
while (1) {
fgets(ctemp, 80, inFile);
if (ctemp[0] != '*') {
/*printf("l=%2d:%s\n", strlen(ctemp),ctemp);*/
if (strlen(ctemp)==80) {
fprintf(stderr, "\n fatal error in %s: input line contains more than "
"80 characters.\n",argv[0]);
exit(-1);
}
if (k==0) {
sscanf(ctemp, "%d", &iformat);
if (iformat < 0 || iformat > 2) {
fprintf(stderr, "\n fatal error in %s: "
"invalid source matrix format\n",argv[0]) ;
return(-1) ;
}
}
else if (k==1)
sscanf(ctemp, "%s", srcFileName);
else if (k==2)
sscanf(ctemp, "%s", mtxFileName);
else if (k==3) {
sscanf(ctemp, "%d", &etreeflag);
if (etreeflag < 0 || etreeflag > 4) {
fprintf(stderr, "\n fatal error in %s: "
"invalid etree file status\n",argv[0]) ;
return(-1) ;
}
}
else if (k==4)
sscanf(ctemp, "%s", etreeFileName);
else if (k==5)
sscanf(ctemp, "%s", rhsFileName);
else if (k==6)
sscanf(ctemp, "%s", slnFileName);
else if (k==7){
sscanf(ctemp, "%s", msgFileName);
if ( strcmp(msgFileName, "stdout") == 0 ) {
msgFile = stdout ;
}
else if ( (msgFile = fopen(msgFileName, "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n", argv[0], ctemp) ;
return(-1) ;
}
}
else if (k==8)
sscanf(ctemp, "%d %d %d %d %d %d",
&msglvl, &seed, &nrhs, &Ik, &itermax, &iterout);
else if (k==9)
sscanf(ctemp, "%d %d %d", &symmetryflag, &sparsityflag, &pivotingflag);
else if (k==10)
sscanf(ctemp, "%lf %lf %lf", &tau, &droptol, &conv_tol);
else if (k==11) {
/*
for (j=0; j<strlen(ctemp); j++) {
printf("j=%2d:%s",j,ctemp+j);
if (ctemp[j] == ' ' && ctemp[j+1] != ' ') {
sscanf(ctemp+j, "%d", method+imethod);
printf("method[%d]=%d\n",imethod,method[imethod]);
if (method[imethod] < 0) break;
imethod++;
}
}
*/
imethod = sscanf(ctemp,"%d %d %d %d %d %d %d %d %d %d",
method, method+1, method+2, method+3, method+4,
method+5, method+6, method+7, method+8, method+9);
/*printf("imethod=%d\n",imethod);*/
for (j=0; j<imethod; j++) {
/*printf("method[%d]=%d\n",j,method[j]);*/
if (method[j]<0) {
imethod=j;
break;
}
}
if (imethod == 0) {
fprintf(msgFile,"No method assigned in input file\n");
return(-1);
}
}
k++;
}
if (k==12) break;
}
fclose(inFile);
/* reset nrhs to 1 */
if (nrhs > 1) {
fprintf(msgFile,"*** Multiple right-hand-side vectors is not allowed yet.\n");
fprintf(msgFile,"*** nrhs is reset to 1.\n");
nrhs =1;
}
fprintf(msgFile,
"\n %s "
"\n srcFileName -- %s"
"\n mtxFileName -- %s"
"\n etreeFileName -- %s"
"\n rhsFileName -- %s"
"\n msglvl -- %d"
"\n seed -- %d"
"\n symmetryflag -- %d"
"\n sparsityflag -- %d"
"\n pivotingflag -- %d"
"\n tau -- %e"
"\n droptol -- %e"
"\n conv_tol -- %e"
"\n method -- ",
argv[0], srcFileName, mtxFileName, etreeFileName, rhsFileName,
msglvl, seed, symmetryflag, sparsityflag, pivotingflag,
tau, droptol, conv_tol) ;
for (k=0; k<imethod; k++)
fprintf(msgFile, "%d ", method[k]);
fprintf(msgFile, "\n ", method[k]);
fflush(msgFile) ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
/*Drand_setUniform(&drand, 0.0, 1.0) ;*/
Drand_setNormal(&drand, 0.0, 1.0) ;
/*
----------------------------------------------
read in or convert source to the InpMtx object
----------------------------------------------
*/
rc = 1;
if ( strcmp(srcFileName, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(-1) ;
}
mtxA = InpMtx_new() ;
MARKTIME(t1) ;
if (iformat == 0) { /* InpMtx source format */
rc = InpMtx_readFromFile(mtxA, srcFileName) ;
strcpy(mtxFileName, srcFileName);
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromFile(%p,%s)",
rc, mtxA, srcFileName) ;
}
else if (iformat == 1) { /* HBF source format */
rc = InpMtx_readFromHBfile(mtxA, srcFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromHBfile(%p,%s)",
rc, mtxA, srcFileName) ;
}
else { /* AIJ2 source format */
rc = InpMtx_readFromAIJ2file(mtxA, srcFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_readFromAIJ2file(%p,%s)",
rc, mtxA, srcFileName) ;
}
MARKTIME(t2) ;
if (iformat>0 && strcmp(mtxFileName, "none") != 0 ) {
rc = InpMtx_writeToFile(mtxA, mtxFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from InpMtx_writeToFile(%p,%s)",
rc, mtxA, mtxFileName) ;
}
fprintf(msgFile, "\n CPU %8.3f : read in (+ convert to) mtxA from file %s",
t2 - t1, mtxFileName) ;
if (rc != 1) {
goto end_read;
}
type = mtxA->inputMode ;
neqns = 1 + IVmax(mtxA->nent, InpMtx_ivec1(mtxA), &loc) ;
if ( INPMTX_IS_BY_ROWS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is rows") ;
} else if ( INPMTX_IS_BY_COLUMNS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is columns") ;
} else if ( INPMTX_IS_BY_CHEVRONS(mtxA) ) {
fprintf(msgFile, "\n matrix coordinate type is chevrons") ;
} else {
fprintf(msgFile, "\n\n, error, bad coordinate type") ;
rc=-1;
goto end_read;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is raw data\n") ;
} else if ( INPMTX_IS_SORTED(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is sorted\n") ;
} else if ( INPMTX_IS_BY_VECTORS(mtxA) ) {
fprintf(msgFile, "\n matrix storage mode is by vectors\n") ;
} else {
fprintf(msgFile, "\n\n, error, bad storage mode") ;
rc=-1;
goto end_read;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n after reading InpMtx object from file %s",
mtxFileName) ;
if ( msglvl == 2 ) {
InpMtx_writeStats(mtxA, msgFile) ;
} else {
InpMtx_writeForHumanEye(mtxA, msgFile) ;
}
fflush(msgFile) ;
}
/*
Get the nonzeros in matrix A and print it
*/
nnzA = InpMtx_nent( mtxA );
fprintf(msgFile, "\n\n Input matrix size %d NNZ %d",
neqns, nnzA) ;
/*
--------------------------------------------------------
generate the linear system
1. generate solution matrix and fill with random numbers
2. generate rhs matrix and fill with zeros
3. compute matrix-matrix multiply
--------------------------------------------------------
*/
MARKTIME(t1) ;
mtxX = DenseMtx_new() ;
DenseMtx_init(mtxX, type, 0, -1, neqns, nrhs, 1, neqns) ;
mtxB = DenseMtx_new() ;
if (strcmp(rhsFileName, "none")) {
rc = DenseMtx_readFromFile(mtxB, rhsFileName) ;
if ( rc != 1 )
fprintf(msgFile, "\n return value %d from DenseMtx_readFromFile(%p,%s)",
rc, mtxB, rhsFileName) ;
DenseMtx_zero(mtxX) ;
}
else {
DenseMtx_init(mtxB, type, 1, -1, neqns, nrhs, 1, neqns) ;
DenseMtx_fillRandomEntries(mtxX, &drand) ;
DenseMtx_zero(mtxB) ;
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_mmm(mtxA, mtxB, one, mtxX) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_mmm(mtxA, mtxB, one, mtxX) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_mmm(mtxA, mtxB, one, mtxX) ;
break ;
default :
break ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set up the solution and rhs ",
t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n original mtxX") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fprintf(msgFile, "\n\n original mtxB") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
if (rc != 1) {
InpMtx_free(mtxA);
DenseMtx_free(mtxX);
DenseMtx_free(mtxB);
goto end_init;
}
/*
------------------------
read in/create the ETree object
------------------------
*/
MARKTIME(t1) ;
if (etreeflag == 0) { /* read in ETree from file */
if ( strcmp(etreeFileName, "none") == 0 )
fprintf(msgFile, "\n no file to read from") ;
frontETree = ETree_new() ;
rc = ETree_readFromFile(frontETree, etreeFileName) ;
if (rc!=1)
fprintf(msgFile, "\n return value %d from ETree_readFromFile(%p,%s)",
rc, frontETree, etreeFileName) ;
}
else {
graph = Graph_new() ;
rc = InpMtx_createGraph(mtxA, graph);
if (rc!=1) {
fprintf(msgFile, "\n return value %d from InpMtx_createGraph(%p,%p)",
rc, mtxA, graph) ;
Graph_free(graph);
goto end_tree;
}
if (etreeflag == 1) { /* Via BestOfNDandMS */
maxdomainsize = 500; maxzeros = 1000; maxsize = 64 ;
frontETree = orderViaBestOfNDandMS(graph, maxdomainsize, maxzeros,
maxsize, seed, msglvl, msgFile) ;
}
else if (etreeflag == 2) { /* Via MMD */
frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;
}
else if (etreeflag == 3) { /* Via MS */
maxdomainsize = 500;
frontETree = orderViaMS(graph, maxdomainsize, seed, msglvl, msgFile) ;
}
else if (etreeflag == 4) { /* Via ND */
maxdomainsize = 500;
frontETree = orderViaND(graph, maxdomainsize, seed, msglvl, msgFile) ;
}
Graph_free(graph);
/* optionally write out the ETree object */
if ( strcmp(etreeFileName, "none") != 0 ) {
fprintf(msgFile, "\n\n writing out ETree to file %s",
etreeFileName) ;
ETree_writeToFile(frontETree, etreeFileName) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in/create frontETree from file %s",
t2 - t1, etreeFileName) ;
if ( rc != 1 ) {
ETree_free(frontETree);
goto end_tree;
}
ETree_leftJustify(frontETree) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n after reading ETree object from file %s",
etreeFileName) ;
if ( msglvl == 2 ) {
ETree_writeStats(frontETree, msgFile) ;
} else {
ETree_writeForHumanEye(frontETree, msgFile) ;
}
}
fflush(msgFile) ;
/*
--------------------------------------------------
get the permutations, permute the matrix and the
front tree, and compute the symbolic factorization
--------------------------------------------------
*/
MARKTIME(t1) ;
oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get permutations", t2 - t1) ;
MARKTIME(t1) ;
ETree_permuteVertices(frontETree, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute front tree", t2 - t1) ;
MARKTIME(t1) ;
InpMtx_permute(mtxA, IV_entries(oldToNewIV), IV_entries(oldToNewIV)) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute mtxA", t2 - t1) ;
if ( symmetryflag == SPOOLES_SYMMETRIC
|| symmetryflag == SPOOLES_HERMITIAN ) {
MARKTIME(t1) ;
InpMtx_mapToUpperTriangle(mtxA) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : map to upper triangle", t2 - t1) ;
}
if ( ! INPMTX_IS_BY_CHEVRONS(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : change coordinate type", t2 - t1) ;
}
if ( INPMTX_IS_RAW_DATA(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeStorageMode(mtxA, INPMTX_SORTED) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : sort entries ", t2 - t1) ;
}
if ( INPMTX_IS_SORTED(mtxA) ) {
MARKTIME(t1) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : convert to vectors ", t2 - t1) ;
}
MARKTIME(t1) ;
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : symbolic factorization", t2 - t1) ;
MARKTIME(t1) ;
DenseMtx_permuteRows(mtxB, oldToNewIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute rhs", t2 - t1) ;
/*
------------------------------
initialize the FrontMtx object
------------------------------
*/
MARKTIME(t1) ;
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, NO_LOCK, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL,
type, symmetryflag, sparsityflag, pivotingflag,
NO_LOCK, 0, NULL, mtxmanager, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : initialize the front matrix",
t2 - t1) ;
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n nendD = %d, nentL = %d, nentU = %d",
frontmtx->nentD, frontmtx->nentL, frontmtx->nentU) ;
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front matrix initialized") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------
factor the matrix
-----------------
*/
nzf = ETree_nFactorEntries(frontETree, symmetryflag) ;
factorops = ETree_nFactorOps(frontETree, type, symmetryflag) ;
fprintf(msgFile,
"\n %d factor entries, %.0f factor ops, %8.3f ratio",
nzf, factorops, factorops/nzf) ;
IVzero(6, stats) ;
DVzero(9, cpus) ;
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, NO_LOCK, 1) ;
MARKTIME(t1) ;
rootchv = FrontMtx_factorInpMtx(frontmtx, mtxA, tau, droptol,
chvmanager, &error, cpus,
stats, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops",
t2 - t1, 1.e-6*factorops/(t2-t1)) ;
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n factorization did not complete") ;
for ( chv = rootchv ; chv != NULL ; chv = chv->next ) {
fprintf(stdout, "\n chv %d, nD = %d, nL = %d, nU = %d",
chv->id, chv->nD, chv->nL, chv->nU) ;
}
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n error encountered at front %d\n", error) ;
rc=error ;
goto end_front;
}
fprintf(msgFile,
"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns",
stats[0], stats[1], stats[2]) ;
if ( frontmtx->rowadjIVL != NULL ) {
fprintf(msgFile,
"\n %d entries in rowadjIVL", frontmtx->rowadjIVL->tsize) ;
}
if ( frontmtx->coladjIVL != NULL ) {
fprintf(msgFile,
", %d entries in coladjIVL", frontmtx->coladjIVL->tsize) ;
}
if ( frontmtx->upperblockIVL != NULL ) {
fprintf(msgFile,
"\n %d fronts, %d entries in upperblockIVL",
frontmtx->nfront, frontmtx->upperblockIVL->tsize) ;
}
if ( frontmtx->lowerblockIVL != NULL ) {
fprintf(msgFile,
", %d entries in lowerblockIVL",
frontmtx->lowerblockIVL->tsize) ;
}
fprintf(msgFile,
"\n %d entries in D, %d entries in L, %d entries in U",
stats[3], stats[4], stats[5]) ;
fprintf(msgFile, "\n %d locks", frontmtx->nlocks) ;
if ( FRONTMTX_IS_SYMMETRIC(frontmtx)
|| FRONTMTX_IS_HERMITIAN(frontmtx) ) {
int nneg, npos, nzero ;
FrontMtx_inertia(frontmtx, &nneg, &nzero, &npos) ;
fprintf(msgFile,
"\n %d negative, %d zero and %d positive eigenvalues",
nneg, nzero, npos) ;
fflush(msgFile) ;
}
cputotal = cpus[8] ;
if ( cputotal > 0.0 ) {
fprintf(msgFile,
"\n initialize fronts %8.3f %6.2f"
"\n load original entries %8.3f %6.2f"
"\n update fronts %8.3f %6.2f"
"\n assemble postponed data %8.3f %6.2f"
"\n factor fronts %8.3f %6.2f"
"\n extract postponed data %8.3f %6.2f"
"\n store factor entries %8.3f %6.2f"
"\n miscellaneous %8.3f %6.2f"
"\n total time %8.3f",
cpus[0], 100.*cpus[0]/cputotal,
cpus[1], 100.*cpus[1]/cputotal,
cpus[2], 100.*cpus[2]/cputotal,
cpus[3], 100.*cpus[3]/cputotal,
cpus[4], 100.*cpus[4]/cputotal,
cpus[5], 100.*cpus[5]/cputotal,
cpus[6], 100.*cpus[6]/cputotal,
cpus[7], 100.*cpus[7]/cputotal, cputotal) ;
}
if ( msglvl > 1 ) {
SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ;
ChvManager_writeForHumanEye(chvmanager, msgFile) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
/*
------------------------------
post-process the factor matrix
------------------------------
*/
MARKTIME(t1) ;
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n front factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
}
fprintf(msgFile, "\n\n after post-processing") ;
if ( msglvl > 1 ) SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
/*
----------------
solve the system
----------------
*/
neqns = mtxB->nrow ;
mtxZ = DenseMtx_new() ;
DenseMtx_init(mtxZ, type, 0, 0, neqns, nrhs, 1, neqns) ;
zversion=INPMTX_IS_COMPLEX_ENTRIES(mtxA);
for (k=0; k<imethod; k++) {
DenseMtx_zero(mtxZ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rhs") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(stdout) ;
}
fprintf(msgFile, "\n\n itemax %d", itermax) ;
DVzero(6, cpus) ;
MARKTIME(t1) ;
switch ( method[k] ) {
case BiCGStabR :
if (zversion)
rc=zbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=bicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case BiCGStabL :
if (zversion)
rc=zbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=bicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case TFQMRR :
if (zversion)
rc=ztfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=tfqmrr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case TFQMRL :
if (zversion)
rc=ztfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=tfqmrl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case PCGR :
if (zversion)
rc=zpcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=pcgr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case PCGL :
if (zversion)
rc=zpcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
else
rc=pcgl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ, mtxB,
itermax, conv_tol, msglvl, msgFile);
break;
case MLBiCGStabR :
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
Drand_setUniform(&drand, 0.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxQ, &drand) ;
if (zversion)
rc=zmlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
else
rc=mlbicgstabr(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
DenseMtx_free(mtxQ) ;
break;
case MLBiCGStabL :
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, Ik, 1, neqns) ;
Drand_setUniform(&drand, 0.0, 1.0) ;
DenseMtx_fillRandomEntries(mtxQ, &drand) ;
if (zversion)
rc=zmlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
else
rc=mlbicgstabl(neqns, type, symmetryflag, mtxA, frontmtx, mtxQ, mtxZ,
mtxB, itermax, conv_tol, msglvl, msgFile);
DenseMtx_free(mtxQ) ;
break;
case BGMRESR:
if (zversion)
fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
"at this moment. ") ;
else
rc=bgmresr(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
msglvl, msgFile);
break;
case BGMRESL:
if (zversion)
fprintf(msgFile, "\n\n *** BGMRESR complex version is not available "
"at this moment. ") ;
else
rc=bgmresl(neqns, type, symmetryflag, mtxA, frontmtx, mtxZ,
mtxB, iterout, itermax, &nouter, &ninner, conv_tol,
msglvl, msgFile);
break;
default:
fprintf(msgFile, "\n\n *** Invalid method number ") ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n\n CPU %8.3f : solve the system", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n computed solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
/*
-------------------------------------------------------------
permute the computed solution back into the original ordering
-------------------------------------------------------------
*/
MARKTIME(t1) ;
DenseMtx_permuteRows(mtxZ, newToOldIV) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : permute solution", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n permuted solution") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
/*
-------------
save solution
-------------
*/
if ( strcmp(slnFileName, "none") != 0 ) {
DenseMtx_writeToFile(mtxZ, slnFileName) ;
}
/*
-----------------
compute the error
-----------------
*/
if (!strcmp(rhsFileName, "none")) {
DenseMtx_sub(mtxZ, mtxX) ;
if (method[k] <8) {
mtxQ = DenseMtx_new() ;
DenseMtx_init(mtxQ, type, 0, -1, neqns, 1, 1, neqns) ;
rc=DenseMtx_initAsSubmatrix (mtxQ, mtxZ, 0, neqns-1, 0, 0);
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxQ)) ;
DenseMtx_free(mtxQ) ;
}
else
fprintf(msgFile, "\n\n maxabs error = %12.4e", DenseMtx_maxabs(mtxZ)) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n error") ;
DenseMtx_writeForHumanEye(mtxZ, msgFile) ;
fflush(stdout) ;
}
if ( msglvl > 1 )
SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ;
}
fprintf(msgFile, "\n--------- End of Method %d -------\n",method[k]) ;
}
/*
------------------------
free the working storage
------------------------
*/
DenseMtx_free(mtxZ) ;
end_front:
ChvManager_free(chvmanager) ;
SubMtxManager_free(mtxmanager) ;
FrontMtx_free(frontmtx) ;
IVL_free(symbfacIVL) ;
IV_free(oldToNewIV) ;
IV_free(newToOldIV) ;
end_tree:
ETree_free(frontETree) ;
end_init:
DenseMtx_free(mtxB) ;
DenseMtx_free(mtxX) ;
end_read:
InpMtx_free(mtxA) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(rc) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] ) {
/*
--------------------------------------------------
all-in-one program to solve A X = B
using a multithreaded factorization and solve
We use a patch-and-go strategy
for the factorization without pivoting
(1) read in matrix entries and form DInpMtx object
(2) form Graph object
(3) order matrix and form front tree
(4) get the permutation, permute the matrix and
front tree and get the symbolic factorization
(5) compute the numeric factorization
(6) read in right hand side entries
(7) compute the solution
created -- 98jun04, cca
--------------------------------------------------
*/
/*--------------------------------------------------------------------*/
char *matrixFileName, *rhsFileName ;
DenseMtx *mtxB, *mtxX ;
Chv *rootchv ;
ChvManager *chvmanager ;
double fudge, imag, real, tau = 100., toosmall, value ;
double cpus[10] ;
DV *cumopsDV ;
ETree *frontETree ;
FrontMtx *frontmtx ;
FILE *inputFile, *msgFile ;
Graph *graph ;
InpMtx *mtxA ;
int error, ient, irow, jcol, jrhs, jrow, lookahead, msglvl,
ncol, nedges, nent, neqns, nfront, nrhs, nrow, nthread,
patchAndGoFlag, seed,
storeids, storevalues, symmetryflag, type ;
int *newToOld, *oldToNew ;
int stats[20] ;
IV *newToOldIV, *oldToNewIV, *ownersIV ;
IVL *adjIVL, *symbfacIVL ;
SolveMap *solvemap ;
SubMtxManager *mtxmanager ;
/*--------------------------------------------------------------------*/
/*
--------------------
get input parameters
--------------------
*/
if ( argc != 14 ) {
fprintf(stdout, "\n"
"\n usage: %s msglvl msgFile type symmetryflag patchAndGoFlag"
"\n fudge toosmall storeids storevalues"
"\n matrixFileName rhsFileName seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of entries"
"\n 1 (SPOOLES_REAL) -- real entries"
"\n 2 (SPOOLES_COMPLEX) -- complex entries"
"\n symmetryflag -- type of matrix"
"\n 0 (SPOOLES_SYMMETRIC) -- symmetric entries"
"\n 1 (SPOOLES_HERMITIAN) -- Hermitian entries"
"\n 2 (SPOOLES_NONSYMMETRIC) -- nonsymmetric entries"
"\n patchAndGoFlag -- flag for the patch-and-go strategy"
"\n 0 -- none, stop factorization"
"\n 1 -- optimization strategy"
"\n 2 -- structural analysis strategy"
"\n fudge -- perturbation parameter"
"\n toosmall -- upper bound on a small pivot"
"\n storeids -- flag to store ids of small pivots"
"\n storevalues -- flag to store perturbations"
"\n matrixFileName -- matrix file name, format"
"\n nrow ncol nent"
"\n irow jcol entry"
"\n ..."
"\n note: indices are zero based"
"\n rhsFileName -- right hand side file name, format"
"\n nrow nrhs "
"\n ..."
"\n jrow entry(jrow,0) ... entry(jrow,nrhs-1)"
"\n ..."
"\n seed -- random number seed, used for ordering"
"\n nthread -- number of threads"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
type = atoi(argv[3]) ;
symmetryflag = atoi(argv[4]) ;
patchAndGoFlag = atoi(argv[5]) ;
fudge = atof(argv[6]) ;
toosmall = atof(argv[7]) ;
storeids = atoi(argv[8]) ;
storevalues = atoi(argv[9]) ;
matrixFileName = argv[10] ;
rhsFileName = argv[11] ;
seed = atoi(argv[12]) ;
nthread = atoi(argv[13]) ;
/*--------------------------------------------------------------------*/
/*
--------------------------------------------
STEP 1: read the entries from the input file
and create the InpMtx object
--------------------------------------------
*/
if ( (inputFile = fopen(matrixFileName, "r")) == NULL ) {
fprintf(stderr, "\n unable to open file %s", matrixFileName) ;
spoolesFatal();
}
fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ;
neqns = nrow ;
mtxA = InpMtx_new() ;
InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, 0) ;
if ( type == SPOOLES_REAL ) {
for ( ient = 0 ; ient < nent ; ient++ ) {
fscanf(inputFile, "%d %d %le", &irow, &jcol, &value) ;
InpMtx_inputRealEntry(mtxA, irow, jcol, value) ;
}
} else {
for ( ient = 0 ; ient < nent ; ient++ ) {
fscanf(inputFile, "%d %d %le %le", &irow, &jcol, &real, &imag) ;
InpMtx_inputComplexEntry(mtxA, irow, jcol, real, imag) ;
}
}
fclose(inputFile) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n input matrix") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-------------------------------------------------
STEP 2 : find a low-fill ordering
(1) create the Graph object
(2) order the graph using multiple minimum degree
-------------------------------------------------
*/
graph = Graph_new() ;
adjIVL = InpMtx_fullAdjacency(mtxA) ;
nedges = IVL_tsize(adjIVL) ;
Graph_init2(graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL,
NULL, NULL) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n graph of the input matrix") ;
Graph_writeForHumanEye(graph, msgFile) ;
fflush(msgFile) ;
}
frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n front tree from ordering") ;
ETree_writeForHumanEye(frontETree, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------------
STEP 3: get the permutation, permute the matrix and
front tree and get the symbolic factorization
-----------------------------------------------------
*/
oldToNewIV = ETree_oldToNewVtxPerm(frontETree) ;
oldToNew = IV_entries(oldToNewIV) ;
newToOldIV = ETree_newToOldVtxPerm(frontETree) ;
newToOld = IV_entries(newToOldIV) ;
ETree_permuteVertices(frontETree, oldToNewIV) ;
InpMtx_permute(mtxA, oldToNew, oldToNew) ;
InpMtx_mapToUpperTriangle(mtxA) ;
InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ;
InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ;
symbfacIVL = SymbFac_initFromInpMtx(frontETree, mtxA) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n old-to-new permutation vector") ;
IV_writeForHumanEye(oldToNewIV, msgFile) ;
fprintf(msgFile, "\n\n new-to-old permutation vector") ;
IV_writeForHumanEye(newToOldIV, msgFile) ;
fprintf(msgFile, "\n\n front tree after permutation") ;
ETree_writeForHumanEye(frontETree, msgFile) ;
fprintf(msgFile, "\n\n input matrix after permutation") ;
InpMtx_writeForHumanEye(mtxA, msgFile) ;
fprintf(msgFile, "\n\n symbolic factorization") ;
IVL_writeForHumanEye(symbfacIVL, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
------------------------------------------
STEP 4: initialize the front matrix object
and the PatchAndGoInfo object to handle
small pivots
------------------------------------------
*/
frontmtx = FrontMtx_new() ;
mtxmanager = SubMtxManager_new() ;
SubMtxManager_init(mtxmanager, LOCK_IN_PROCESS, 0) ;
FrontMtx_init(frontmtx, frontETree, symbfacIVL, type, symmetryflag,
FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, LOCK_IN_PROCESS,
0, NULL, mtxmanager, msglvl, msgFile) ;
if ( patchAndGoFlag == 1 ) {
frontmtx->patchinfo = PatchAndGoInfo_new() ;
PatchAndGoInfo_init(frontmtx->patchinfo, 1, toosmall, fudge,
storeids, storevalues) ;
} else if ( patchAndGoFlag == 2 ) {
frontmtx->patchinfo = PatchAndGoInfo_new() ;
PatchAndGoInfo_init(frontmtx->patchinfo, 2, toosmall, fudge,
storeids, storevalues) ;
}
/*--------------------------------------------------------------------*/
/*
------------------------------------------
STEP 5: setup the domain decomposition map
------------------------------------------
*/
if ( nthread > (nfront = FrontMtx_nfront(frontmtx)) ) {
nthread = nfront ;
}
cumopsDV = DV_new() ;
DV_init(cumopsDV, nthread, NULL) ;
ownersIV = ETree_ddMap(frontETree, type, symmetryflag,
cumopsDV, 1./(2.*nthread)) ;
DV_free(cumopsDV) ;
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------------
STEP 6: compute the numeric factorization in parallel
-----------------------------------------------------
*/
chvmanager = ChvManager_new() ;
ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1) ;
DVfill(10, cpus, 0.0) ;
IVfill(20, stats, 0) ;
lookahead = 0 ;
rootchv = FrontMtx_MT_factorInpMtx(frontmtx, mtxA, tau, 0.0,
chvmanager, ownersIV, lookahead,
&error, cpus, stats, msglvl, msgFile) ;
if ( patchAndGoFlag == 1 ) {
if ( frontmtx->patchinfo->fudgeIV != NULL ) {
fprintf(msgFile, "\n small pivots found at these locations") ;
IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ;
}
PatchAndGoInfo_free(frontmtx->patchinfo) ;
} else if ( patchAndGoFlag == 2 ) {
if ( frontmtx->patchinfo->fudgeIV != NULL ) {
fprintf(msgFile, "\n small pivots found at these locations") ;
IV_writeForHumanEye(frontmtx->patchinfo->fudgeIV, msgFile) ;
}
if ( frontmtx->patchinfo->fudgeDV != NULL ) {
fprintf(msgFile, "\n perturbations") ;
DV_writeForHumanEye(frontmtx->patchinfo->fudgeDV, msgFile) ;
}
PatchAndGoInfo_free(frontmtx->patchinfo) ;
}
ChvManager_free(chvmanager) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n factor matrix") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
if ( rootchv != NULL ) {
fprintf(msgFile, "\n\n matrix found to be singular\n") ;
spoolesFatal();
}
if ( error >= 0 ) {
fprintf(msgFile, "\n\n fatal error at front %d\n", error) ;
spoolesFatal();
}
/*
--------------------------------------
STEP 7: post-process the factorization
--------------------------------------
*/
FrontMtx_postProcess(frontmtx, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n factor matrix after post-processing") ;
FrontMtx_writeForHumanEye(frontmtx, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------
STEP 8: read the right hand side matrix B
-----------------------------------------
*/
if ( (inputFile = fopen(rhsFileName, "r")) == NULL ) {
fprintf(stderr, "\n unable to open file %s", rhsFileName) ;
spoolesFatal();
}
fscanf(inputFile, "%d %d", &nrow, &nrhs) ;
mtxB = DenseMtx_new() ;
DenseMtx_init(mtxB, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxB) ;
if ( type == SPOOLES_REAL ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
fscanf(inputFile, "%d", &jrow) ;
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
fscanf(inputFile, "%le", &value) ;
DenseMtx_setRealEntry(mtxB, jrow, jrhs, value) ;
}
}
} else {
for ( irow = 0 ; irow < nrow ; irow++ ) {
fscanf(inputFile, "%d", &jrow) ;
for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
fscanf(inputFile, "%le %le", &real, &imag) ;
DenseMtx_setComplexEntry(mtxB, jrow, jrhs, real, imag) ;
}
}
}
fclose(inputFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n rhs matrix in original ordering") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------------
STEP 9: permute the right hand side into the original ordering
--------------------------------------------------------------
*/
DenseMtx_permuteRows(mtxB, oldToNewIV) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n right hand side matrix in new ordering") ;
DenseMtx_writeForHumanEye(mtxB, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------
STEP 10: get the solve map object for the parallel solve
--------------------------------------------------------
*/
solvemap = SolveMap_new() ;
SolveMap_ddMap(solvemap, type, FrontMtx_upperBlockIVL(frontmtx),
FrontMtx_lowerBlockIVL(frontmtx), nthread, ownersIV,
FrontMtx_frontTree(frontmtx), seed, msglvl, msgFile) ;
/*--------------------------------------------------------------------*/
/*
--------------------------------------------
STEP 11: solve the linear system in parallel
--------------------------------------------
*/
mtxX = DenseMtx_new() ;
DenseMtx_init(mtxX, type, 0, 0, neqns, nrhs, 1, neqns) ;
DenseMtx_zero(mtxX) ;
FrontMtx_MT_solve(frontmtx, mtxX, mtxB, mtxmanager, solvemap,
cpus, msglvl, msgFile) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n solution matrix in new ordering") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
--------------------------------------------------------
STEP 12: permute the solution into the original ordering
--------------------------------------------------------
*/
DenseMtx_permuteRows(mtxX, newToOldIV) ;
if ( msglvl > 0 ) {
fprintf(msgFile, "\n\n solution matrix in original ordering") ;
DenseMtx_writeForHumanEye(mtxX, msgFile) ;
fflush(msgFile) ;
}
/*--------------------------------------------------------------------*/
/*
-----------
free memory
-----------
*/
FrontMtx_free(frontmtx) ;
DenseMtx_free(mtxX) ;
DenseMtx_free(mtxB) ;
IV_free(newToOldIV) ;
IV_free(oldToNewIV) ;
InpMtx_free(mtxA) ;
ETree_free(frontETree) ;
IVL_free(symbfacIVL) ;
SubMtxManager_free(mtxmanager) ;
Graph_free(graph) ;
SolveMap_free(solvemap) ;
IV_free(ownersIV) ;
/*--------------------------------------------------------------------*/
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------
read in (i, j, a(i,j)) triples,
construct a InpMtx object and
write it out to a file
created -- 97oct17, cca
---------------------------------------------------
*/
{
char *inFileName, *outFileName ;
InpMtx *inpmtx ;
FILE *inputFile, *msgFile ;
int dataType, flag, ient, msglvl,
ncol, nent, nrow, rc ;
int *ivec1, *ivec2 ;
if ( argc != 7 ) {
fprintf(stdout,
"\n\n usage : readAIJ msglvl msgFile dataType inputFile outFile flag"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n dataType -- 0 for indices only, 1 for double, 2 for complex"
"\n inputFile -- input file for a(i,j) entries"
"\n the first line must be \"nrow ncol nentries\""
"\n if dataType == 0 then"
"\n next lines are \"irow jcol\""
"\n else if dataType == 1 then"
"\n next lines are \"irow jcol entry\""
"\n else if dataType == 2 then"
"\n next lines are \"irow jcol realEntry imagEntry\""
"\n endif"
"\n outFile -- output file, must be *.inpmtxf or *.inpmtxb"
"\n flag -- flag for 0-based or 1-based addressing"
"\n") ;
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) ;
}
dataType = atoi(argv[3]) ;
inFileName = argv[4] ;
outFileName = argv[5] ;
flag = atoi(argv[6]) ;
fprintf(msgFile,
"\n readAIJ "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n dataType -- %d"
"\n inputFile -- %s"
"\n outFile -- %s"
"\n flag -- %d"
"\n",
msglvl, argv[2], dataType, inFileName, outFileName, flag) ;
fflush(msgFile) ;
/*
----------------------------
open the input file and read
#rows #columns #entries
----------------------------
*/
if ( (inputFile = fopen(inFileName, "r")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], inFileName) ;
return(-1) ;
}
rc = fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ;
if ( rc != 3 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 3 fields read on first line of file %s",
argv[0], rc, inFileName) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n read in nrow = %d, ncol = %d, nent = %d",
nrow, ncol, nent) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------
initialize the object
set coordType = INPMTX_BY_ROWS --> row coordinates
set inputMode = dataType
--------------------------------------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, dataType, nent, 0) ;
/*
-------------------------------------------------
read in the entries and load them into the object
-------------------------------------------------
*/
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) {
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d", ivec1 + ient, ivec2 + ient) ;
if ( rc != 2 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 2 fields read on entry %d of file %s",
argv[0], rc, ient, inFileName) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n entry %d, row %d, column %d",
ient, ivec1[ient], ivec2[ient]) ;
fflush(msgFile) ;
}
}
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d %le",
ivec1 + ient, ivec2 + ient, dvec + ient) ;
if ( rc != 3 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 3 fields read on entry %d of file %s",
argv[0], rc, ient, argv[3]) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n entry %d, row %d, column %d, value %e",
ient, ivec1[ient], ivec2[ient], dvec[ient]) ;
fflush(msgFile) ;
}
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
rc = fscanf(inputFile, "%d %d %le %le",
ivec1 + ient, ivec2 + ient,
dvec + 2*ient, dvec + 2*ient+1) ;
if ( rc != 4 ) {
fprintf(stderr, "\n fatal error in %s"
"\n %d of 4 fields read on entry %d of file %s",
argv[0], rc, ient, argv[3]) ;
return(-1) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n entry %d, row %d, column %d, value %12.4e + %12.4e*i",
ient, ivec1[ient], ivec2[ient],
dvec[2*ient], dvec[2*ient+1]) ;
fflush(msgFile) ;
}
}
}
inpmtx->nent = nent ;
if ( flag == 1 ) {
/*
--------------------------------------------------
indices were in FORTRAN mode, decrement for C mode
--------------------------------------------------
*/
for ( ient = 0 ; ient < nent ; ient++ ) {
ivec1[ient]-- ; ivec2[ient]-- ;
}
}
/*
-----------------------------
sort and compress the entries
-----------------------------
*/
InpMtx_changeStorageMode(inpmtx, 3) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n sorted, compressed and vector form") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
write out the InpMtx object
---------------------------
*/
if ( strcmp(outFileName, "none") != 0 ) {
rc = InpMtx_writeToFile(inpmtx, outFileName) ;
fprintf(msgFile,
"\n return value %d from InpMtx_writeToFile(%p,%s)",
rc, inpmtx, outFileName) ;
}
/*
---------------------
free the working data
---------------------
*/
InpMtx_free(inpmtx) ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(1) ; }
/*
----------------------------------------------------------------
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) ; }
