EXTERN_C_BEGIN
/*
MatOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
#undef __FUNCT__
#define __FUNCT__ "MatOrdering_RCM"
PetscErrorCode PETSCMAT_DLLEXPORT MatOrdering_RCM(Mat mat,const MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*ia,*ja,*perm;
PetscTruth done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,PetscInt,&mask,nrow,PetscInt,&perm,2*nrow,PetscInt,&xls);CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,col);CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_QMD(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscInt i, *deg,*marker,*rchset,*nbrhd,*qsize,*qlink,nofsub,*iperm,nrow,*perm;
PetscErrorCode ierr;
const PetscInt *ia,*ja;
PetscBool done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc(nrow * sizeof(PetscInt),&perm);CHKERRQ(ierr);
ierr = PetscMalloc5(nrow,PetscInt,&iperm,nrow,PetscInt,°,nrow,PetscInt,&marker,nrow,PetscInt,&rchset,nrow,PetscInt,&nbrhd);CHKERRQ(ierr);
ierr = PetscMalloc2(nrow,PetscInt,&qsize,nrow,PetscInt,&qlink);CHKERRQ(ierr);
/* WARNING - genqmd trashes ja */
SPARSEPACKgenqmd(&nrow,ia,ja,perm,iperm,deg,marker,rchset,nbrhd,qsize,qlink,&nofsub);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
ierr = PetscFree2(qsize,qlink);CHKERRQ(ierr);
ierr = PetscFree5(iperm,deg,marker,rchset,nbrhd);CHKERRQ(ierr);
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_OWN_POINTER,col);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/*
MatGetOrdering_1WD - Find the 1-way dissection ordering of a given matrix.
*/
#undef __FUNCT__
#define __FUNCT__ "MatGetOrdering_1WD"
PetscErrorCode MatGetOrdering_1WD(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nblks,*xblk,*ls,nrow,*perm;
const PetscInt *ia,*ja;
PetscBool done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc5(nrow,PetscInt,&mask,nrow+1,PetscInt,&xls,nrow,PetscInt,&ls,nrow+1,PetscInt,&xblk,nrow,PetscInt,&perm);CHKERRQ(ierr);
SPARSEPACKgen1wd(&nrow,ia,ja,mask,&nblks,xblk,perm,xls,ls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);CHKERRQ(ierr);
ierr = PetscFree5(mask,xls,ls,xblk,perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DumpCSR(Mat A,PetscInt shift,PetscBool symmetric,PetscBool compressed)
{
MatType type;
PetscInt i,j,nr,bs = 1;
const PetscInt *ia,*ja;
PetscBool done,isseqbaij,isseqsbaij;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQBAIJ,&isseqbaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQSBAIJ,&isseqsbaij);CHKERRQ(ierr);
if (isseqbaij || isseqsbaij) {
ierr = MatGetBlockSize(A,&bs);CHKERRQ(ierr);
}
ierr = MatGetType(A,&type);CHKERRQ(ierr);
ierr = MatGetRowIJ(A,shift,symmetric,compressed,&nr,&ia,&ja,&done);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"===========================================================\n");CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"CSR for %s: shift %D symmetric %D compressed %D\n",type,shift,(PetscInt)symmetric,(PetscInt)compressed);CHKERRQ(ierr);
for (i=0;i<nr;i++) {
ierr = PetscPrintf(PETSC_COMM_SELF,"%D:",i+shift);CHKERRQ(ierr);
for (j=ia[i];j<ia[i+1];j++) {
ierr = PetscPrintf(PETSC_COMM_SELF," %D",ja[j-shift]);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_SELF,"\n");CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(A,shift,symmetric,compressed,&nr,&ia,&ja,&done);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatGetOrdering_myordering(Mat mat,MatOrderingType type,IS *irow,IS *icol)
{
PetscErrorCode ierr;
PetscInt n,i,*ii;
PetscBool done;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)mat,&comm);
CHKERRQ(ierr);
ierr = MatGetRowIJ(mat,0,PETSC_FALSE,PETSC_TRUE,&n,NULL,NULL,&done);
CHKERRQ(ierr);
ierr = MatRestoreRowIJ(mat,0,PETSC_FALSE,PETSC_TRUE,NULL,NULL,NULL,&done);
CHKERRQ(ierr);
if (done) { /* matrix may be "compressed" in symbolic factorization, due to i-nodes or block storage */
ierr = PetscMalloc(n*sizeof(PetscInt),&ii);
CHKERRQ(ierr);
for (i=0; i<n; i++) ii[i] = n-i-1; /* replace your index here */
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ii,PETSC_COPY_VALUES,irow);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ii,PETSC_OWN_POINTER,icol);
CHKERRQ(ierr);
} else SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"MatRestoreRowIJ fails!");
ierr = ISSetIdentity(*irow);
CHKERRQ(ierr);
ierr = ISSetIdentity(*icol);
CHKERRQ(ierr);
ierr = ISSetPermutation(*irow);
CHKERRQ(ierr);
ierr = ISSetPermutation(*icol);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
MatGetOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
PETSC_INTERN PetscErrorCode MatGetOrdering_RCM(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*perm;
const PetscInt *ia,*ja;
PetscBool done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);
CHKERRQ(ierr);
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,&mask,nrow,&perm,2*nrow,&xls);
CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,NULL,&ia,&ja,&done);
CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);
CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/*
MatOrdering_ND - Find the nested dissection ordering of a given matrix.
*/
#undef __FUNCT__
#define __FUNCT__ "MatOrdering_ND"
PetscErrorCode PETSCMAT_DLLEXPORT MatOrdering_ND(Mat mat,const MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i, *mask,*xls,*ls,nrow,*ia,*ja,*perm;
PetscTruth done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PETSC_ERR_SUP,"Cannot get rows for matrix type %s",((PetscObject)mat)->type_name);
ierr = PetscMalloc4(nrow,PetscInt,&mask,nrow,PetscInt,&perm,nrow+1,PetscInt,&xls,nrow,PetscInt,&ls);CHKERRQ(ierr);
SPARSEPACKgennd(&nrow,ia,ja,mask,perm,xls,ls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,col);CHKERRQ(ierr);
ierr = PetscFree4(mask,perm,xls,ls);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv) {
Mat A,B,As;
const PetscInt *ai,*aj;
PetscInt i,j,k,nz,n,asi[]={0,2,3,4,6,7};
PetscInt asj[]={0,4,1,2,3,4,4};
PetscScalar asa[7],*aa;
PetscRandom rctx;
PetscErrorCode ierr;
PetscMPIInt size;
PetscBool flg;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!");
/* Create a aij matrix for checking */
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,5,5,2,PETSC_NULL,&A);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
k = 0;
for (i=0; i<5; i++) {
nz = asi[i+1] - asi[i]; /* length of i_th row of A */
for (j=0; j<nz; j++){
ierr = PetscRandomGetValue(rctx,&asa[k]);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&i,1,&asj[k],&asa[k],INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&i,1,&asj[k],&asa[k],INSERT_VALUES);CHKERRQ(ierr);
if (i != asj[k]){ /* insert symmetric entry */
ierr = MatSetValues(A,1,&asj[k],1,&i,&asa[k],INSERT_VALUES);CHKERRQ(ierr);
}
k++;
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create a baij matrix using MatCreateSeqBAIJWithArrays() */
ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ai,&aj,&flg);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(A,&aa);CHKERRQ(ierr);
/* WARNING: This sharing is dangerous if either A or B is later assembled */
ierr = MatCreateSeqBAIJWithArrays(PETSC_COMM_SELF,1,5,5,(PetscInt*)ai,(PetscInt*)aj,aa,&B);CHKERRQ(ierr);
ierr = MatSeqAIJRestoreArray(A,&aa);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ai,&aj,&flg);CHKERRQ(ierr);
ierr = MatMultEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"MatMult(A,B) are NOT equal");
/* Create a sbaij matrix using MatCreateSeqSBAIJWithArrays() */
ierr = MatCreateSeqSBAIJWithArrays(PETSC_COMM_SELF,1,5,5,asi,asj,asa,&As);CHKERRQ(ierr);
ierr = MatMultEqual(A,As,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"MatMult(A,As) are NOT equal");
/* Free spaces */
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&As);CHKERRQ(ierr);
ierr = PetscFinalize();
return(0);
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_AMD(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt nrow,*perm;
const PetscInt *ia,*ja;
int status;
PetscReal val;
double Control[AMD_CONTROL],Info[AMD_INFO];
PetscBool tval,done;
PetscFunctionBegin;
/*
AMD does not require that the matrix be symmetric (it does so internally,
at least in so far as computing orderings for A+A^T.
*/
ierr = MatGetRowIJ(mat,0,PETSC_FALSE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get rows for matrix type %s",((PetscObject)mat)->type_name);
amd_AMD_defaults(Control);
ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)mat),((PetscObject)mat)->prefix,"AMD Options","Mat");CHKERRQ(ierr);
/*
We have to use temporary values here because AMD always uses double, even though PetscReal may be single
*/
val = (PetscReal)Control[AMD_DENSE];
ierr = PetscOptionsReal("-mat_ordering_amd_dense","threshold for \"dense\" rows/columns","None",val,&val,NULL);CHKERRQ(ierr);
Control[AMD_DENSE] = (double)val;
tval = (PetscBool)Control[AMD_AGGRESSIVE];
ierr = PetscOptionsBool("-mat_ordering_amd_aggressive","use aggressive absorption","None",tval,&tval,NULL);CHKERRQ(ierr);
Control[AMD_AGGRESSIVE] = (double)tval;
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscMalloc(nrow*sizeof(PetscInt),&perm);CHKERRQ(ierr);
status = amd_AMD_order(nrow,ia,ja,perm,Control,Info);
switch (status) {
case AMD_OK: break;
case AMD_OK_BUT_JUMBLED:
/* The result is fine, but PETSc matrices are supposed to satisfy stricter preconditions, so PETSc considers a
* matrix that triggers this error condition to be invalid.
*/
SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_PLIB,"According to AMD, the matrix has unsorted and/or duplicate row indices");
case AMD_INVALID:
amd_info(Info);
SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_PLIB,"According to AMD, the matrix is invalid");
case AMD_OUT_OF_MEMORY:
SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_MEM,"AMD could not compute ordering");
default:
SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_LIB,"Unexpected return value");
}
ierr = MatRestoreRowIJ(mat,0,PETSC_FALSE,PETSC_TRUE,NULL,&ia,&ja,&done);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_OWN_POINTER,col);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void
destroy() {
if (valid) {
//clean up the local array structures I allocated.
MatRestoreArray(mat, &data);
PetscTruth done = PETSC_FALSE;
MatRestoreRowIJ(mat, 0, PETSC_FALSE, PETSC_FALSE, &nrows, &ia, &ja, &done);
assert(done == PETSC_TRUE || "Unexpected error: can't return csr structure to matrix");
}
valid = false;
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
{
PetscScalar *a, *dw;
const PetscInt *ia, *ja;
const PetscInt job = 5;
PetscInt *perm, nrow, ncol, nnz, liw, *iw, ldw, i;
PetscBool done;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
ncol = nrow;
nnz = ia[nrow];
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = MatSeqAIJGetArray(mat, &a);CHKERRQ(ierr);
switch (job) {
case 1: liw = 4*nrow + ncol; ldw = 0;break;
case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
}
ierr = PetscMalloc3(liw,&iw,ldw,&dw,nrow,&perm);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUPERLU_DIST)
{
PetscInt num, info[10], icntl[10];
ierr = mc64id_dist(icntl);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64id_dist returned %d\n",ierr);
icntl[0] = 0; /* allow printing error messages (f2c'd code uses if non-negative, ignores value otherwise) */
icntl[1] = -1; /* suppress warnings */
icntl[2] = -1; /* ignore diagnostic output [default] */
icntl[3] = 0; /* perform consistency checks [default] */
ierr = mc64ad_dist(&job, &nrow, &nnz, ia, ja, a, &num, perm, &liw, iw, &ldw, dw, icntl, info);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64ad_dist returned %d\n",ierr);
}
#else
SETERRQ(PetscObjectComm((PetscObject) mat), PETSC_ERR_SUP, "WBM using MC64 does not support complex numbers");
#endif
ierr = MatRestoreRowIJ(mat, 1, PETSC_TRUE, PETSC_TRUE, NULL, &ia, &ja, &done);CHKERRQ(ierr);
for (i = 0; i < nrow; ++i) perm[i]--;
/* If job == 5, dw[0..ncols] contains the column scaling and dw[ncols..ncols+nrows] contains the row scaling */
ierr = ISCreateStride(PETSC_COMM_SELF, nrow, 0, 1, row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);CHKERRQ(ierr);
ierr = PetscFree3(iw,dw,perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void
find_influences
/////////////////////////////////////////////////////////////
/**
*/
(
Mat graph,
//graph of non-zero structure
IS wanted,
//nodes we are interested in. Contains different values on each processor.
IS *is_influences
//all the influences of the nodes we are interested in.
) {
//First, get all the matrix rows we are concerned with.
Mat subgraph_global;
get_matrix_rows(graph, wanted, &subgraph_global);
Mat subgraph;
MatGetLocalMat(subgraph_global, MAT_INITIAL_MATRIX, &subgraph);
MatDestroy(subgraph_global);
PetscInt n;
PetscInt *ia;
PetscInt *ja;
PetscTruth success = PETSC_FALSE;
MatGetRowIJ(subgraph, 0, PETSC_FALSE, PETSC_FALSE, &n, &ia, &ja, &success);
assert(success == PETSC_TRUE);
std::set<PetscInt> influences;
for(int ii=ia[0]; ii<ia[n]; ii++) {
influences.insert(ja[ii]);
}
success = PETSC_TRUE;
MatRestoreRowIJ(subgraph, 0, PETSC_FALSE, PETSC_FALSE, &n, &ia, &ja, &success);
MatDestroy(subgraph);
std::vector<PetscInt> all_influences;
std::copy(influences.begin(), influences.end(), std::back_inserter(all_influences));
ISCreateGeneral(PETSC_COMM_WORLD, all_influences.size(), &all_influences[0], is_influences);
}
PETSC_EXTERN void PETSC_STDCALL matrestorerowij_(Mat *B,PetscInt *shift,PetscBool *sym,PetscBool *blockcompressed, PetscInt *n,PetscInt *ia,size_t *iia,
PetscInt *ja,size_t *jja,PetscBool *done,PetscErrorCode *ierr)
{
const PetscInt *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja);
*ierr = MatRestoreRowIJ(*B,*shift,*sym,*blockcompressed,n,&IA,&JA,done);
}
/*
Mm_ratio - ration of grid lines between fine and coarse grids.
*/
int main(int argc,char **argv)
{
PetscErrorCode ierr;
AppCtx user;
PetscInt Npx=PETSC_DECIDE,Npy=PETSC_DECIDE,Npz=PETSC_DECIDE;
PetscMPIInt size,rank;
PetscInt m,n,M,N,i,nrows;
PetscScalar one = 1.0;
PetscReal fill=2.0;
Mat A,A_tmp,P,C,C1,C2;
PetscScalar *array,none = -1.0,alpha;
Vec x,v1,v2,v3,v4;
PetscReal norm,norm_tmp,norm_tmp1,tol=100.*PETSC_MACHINE_EPSILON;
PetscRandom rdm;
PetscBool Test_MatMatMult=PETSC_TRUE,Test_MatPtAP=PETSC_TRUE,Test_3D=PETSC_TRUE,flg;
const PetscInt *ia,*ja;
ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
ierr = PetscOptionsGetReal(NULL,NULL,"-tol",&tol,NULL);CHKERRQ(ierr);
user.ratio = 2;
user.coarse.mx = 20; user.coarse.my = 20; user.coarse.mz = 20;
ierr = PetscOptionsGetInt(NULL,NULL,"-Mx",&user.coarse.mx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-My",&user.coarse.my,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-Mz",&user.coarse.mz,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-ratio",&user.ratio,NULL);CHKERRQ(ierr);
if (user.coarse.mz) Test_3D = PETSC_TRUE;
user.fine.mx = user.ratio*(user.coarse.mx-1)+1;
user.fine.my = user.ratio*(user.coarse.my-1)+1;
user.fine.mz = user.ratio*(user.coarse.mz-1)+1;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-Npx",&Npx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-Npy",&Npy,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-Npz",&Npz,NULL);CHKERRQ(ierr);
/* Set up distributed array for fine grid */
if (!Test_3D) {
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,Npx,Npy,1,1,NULL,NULL,&user.fine.da);CHKERRQ(ierr);
} else {
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,user.fine.mz,Npx,Npy,Npz,1,1,NULL,NULL,NULL,&user.fine.da);CHKERRQ(ierr);
}
ierr = DMSetFromOptions(user.fine.da);CHKERRQ(ierr);
ierr = DMSetUp(user.fine.da);CHKERRQ(ierr);
/* Test DMCreateMatrix() */
/*------------------------------------------------------------*/
ierr = DMSetMatType(user.fine.da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(user.fine.da,&A);CHKERRQ(ierr);
ierr = DMSetMatType(user.fine.da,MATBAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(user.fine.da,&C);CHKERRQ(ierr);
ierr = MatConvert(C,MATAIJ,MAT_INITIAL_MATRIX,&A_tmp);CHKERRQ(ierr); /* not work for mpisbaij matrix! */
ierr = MatEqual(A,A_tmp,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"A != C");
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&A_tmp);CHKERRQ(ierr);
/*------------------------------------------------------------*/
ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr);
/* if (!rank) printf("A %d, %d\n",M,N); */
/* set val=one to A */
if (size == 1) {
ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
} else {
Mat AA,AB;
ierr = MatMPIAIJGetSeqAIJ(A,&AA,&AB,NULL);CHKERRQ(ierr);
ierr = MatGetRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(AA,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(AA,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
ierr = MatGetRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(AB,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(AB,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
}
/* ierr = MatView(A, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
/* Set up distributed array for coarse grid */
if (!Test_3D) {
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,Npx,Npy,1,1,NULL,NULL,&user.coarse.da);CHKERRQ(ierr);
} else {
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,user.coarse.mz,Npx,Npy,Npz,
1,1,NULL,NULL,NULL,&user.coarse.da);CHKERRQ(ierr);
}
ierr = DMSetFromOptions(user.coarse.da);CHKERRQ(ierr);
ierr = DMSetUp(user.coarse.da);CHKERRQ(ierr);
/* Create interpolation between the fine and coarse grids */
ierr = DMCreateInterpolation(user.coarse.da,user.fine.da,&P,NULL);CHKERRQ(ierr);
ierr = MatGetLocalSize(P,&m,&n);CHKERRQ(ierr);
ierr = MatGetSize(P,&M,&N);CHKERRQ(ierr);
/* if (!rank) printf("P %d, %d\n",M,N); */
/* Create vectors v1 and v2 that are compatible with A */
ierr = VecCreate(PETSC_COMM_WORLD,&v1);CHKERRQ(ierr);
ierr = MatGetLocalSize(A,&m,NULL);CHKERRQ(ierr);
ierr = VecSetSizes(v1,m,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(v1);CHKERRQ(ierr);
ierr = VecDuplicate(v1,&v2);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
/* Test MatMatMult(): C = A*P */
/*----------------------------*/
if (Test_MatMatMult) {
ierr = MatDuplicate(A,MAT_COPY_VALUES,&A_tmp);CHKERRQ(ierr);
ierr = MatMatMult(A_tmp,P,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr);
/* Test MAT_REUSE_MATRIX - reuse symbolic C */
alpha=1.0;
for (i=0; i<2; i++) {
alpha -= 0.1;
ierr = MatScale(A_tmp,alpha);CHKERRQ(ierr);
ierr = MatMatMult(A_tmp,P,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr);
}
/* Free intermediate data structures created for reuse of C=Pt*A*P */
ierr = MatFreeIntermediateDataStructures(C);CHKERRQ(ierr);
/* Test MatDuplicate() */
/*----------------------------*/
ierr = MatDuplicate(C,MAT_COPY_VALUES,&C1);CHKERRQ(ierr);
ierr = MatDuplicate(C1,MAT_COPY_VALUES,&C2);CHKERRQ(ierr);
ierr = MatDestroy(&C1);CHKERRQ(ierr);
ierr = MatDestroy(&C2);CHKERRQ(ierr);
/* Create vector x that is compatible with P */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = MatGetLocalSize(P,NULL,&n);CHKERRQ(ierr);
ierr = VecSetSizes(x,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
norm = 0.0;
for (i=0; i<10; i++) {
ierr = VecSetRandom(x,rdm);CHKERRQ(ierr);
ierr = MatMult(P,x,v1);CHKERRQ(ierr);
ierr = MatMult(A_tmp,v1,v2);CHKERRQ(ierr); /* v2 = A*P*x */
ierr = MatMult(C,x,v1);CHKERRQ(ierr); /* v1 = C*x */
ierr = VecAXPY(v1,none,v2);CHKERRQ(ierr);
ierr = VecNorm(v1,NORM_1,&norm_tmp);CHKERRQ(ierr);
ierr = VecNorm(v2,NORM_1,&norm_tmp1);CHKERRQ(ierr);
norm_tmp /= norm_tmp1;
if (norm_tmp > norm) norm = norm_tmp;
}
if (norm >= tol && !rank) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMatMult(), |v1 - v2|/|v2|: %g\n",(double)norm);CHKERRQ(ierr);
}
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&A_tmp);CHKERRQ(ierr);
}
/* Test P^T * A * P - MatPtAP() */
/*------------------------------*/
if (Test_MatPtAP) {
ierr = MatPtAP(A,P,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr);
ierr = MatGetLocalSize(C,&m,&n);CHKERRQ(ierr);
/* Test MAT_REUSE_MATRIX - reuse symbolic C */
alpha=1.0;
for (i=0; i<1; i++) {
alpha -= 0.1;
ierr = MatScale(A,alpha);CHKERRQ(ierr);
ierr = MatPtAP(A,P,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr);
}
/* Free intermediate data structures created for reuse of C=Pt*A*P */
ierr = MatFreeIntermediateDataStructures(C);CHKERRQ(ierr);
/* Test MatDuplicate() */
/*----------------------------*/
ierr = MatDuplicate(C,MAT_COPY_VALUES,&C1);CHKERRQ(ierr);
ierr = MatDuplicate(C1,MAT_COPY_VALUES,&C2);CHKERRQ(ierr);
ierr = MatDestroy(&C1);CHKERRQ(ierr);
ierr = MatDestroy(&C2);CHKERRQ(ierr);
/* Create vector x that is compatible with P */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = MatGetLocalSize(P,&m,&n);CHKERRQ(ierr);
ierr = VecSetSizes(x,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&v3);CHKERRQ(ierr);
ierr = VecSetSizes(v3,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(v3);CHKERRQ(ierr);
ierr = VecDuplicate(v3,&v4);CHKERRQ(ierr);
norm = 0.0;
for (i=0; i<10; i++) {
ierr = VecSetRandom(x,rdm);CHKERRQ(ierr);
ierr = MatMult(P,x,v1);CHKERRQ(ierr);
ierr = MatMult(A,v1,v2);CHKERRQ(ierr); /* v2 = A*P*x */
ierr = MatMultTranspose(P,v2,v3);CHKERRQ(ierr); /* v3 = Pt*A*P*x */
ierr = MatMult(C,x,v4);CHKERRQ(ierr); /* v3 = C*x */
ierr = VecAXPY(v4,none,v3);CHKERRQ(ierr);
ierr = VecNorm(v4,NORM_1,&norm_tmp);CHKERRQ(ierr);
ierr = VecNorm(v3,NORM_1,&norm_tmp1);CHKERRQ(ierr);
norm_tmp /= norm_tmp1;
if (norm_tmp > norm) norm = norm_tmp;
}
if (norm >= tol && !rank) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatPtAP(), |v3 - v4|/|v3|: %g\n",(double)norm);CHKERRQ(ierr);
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = VecDestroy(&v3);CHKERRQ(ierr);
ierr = VecDestroy(&v4);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
}
/* Clean up */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
ierr = VecDestroy(&v1);CHKERRQ(ierr);
ierr = VecDestroy(&v2);CHKERRQ(ierr);
ierr = DMDestroy(&user.fine.da);CHKERRQ(ierr);
ierr = DMDestroy(&user.coarse.da);CHKERRQ(ierr);
ierr = MatDestroy(&P);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode MatISGetMPIXAIJ_IS(Mat mat, MatReuse reuse, Mat *M)
{
Mat_IS *matis = (Mat_IS*)(mat->data);
Mat local_mat;
/* info on mat */
PetscInt bs,rows,cols,lrows,lcols;
PetscInt local_rows,local_cols;
PetscBool isdense,issbaij,isseqaij;
PetscMPIInt nsubdomains;
/* values insertion */
PetscScalar *array;
/* work */
PetscErrorCode ierr;
PetscFunctionBegin;
/* get info from mat */
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
if (nsubdomains == 1) {
if (reuse == MAT_INITIAL_MATRIX) {
ierr = MatDuplicate(matis->A,MAT_COPY_VALUES,&(*M));CHKERRQ(ierr);
} else {
ierr = MatCopy(matis->A,*M,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
ierr = MatGetLocalSize(mat,&lrows,&lcols);CHKERRQ(ierr);
ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
if (reuse == MAT_INITIAL_MATRIX) {
MatType new_mat_type;
PetscBool issbaij_red;
/* determining new matrix type */
ierr = MPIU_Allreduce(&issbaij,&issbaij_red,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
if (issbaij_red) {
new_mat_type = MATSBAIJ;
} else {
if (bs>1) {
new_mat_type = MATBAIJ;
} else {
new_mat_type = MATAIJ;
}
}
ierr = MatCreate(PetscObjectComm((PetscObject)mat),M);CHKERRQ(ierr);
ierr = MatSetSizes(*M,lrows,lcols,rows,cols);CHKERRQ(ierr);
ierr = MatSetBlockSize(*M,bs);CHKERRQ(ierr);
ierr = MatSetType(*M,new_mat_type);CHKERRQ(ierr);
ierr = MatISSetMPIXAIJPreallocation_Private(mat,*M,PETSC_FALSE);CHKERRQ(ierr);
} else {
PetscInt mbs,mrows,mcols,mlrows,mlcols;
/* some checks */
ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
ierr = MatGetLocalSize(*M,&mlrows,&mlcols);CHKERRQ(ierr);
if (mrows != rows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
if (mcols != cols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
if (mlrows != lrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of local rows (%d != %d)",lrows,mlrows);
if (mlcols != lcols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of local cols (%d != %d)",lcols,mlcols);
if (mbs != bs) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
ierr = MatZeroEntries(*M);CHKERRQ(ierr);
}
if (issbaij) {
ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&local_mat);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
local_mat = matis->A;
}
/* Set values */
ierr = MatSetLocalToGlobalMapping(*M,mat->rmap->mapping,mat->cmap->mapping);CHKERRQ(ierr);
if (isdense) { /* special case for dense local matrices */
PetscInt i,*dummy_rows,*dummy_cols;
if (local_rows != local_cols) {
ierr = PetscMalloc2(local_rows,&dummy_rows,local_cols,&dummy_cols);CHKERRQ(ierr);
for (i=0;i<local_rows;i++) dummy_rows[i] = i;
for (i=0;i<local_cols;i++) dummy_cols[i] = i;
} else {
ierr = PetscMalloc1(local_rows,&dummy_rows);CHKERRQ(ierr);
for (i=0;i<local_rows;i++) dummy_rows[i] = i;
dummy_cols = dummy_rows;
}
ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatDenseGetArray(local_mat,&array);CHKERRQ(ierr);
ierr = MatSetValuesLocal(*M,local_rows,dummy_rows,local_cols,dummy_cols,array,ADD_VALUES);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(local_mat,&array);CHKERRQ(ierr);
if (dummy_rows != dummy_cols) {
ierr = PetscFree2(dummy_rows,dummy_cols);CHKERRQ(ierr);
} else {
ierr = PetscFree(dummy_rows);CHKERRQ(ierr);
}
} else if (isseqaij) {
PetscInt i,nvtxs,*xadj,*adjncy;
PetscBool done;
ierr = MatGetRowIJ(local_mat,0,PETSC_FALSE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PetscObjectComm((PetscObject)local_mat),PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
ierr = MatSeqAIJGetArray(local_mat,&array);CHKERRQ(ierr);
for (i=0;i<nvtxs;i++) {
ierr = MatSetValuesLocal(*M,1,&i,xadj[i+1]-xadj[i],adjncy+xadj[i],array+xadj[i],ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(local_mat,0,PETSC_FALSE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PetscObjectComm((PetscObject)local_mat),PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
ierr = MatSeqAIJRestoreArray(local_mat,&array);CHKERRQ(ierr);
} else { /* very basic values insertion for all other matrix types */
PetscInt i;
for (i=0;i<local_rows;i++) {
PetscInt j;
const PetscInt *local_indices_cols;
ierr = MatGetRow(local_mat,i,&j,&local_indices_cols,(const PetscScalar**)&array);CHKERRQ(ierr);
ierr = MatSetValuesLocal(*M,1,&i,j,local_indices_cols,array,ADD_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(local_mat,i,&j,&local_indices_cols,(const PetscScalar**)&array);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDestroy(&local_mat);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (isdense) {
ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
* The interface should be easy to use for both MatGetSubMatrix (parallel sub-matrix) and MatGetSubMatrices (sequential sub-matrices)
* */
static PetscErrorCode MatGetSubMatrix_MPIAdj_data(Mat adj,IS irows, IS icols, PetscInt **sadj_xadj,PetscInt **sadj_adjncy,PetscInt **sadj_values)
{
PetscInt nlrows_is,icols_n,i,j,nroots,nleaves,owner,rlocalindex,*ncols_send,*ncols_recv;
PetscInt nlrows_mat,*adjncy_recv,Ncols_recv,Ncols_send,*xadj_recv,*values_recv;
PetscInt *ncols_recv_offsets,loc,rnclos,*sadjncy,*sxadj,*svalues,isvalue;
const PetscInt *irows_indices,*icols_indices,*xadj, *adjncy;
Mat_MPIAdj *a = (Mat_MPIAdj*)adj->data;
PetscLayout rmap;
MPI_Comm comm;
PetscSF sf;
PetscSFNode *iremote;
PetscBool done;
PetscErrorCode ierr;
PetscFunctionBegin;
/* communicator */
ierr = PetscObjectGetComm((PetscObject)adj,&comm);CHKERRQ(ierr);
/* Layouts */
ierr = MatGetLayouts(adj,&rmap,PETSC_NULL);CHKERRQ(ierr);
/* get rows information */
ierr = ISGetLocalSize(irows,&nlrows_is);CHKERRQ(ierr);
ierr = ISGetIndices(irows,&irows_indices);CHKERRQ(ierr);
ierr = PetscCalloc1(nlrows_is,&iremote);CHKERRQ(ierr);
/* construct sf graph*/
nleaves = nlrows_is;
for(i=0; i<nlrows_is; i++){
owner = -1;
rlocalindex = -1;
ierr = PetscLayoutFindOwnerIndex(rmap,irows_indices[i],&owner,&rlocalindex);CHKERRQ(ierr);
iremote[i].rank = owner;
iremote[i].index = rlocalindex;
}
ierr = MatGetRowIJ(adj,0,PETSC_FALSE,PETSC_FALSE,&nlrows_mat,&xadj,&adjncy,&done);CHKERRQ(ierr);
ierr = PetscCalloc4(nlrows_mat,&ncols_send,nlrows_is,&xadj_recv,nlrows_is+1,&ncols_recv_offsets,nlrows_is,&ncols_recv);CHKERRQ(ierr);
nroots = nlrows_mat;
for(i=0; i<nlrows_mat; i++){
ncols_send[i] = xadj[i+1]-xadj[i];
}
ierr = PetscSFCreate(comm,&sf);CHKERRQ(ierr);
ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
ierr = PetscSFBcastBegin(sf,MPIU_INT,ncols_send,ncols_recv);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,ncols_send,ncols_recv);CHKERRQ(ierr);
ierr = PetscSFBcastBegin(sf,MPIU_INT,xadj,xadj_recv);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,xadj,xadj_recv);CHKERRQ(ierr);
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
Ncols_recv =0;
for(i=0; i<nlrows_is; i++){
Ncols_recv += ncols_recv[i];
ncols_recv_offsets[i+1] = ncols_recv[i]+ncols_recv_offsets[i];
}
Ncols_send = 0;
for(i=0; i<nlrows_mat; i++){
Ncols_send += ncols_send[i];
}
ierr = PetscCalloc1(Ncols_recv,&iremote);CHKERRQ(ierr);
ierr = PetscCalloc1(Ncols_recv,&adjncy_recv);CHKERRQ(ierr);
nleaves = Ncols_recv;
Ncols_recv = 0;
for(i=0; i<nlrows_is; i++){
ierr = PetscLayoutFindOwner(rmap,irows_indices[i],&owner);CHKERRQ(ierr);
for(j=0; j<ncols_recv[i]; j++){
iremote[Ncols_recv].rank = owner;
iremote[Ncols_recv++].index = xadj_recv[i]+j;
}
}
ierr = ISRestoreIndices(irows,&irows_indices);CHKERRQ(ierr);
/*if we need to deal with edge weights ???*/
if(a->values){isvalue=1;}else{isvalue=0;}
/*involve a global communication */
/*ierr = MPI_Allreduce(&isvalue,&isvalue,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);*/
if(isvalue){ierr = PetscCalloc1(Ncols_recv,&values_recv);CHKERRQ(ierr);}
nroots = Ncols_send;
ierr = PetscSFCreate(comm,&sf);CHKERRQ(ierr);
ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
ierr = PetscSFBcastBegin(sf,MPIU_INT,adjncy,adjncy_recv);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,adjncy,adjncy_recv);CHKERRQ(ierr);
if(isvalue){
ierr = PetscSFBcastBegin(sf,MPIU_INT,a->values,values_recv);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,a->values,values_recv);CHKERRQ(ierr);
}
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(adj,0,PETSC_FALSE,PETSC_FALSE,&nlrows_mat,&xadj,&adjncy,&done);CHKERRQ(ierr);
ierr = ISGetLocalSize(icols,&icols_n);CHKERRQ(ierr);
ierr = ISGetIndices(icols,&icols_indices);CHKERRQ(ierr);
rnclos = 0;
for(i=0; i<nlrows_is; i++){
for(j=ncols_recv_offsets[i]; j<ncols_recv_offsets[i+1]; j++){
ierr = PetscFindInt(adjncy_recv[j], icols_n, icols_indices, &loc);CHKERRQ(ierr);
if(loc<0){
adjncy_recv[j] = -1;
if(isvalue) values_recv[j] = -1;
ncols_recv[i]--;
}else{
rnclos++;
}
}
}
ierr = ISRestoreIndices(icols,&icols_indices);CHKERRQ(ierr);
ierr = PetscCalloc1(rnclos,&sadjncy);CHKERRQ(ierr);
if(isvalue) {ierr = PetscCalloc1(rnclos,&svalues);CHKERRQ(ierr);}
ierr = PetscCalloc1(nlrows_is+1,&sxadj);CHKERRQ(ierr);
rnclos = 0;
for(i=0; i<nlrows_is; i++){
for(j=ncols_recv_offsets[i]; j<ncols_recv_offsets[i+1]; j++){
if(adjncy_recv[j]<0) continue;
sadjncy[rnclos] = adjncy_recv[j];
if(isvalue) svalues[rnclos] = values_recv[j];
rnclos++;
}
}
for(i=0; i<nlrows_is; i++){
sxadj[i+1] = sxadj[i]+ncols_recv[i];
}
if(sadj_xadj) { *sadj_xadj = sxadj;}else { ierr = PetscFree(sxadj);CHKERRQ(ierr);}
if(sadj_adjncy){ *sadj_adjncy = sadjncy;}else{ ierr = PetscFree(sadjncy);CHKERRQ(ierr);}
if(sadj_values){
if(isvalue) *sadj_values = svalues; else *sadj_values=0;
}else{
if(isvalue) {ierr = PetscFree(svalues);CHKERRQ(ierr);}
}
ierr = PetscFree4(ncols_send,xadj_recv,ncols_recv_offsets,ncols_recv);CHKERRQ(ierr);
ierr = PetscFree(adjncy_recv);CHKERRQ(ierr);
if(isvalue) {ierr = PetscFree(values_recv);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/* ----------------------------------------------------------------------------*/
/*
MatGetColoring_SL_Minpack - Uses the smallest-last (SL) coloring of minpack
*/
#undef __FUNCT__
#define __FUNCT__ "MatGetColoring_SL_Minpack"
PetscErrorCode MatGetColoring_SL_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscInt *list,*work,clique,*seq,*coloring,n;
const PetscInt *ria,*rja,*cia,*cja;
PetscInt ncolors,i;
PetscBool done;
Mat mat_seq = mat;
PetscMPIInt size;
MPI_Comm comm;
ISColoring iscoloring_seq;
PetscInt bs = 1,rstart,rend,N_loc,nc;
ISColoringValue *colors_loc;
PetscBool flg1,flg2;
PetscFunctionBegin;
/* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1){
/* create a sequential iscoloring on all processors */
ierr = MatGetSeqNonzeroStructure(mat,&mat_seq);CHKERRQ(ierr);
}
ierr = MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");
ierr = MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);CHKERRQ(ierr);
ierr = PetscMalloc2(n,PetscInt,&list,4*n,PetscInt,&work);CHKERRQ(ierr);
MINPACKslo(&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
ierr = PetscMalloc(n*sizeof(PetscInt),&coloring);CHKERRQ(ierr);
MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
ierr = PetscFree2(list,work);CHKERRQ(ierr);
ierr = PetscFree(seq);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
/* shift coloring numbers to start at zero and shorten */
if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
{
ISColoringValue *s = (ISColoringValue*) coloring;
for (i=0; i<n; i++) {
s[i] = (ISColoringValue) (coloring[i]-1);
}
ierr = MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);CHKERRQ(ierr);
}
if (size > 1) {
ierr = MatDestroySeqNonzeroStructure(&mat_seq);CHKERRQ(ierr);
/* convert iscoloring_seq to a parallel iscoloring */
iscoloring_seq = *iscoloring;
rstart = mat->rmap->rstart/bs;
rend = mat->rmap->rend/bs;
N_loc = rend - rstart; /* number of local nodes */
/* get local colors for each local node */
ierr = PetscMalloc((N_loc+1)*sizeof(ISColoringValue),&colors_loc);CHKERRQ(ierr);
for (i=rstart; i<rend; i++){
colors_loc[i-rstart] = iscoloring_seq->colors[i];
}
/* create a parallel iscoloring */
nc=iscoloring_seq->n;
ierr = ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring_seq);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatColoringApply_LF(MatColoring mc,ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscInt *list,*work,*seq,*coloring,n;
const PetscInt *ria,*rja,*cia,*cja;
PetscInt n1, none,ncolors,i;
PetscBool done;
Mat mat = mc->mat;
Mat mat_seq = mat;
PetscMPIInt size;
MPI_Comm comm;
ISColoring iscoloring_seq;
PetscInt bs = 1,rstart,rend,N_loc,nc;
ISColoringValue *colors_loc;
PetscBool flg1,flg2;
PetscFunctionBegin;
if (mc->dist != 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LF may only do distance 2 coloring");
/* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1) {
/* create a sequential iscoloring on all processors */
ierr = MatGetSeqNonzeroStructure(mat,&mat_seq);CHKERRQ(ierr);
}
ierr = MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");
ierr = MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);CHKERRQ(ierr);
ierr = PetscMalloc2(n,&list,4*n,&work);CHKERRQ(ierr);
n1 = n - 1;
none = -1;
MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
ierr = PetscMalloc1(n,&coloring);CHKERRQ(ierr);
MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
ierr = PetscFree2(list,work);CHKERRQ(ierr);
ierr = PetscFree(seq);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&cia,&cja,&done);CHKERRQ(ierr);
/* shift coloring numbers to start at zero and shorten */
if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
{
ISColoringValue *s = (ISColoringValue*) coloring;
for (i=0; i<n; i++) s[i] = (ISColoringValue) (coloring[i]-1);
ierr = MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);CHKERRQ(ierr);
}
if (size > 1) {
ierr = MatDestroySeqNonzeroStructure(&mat_seq);CHKERRQ(ierr);
/* convert iscoloring_seq to a parallel iscoloring */
iscoloring_seq = *iscoloring;
rstart = mat->rmap->rstart/bs;
rend = mat->rmap->rend/bs;
N_loc = rend - rstart; /* number of local nodes */
/* get local colors for each local node */
ierr = PetscMalloc1((N_loc+1),&colors_loc);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) colors_loc[i-rstart] = iscoloring_seq->colors[i];
/* create a parallel iscoloring */
nc = iscoloring_seq->n;
ierr = ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring_seq);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Mm_ratio - ration of grid lines between fine and coarse grids.
*/
int main(int argc,char **argv)
{
PetscErrorCode ierr;
AppCtx user;
PetscMPIInt size,rank;
PetscInt m,n,M,N,i,nrows;
PetscScalar one = 1.0;
PetscReal fill=2.0;
Mat A,P,R,C,PtAP;
PetscScalar *array;
PetscRandom rdm;
PetscBool Test_3D=PETSC_FALSE,flg;
const PetscInt *ia,*ja;
ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* Get size of fine grids and coarse grids */
user.ratio = 2;
user.coarse.mx = 4; user.coarse.my = 4; user.coarse.mz = 4;
ierr = PetscOptionsGetInt(NULL,NULL,"-Mx",&user.coarse.mx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-My",&user.coarse.my,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-Mz",&user.coarse.mz,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-ratio",&user.ratio,NULL);CHKERRQ(ierr);
if (user.coarse.mz) Test_3D = PETSC_TRUE;
user.fine.mx = user.ratio*(user.coarse.mx-1)+1;
user.fine.my = user.ratio*(user.coarse.my-1)+1;
user.fine.mz = user.ratio*(user.coarse.mz-1)+1;
if (!rank) {
if (!Test_3D) {
ierr = PetscPrintf(PETSC_COMM_SELF,"coarse grids: %D %D; fine grids: %D %D\n",user.coarse.mx,user.coarse.my,user.fine.mx,user.fine.my);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF,"coarse grids: %D %D %D; fine grids: %D %D %D\n",user.coarse.mx,user.coarse.my,user.coarse.mz,user.fine.mx,user.fine.my,user.fine.mz);CHKERRQ(ierr);
}
}
/* Set up distributed array for fine grid */
if (!Test_3D) {
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&user.fine.da);CHKERRQ(ierr);
} else {
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,user.fine.mz,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,
1,1,NULL,NULL,NULL,&user.fine.da);CHKERRQ(ierr);
}
ierr = DMSetFromOptions(user.fine.da);CHKERRQ(ierr);
ierr = DMSetUp(user.fine.da);CHKERRQ(ierr);
/* Create and set A at fine grids */
ierr = DMSetMatType(user.fine.da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(user.fine.da,&A);CHKERRQ(ierr);
ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr);
/* set val=one to A (replace with random values!) */
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
if (size == 1) {
ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
} else {
Mat AA,AB;
ierr = MatMPIAIJGetSeqAIJ(A,&AA,&AB,NULL);CHKERRQ(ierr);
ierr = MatGetRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(AA,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(AA,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
ierr = MatGetRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSeqAIJGetArray(AB,&array);CHKERRQ(ierr);
for (i=0; i<ia[nrows]; i++) array[i] = one;
ierr = MatSeqAIJRestoreArray(AB,&array);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr);
}
/* Set up distributed array for coarse grid */
if (!Test_3D) {
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&user.coarse.da);CHKERRQ(ierr);
} else {
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,user.coarse.mz,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,NULL,&user.coarse.da);CHKERRQ(ierr);
}
ierr = DMSetFromOptions(user.coarse.da);CHKERRQ(ierr);
ierr = DMSetUp(user.coarse.da);CHKERRQ(ierr);
/* Create interpolation between the fine and coarse grids */
ierr = DMCreateInterpolation(user.coarse.da,user.fine.da,&P,NULL);CHKERRQ(ierr);
/* Get R = P^T */
ierr = MatTranspose(P,MAT_INITIAL_MATRIX,&R);CHKERRQ(ierr);
/* C = R*A*P */
ierr = MatMatMatMult(R,A,P,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr);
ierr = MatMatMatMult(R,A,P,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr);
/* Test C == PtAP */
ierr = MatPtAP(A,P,MAT_INITIAL_MATRIX,fill,&PtAP);CHKERRQ(ierr);
ierr = MatPtAP(A,P,MAT_REUSE_MATRIX,fill,&PtAP);CHKERRQ(ierr);
ierr = MatEqual(C,PtAP,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"Matrices are not equal");
ierr = MatDestroy(&PtAP);CHKERRQ(ierr);
/* Clean up */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
ierr = DMDestroy(&user.fine.da);CHKERRQ(ierr);
ierr = DMDestroy(&user.coarse.da);CHKERRQ(ierr);
ierr = MatDestroy(&P);CHKERRQ(ierr);
ierr = MatDestroy(&R);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
