/*@
MatCreateTranspose - Creates a new matrix object that behaves like A'
Collective on Mat
Input Parameter:
. A - the (possibly rectangular) matrix
Output Parameter:
. N - the matrix that represents A'
Level: intermediate
Notes:
The transpose A' is NOT actually formed! Rather the new matrix
object performs the matrix-vector product by using the MatMultTranspose() on
the original matrix
.seealso: MatCreateNormal(), MatMult(), MatMultTranspose(), MatCreate()
@*/
PetscErrorCode MatCreateTranspose(Mat A,Mat *N)
{
PetscErrorCode ierr;
PetscInt m,n;
Mat_Transpose *Na;
PetscFunctionBegin;
ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
ierr = MatCreate(PetscObjectComm((PetscObject)A),N);CHKERRQ(ierr);
ierr = MatSetSizes(*N,n,m,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*N)->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*N)->cmap);CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)*N,MATTRANSPOSEMAT);CHKERRQ(ierr);
ierr = PetscNewLog(*N,&Na);CHKERRQ(ierr);
(*N)->data = (void*) Na;
ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
Na->A = A;
(*N)->ops->destroy = MatDestroy_Transpose;
(*N)->ops->mult = MatMult_Transpose;
(*N)->ops->multadd = MatMultAdd_Transpose;
(*N)->ops->multtranspose = MatMultTranspose_Transpose;
(*N)->ops->multtransposeadd = MatMultTransposeAdd_Transpose;
(*N)->ops->duplicate = MatDuplicate_Transpose;
(*N)->ops->getvecs = MatCreateVecs_Transpose;
(*N)->ops->axpy = MatAXPY_Transpose;
(*N)->assembled = PETSC_TRUE;
ierr = PetscObjectComposeFunction((PetscObject)(*N),"MatTransposeGetMat_C",MatTransposeGetMat_Transpose);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*N,PetscAbs(A->cmap->bs),PetscAbs(A->rmap->bs));CHKERRQ(ierr);
ierr = MatSetUp(*N);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Takes the local part of an already assembled MPIAIJ matrix
and disassembles it. This is to allow new nonzeros into the matrix
that require more communication in the matrix vector multiply.
Thus certain data-structures must be rebuilt.
Kind of slow! But that's what application programmers get when
they are sloppy.
*/
PetscErrorCode MatDisAssemble_MPIAIJ(Mat A)
{
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)A->data;
Mat B = aij->B,Bnew;
Mat_SeqAIJ *Baij = (Mat_SeqAIJ*)B->data;
PetscErrorCode ierr;
PetscInt i,j,m = B->rmap->n,n = A->cmap->N,col,ct = 0,*garray = aij->garray,*nz,ec;
PetscScalar v;
PetscFunctionBegin;
/* free stuff related to matrix-vec multiply */
ierr = VecGetSize(aij->lvec,&ec);CHKERRQ(ierr); /* needed for PetscLogObjectMemory below */
ierr = VecDestroy(&aij->lvec);CHKERRQ(ierr);
ierr = VecScatterDestroy(&aij->Mvctx);CHKERRQ(ierr);
if (aij->colmap) {
#if defined (PETSC_USE_CTABLE)
ierr = PetscTableDestroy(&aij->colmap);CHKERRQ(ierr);
#else
ierr = PetscFree(aij->colmap);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(A,-aij->B->cmap->n*sizeof(PetscInt));CHKERRQ(ierr);
#endif
}
/* make sure that B is assembled so we can access its values */
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* invent new B and copy stuff over */
ierr = PetscMalloc((m+1)*sizeof(PetscInt),&nz);CHKERRQ(ierr);
for (i=0; i<m; i++) {
nz[i] = Baij->i[i+1] - Baij->i[i];
}
ierr = MatCreate(PETSC_COMM_SELF,&Bnew);CHKERRQ(ierr);
ierr = MatSetSizes(Bnew,m,n,m,n);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Bnew,A->rmap->bs,A->cmap->bs);CHKERRQ(ierr);
ierr = MatSetType(Bnew,((PetscObject)B)->type_name);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Bnew,0,nz);CHKERRQ(ierr);
((Mat_SeqAIJ*)Bnew->data)->nonew = Baij->nonew; /* Inherit insertion error options. */
ierr = PetscFree(nz);CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=Baij->i[i]; j<Baij->i[i+1]; j++) {
col = garray[Baij->j[ct]];
v = Baij->a[ct++];
ierr = MatSetValues(Bnew,1,&i,1,&col,&v,B->insertmode);CHKERRQ(ierr);
}
}
ierr = PetscFree(aij->garray);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(A,-ec*sizeof(PetscInt));CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscLogObjectParent(A,Bnew);CHKERRQ(ierr);
aij->B = Bnew;
A->was_assembled = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode MatGetMultiProcBlock_MPIBAIJ(Mat mat, MPI_Comm subComm, MatReuse scall,Mat *subMat)
{
PetscErrorCode ierr;
Mat_MPIBAIJ *aij = (Mat_MPIBAIJ*)mat->data;
Mat_SeqBAIJ *aijB = (Mat_SeqBAIJ*)aij->B->data;
PetscMPIInt commRank,subCommSize,subCommRank;
PetscMPIInt *commRankMap,subRank,rank,commsize;
PetscInt *garrayCMap,col,i,j,*nnz,newRow,newCol,*newbRow,*newbCol,k,k1;
PetscInt bs=mat->rmap->bs;
PetscScalar *vals,*aijBvals;
PetscFunctionBegin;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&commsize);CHKERRQ(ierr);
ierr = MPI_Comm_size(subComm,&subCommSize);CHKERRQ(ierr);
/* create subMat object with the relavent layout */
if (scall == MAT_INITIAL_MATRIX) {
ierr = MatCreate(subComm,subMat);CHKERRQ(ierr);
ierr = MatSetType(*subMat,MATMPIBAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(*subMat,mat->rmap->n,mat->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*subMat,mat->rmap->bs,mat->cmap->bs);CHKERRQ(ierr);
/* need to setup rmap and cmap before Preallocation */
ierr = PetscLayoutSetBlockSize((*subMat)->rmap,mat->rmap->bs);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize((*subMat)->cmap,mat->cmap->bs);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*subMat)->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*subMat)->cmap);CHKERRQ(ierr);
}
/* create a map of comm_rank from subComm to comm - should commRankMap and garrayCMap be kept for reused? */
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&commRank);CHKERRQ(ierr);
ierr = MPI_Comm_rank(subComm,&subCommRank);CHKERRQ(ierr);
ierr = PetscMalloc(subCommSize*sizeof(PetscMPIInt),&commRankMap);CHKERRQ(ierr);
ierr = MPI_Allgather(&commRank,1,MPI_INT,commRankMap,1,MPI_INT,subComm);CHKERRQ(ierr);
/* Traverse garray and identify blocked column indices [of offdiag mat] that
should be discarded. For the ones not discarded, store the newCol+1
value in garrayCMap */
ierr = PetscMalloc(aij->B->cmap->n/bs*sizeof(PetscInt),&garrayCMap);CHKERRQ(ierr);
ierr = PetscMemzero(garrayCMap,aij->B->cmap->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<aij->B->cmap->n/bs; i++) {
col = aij->garray[i]; /* blocked column index */
for (subRank=0; subRank<subCommSize; subRank++) {
rank = commRankMap[subRank];
if ((col >= mat->cmap->range[rank]/bs) && (col < mat->cmap->range[rank+1]/bs)) {
garrayCMap[i] = (((*subMat)->cmap->range[subRank]- mat->cmap->range[rank])/bs + col + 1);
break;
}
}
}
if (scall == MAT_INITIAL_MATRIX) {
/* Now compute preallocation for the offdiag mat */
ierr = PetscMalloc(aij->B->rmap->n/bs*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
ierr = PetscMemzero(nnz,aij->B->rmap->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n/bs; i++) {
for (j=aijB->i[i]; j<aijB->i[i+1]; j++) {
if (garrayCMap[aijB->j[j]]) nnz[i]++;
}
}
ierr = MatMPIBAIJSetPreallocation(*(subMat),bs,0,NULL,0,nnz);CHKERRQ(ierr);
/* reuse diag block with the new submat */
ierr = MatDestroy(&((Mat_MPIBAIJ*)((*subMat)->data))->A);CHKERRQ(ierr);
((Mat_MPIBAIJ*)((*subMat)->data))->A = aij->A;
ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr);
} else if (((Mat_MPIBAIJ*)(*subMat)->data)->A != aij->A) {
PetscObject obj = (PetscObject)((Mat_MPIBAIJ*)((*subMat)->data))->A;
ierr = PetscObjectReference((PetscObject)obj);CHKERRQ(ierr);
((Mat_MPIBAIJ*)((*subMat)->data))->A = aij->A;
ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr);
}
/* Now traverse aij->B and insert values into subMat */
ierr = PetscMalloc3(bs,PetscInt,&newbRow,bs,PetscInt,&newbCol,bs*bs,PetscScalar,&vals);CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n/bs; i++) {
newRow = (*subMat)->rmap->range[subCommRank] + i*bs;
for (j=aijB->i[i]; j<aijB->i[i+1]; j++) {
newCol = garrayCMap[aijB->j[j]];
if (newCol) {
newCol--; /* remove the increment */
newCol *= bs;
for (k=0; k<bs; k++) {
newbRow[k] = newRow + k;
newbCol[k] = newCol + k;
}
/* copy column-oriented aijB->a into row-oriented vals */
aijBvals = aijB->a + j*bs*bs;
for (k1=0; k1<bs; k1++) {
for (k=0; k<bs; k++) {
vals[k1+k*bs] = *aijBvals++;
}
}
ierr = MatSetValues(*subMat,bs,newbRow,bs,newbCol,vals,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* deallocate temporary data */
ierr = PetscFree3(newbRow,newbCol,vals);CHKERRQ(ierr);
ierr = PetscFree(commRankMap);CHKERRQ(ierr);
ierr = PetscFree(garrayCMap);CHKERRQ(ierr);
if (scall == MAT_INITIAL_MATRIX) {
ierr = PetscFree(nnz);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatPtAPSymbolic_SeqAIJ_SeqAIJ_SparseAxpy(Mat A,Mat P,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*p = (Mat_SeqAIJ*)P->data,*c;
PetscInt *pti,*ptj,*ptJ,*ai=a->i,*aj=a->j,*ajj,*pi=p->i,*pj=p->j,*pjj;
PetscInt *ci,*cj,*ptadenserow,*ptasparserow,*ptaj,nspacedouble=0;
PetscInt an=A->cmap->N,am=A->rmap->N,pn=P->cmap->N,pm=P->rmap->N;
PetscInt i,j,k,ptnzi,arow,anzj,ptanzi,prow,pnzj,cnzi,nlnk,*lnk;
MatScalar *ca;
PetscBT lnkbt;
PetscReal afill;
PetscFunctionBegin;
/* Get ij structure of P^T */
ierr = MatGetSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr);
ptJ = ptj;
/* Allocate ci array, arrays for fill computation and */
/* free space for accumulating nonzero column info */
ierr = PetscMalloc1(pn+1,&ci);CHKERRQ(ierr);
ci[0] = 0;
ierr = PetscCalloc1(2*an+1,&ptadenserow);CHKERRQ(ierr);
ptasparserow = ptadenserow + an;
/* create and initialize a linked list */
nlnk = pn+1;
ierr = PetscLLCreate(pn,pn,nlnk,lnk,lnkbt);CHKERRQ(ierr);
/* Set initial free space to be fill*(nnz(A)+ nnz(P)) */
ierr = PetscFreeSpaceGet(PetscRealIntMultTruncate(fill,PetscIntSumTruncate(ai[am],pi[pm])),&free_space);CHKERRQ(ierr);
current_space = free_space;
/* Determine symbolic info for each row of C: */
for (i=0; i<pn; i++) {
ptnzi = pti[i+1] - pti[i];
ptanzi = 0;
/* Determine symbolic row of PtA: */
for (j=0; j<ptnzi; j++) {
arow = *ptJ++;
anzj = ai[arow+1] - ai[arow];
ajj = aj + ai[arow];
for (k=0; k<anzj; k++) {
if (!ptadenserow[ajj[k]]) {
ptadenserow[ajj[k]] = -1;
ptasparserow[ptanzi++] = ajj[k];
}
}
}
/* Using symbolic info for row of PtA, determine symbolic info for row of C: */
ptaj = ptasparserow;
cnzi = 0;
for (j=0; j<ptanzi; j++) {
prow = *ptaj++;
pnzj = pi[prow+1] - pi[prow];
pjj = pj + pi[prow];
/* add non-zero cols of P into the sorted linked list lnk */
ierr = PetscLLAddSorted(pnzj,pjj,pn,nlnk,lnk,lnkbt);CHKERRQ(ierr);
cnzi += nlnk;
}
/* If free space is not available, make more free space */
/* Double the amount of total space in the list */
if (current_space->local_remaining<cnzi) {
ierr = PetscFreeSpaceGet(PetscIntSumTruncate(cnzi,current_space->total_array_size),¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, and zero out denserows */
ierr = PetscLLClean(pn,pn,cnzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
current_space->array += cnzi;
current_space->local_used += cnzi;
current_space->local_remaining -= cnzi;
for (j=0; j<ptanzi; j++) ptadenserow[ptasparserow[j]] = 0;
/* Aside: Perhaps we should save the pta info for the numerical factorization. */
/* For now, we will recompute what is needed. */
ci[i+1] = ci[i] + cnzi;
}
/* nnz is now stored in ci[ptm], column indices are in the list of free space */
/* Allocate space for cj, initialize cj, and */
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1(ci[pn]+1,&cj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,cj);CHKERRQ(ierr);
ierr = PetscFree(ptadenserow);CHKERRQ(ierr);
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscCalloc1(ci[pn]+1,&ca);CHKERRQ(ierr);
/* put together the new matrix */
ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),pn,pn,ci,cj,ca,C);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*C,PetscAbs(P->cmap->bs),PetscAbs(P->cmap->bs));CHKERRQ(ierr);
/* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */
/* Since these are PETSc arrays, change flags to free them as necessary. */
c = (Mat_SeqAIJ*)((*C)->data);
c->free_a = PETSC_TRUE;
c->free_ij = PETSC_TRUE;
c->nonew = 0;
(*C)->ops->ptapnumeric = MatPtAPNumeric_SeqAIJ_SeqAIJ_SparseAxpy;
/* set MatInfo */
afill = (PetscReal)ci[pn]/(ai[am]+pi[pm] + 1.e-5);
if (afill < 1.0) afill = 1.0;
c->maxnz = ci[pn];
c->nz = ci[pn];
(*C)->info.mallocs = nspacedouble;
(*C)->info.fill_ratio_given = fill;
(*C)->info.fill_ratio_needed = afill;
/* Clean up. */
ierr = MatRestoreSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr);
#if defined(PETSC_USE_INFO)
if (ci[pn] != 0) {
ierr = PetscInfo3((*C),"Reallocs %D; Fill ratio: given %g needed %g.\n",nspacedouble,(double)fill,(double)afill);CHKERRQ(ierr);
ierr = PetscInfo1((*C),"Use MatPtAP(A,P,MatReuse,%g,&C) for best performance.\n",(double)afill);CHKERRQ(ierr);
} else {
ierr = PetscInfo((*C),"Empty matrix product\n");CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
/*
PCGAMGCreateGraph - create simple scaled scalar graph from matrix
Input Parameter:
. Amat - matrix
Output Parameter:
. a_Gmaat - eoutput scalar graph (symmetric?)
*/
PetscErrorCode PCGAMGCreateGraph(Mat Amat, Mat *a_Gmat)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,kk,ncols,nloc,NN,MM,bs;
MPI_Comm comm;
Mat Gmat;
MatType mtype;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetSize(Amat, &MM, &NN);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
if (bs > 1) {
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz,*w0,*w1,*w2;
PetscBool ismpiaij,isseqaij;
/*
Determine the preallocation needed for the scalar matrix derived from the vector matrix.
*/
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATMPIAIJ,&ismpiaij);CHKERRQ(ierr);
ierr = PetscMalloc2(nloc, &d_nnz,isseqaij ? 0 : nloc, &o_nnz);CHKERRQ(ierr);
if (isseqaij) {
PetscInt max_d_nnz;
/*
Determine exact preallocation count for (sequential) scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Amat,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend; Ii += bs, jj++) {
ierr = MatCollapseRows(Amat,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
} else if (ismpiaij) {
Mat Daij,Oaij;
const PetscInt *garray;
PetscInt max_d_nnz;
ierr = MatMPIAIJGetSeqAIJ(Amat,&Daij,&Oaij,&garray);CHKERRQ(ierr);
/*
Determine exact preallocation count for diagonal block portion of scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Daij,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
ierr = MatCollapseRows(Daij,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
/*
Over estimate (usually grossly over), preallocation count for off-diagonal portion of scalar matrix
*/
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
o_nnz[jj] = 0;
for (kk=0; kk<bs; kk++) { /* rows that get collapsed to a single row */
ierr = MatGetRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
o_nnz[jj] += ncols;
ierr = MatRestoreRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
}
if (o_nnz[jj] > (NN/bs-nloc)) o_nnz[jj] = NN/bs-nloc;
}
} else SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"Require AIJ matrix type");
/* get scalar copy (norms) of matrix */
ierr = MatGetType(Amat,&mtype);CHKERRQ(ierr);
ierr = MatCreate(comm, &Gmat);CHKERRQ(ierr);
ierr = MatSetSizes(Gmat,nloc,nloc,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Gmat, 1, 1);CHKERRQ(ierr);
ierr = MatSetType(Gmat, mtype);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Gmat,0,d_nnz);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Gmat,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
for (Ii = Istart; Ii < Iend; Ii++) {
PetscInt dest_row = Ii/bs;
ierr = MatGetRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++) {
PetscInt dest_col = idx[jj]/bs;
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
ierr = MatSetValues(Gmat,1,&dest_row,1,&dest_col,&sv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* just copy scalar matrix - abs() not taken here but scaled later */
ierr = MatDuplicate(Amat, MAT_COPY_VALUES, &Gmat);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
*a_Gmat = Gmat;
PetscFunctionReturn(0);
}
/*@C
PCGAMGFilterGraph - filter (remove zero and possibly small values from the) graph and make it symmetric if requested
Collective on Mat
Input Parameter:
+ a_Gmat - the graph
. vfilter - threshold paramter [0,1)
- symm - make the result symmetric
Level: developer
Notes:
This is called before graph coarsers are called.
.seealso: PCGAMGSetThreshold()
@*/
PetscErrorCode PCGAMGFilterGraph(Mat *a_Gmat,PetscReal vfilter,PetscBool symm)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,ncols,nnz0,nnz1, NN, MM, nloc;
PetscMPIInt rank;
Mat Gmat = *a_Gmat, tGmat, matTrans;
MPI_Comm comm;
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz;
Vec diag;
MatType mtype;
PetscFunctionBegin;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
/* scale Gmat for all values between -1 and 1 */
ierr = MatCreateVecs(Gmat, &diag, 0);CHKERRQ(ierr);
ierr = MatGetDiagonal(Gmat, diag);CHKERRQ(ierr);
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecSqrtAbs(diag);CHKERRQ(ierr);
ierr = MatDiagonalScale(Gmat, diag, diag);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
if (vfilter < 0.0 && !symm) {
/* Just use the provided matrix as the graph but make all values positive */
MatInfo info;
PetscScalar *avals;
PetscBool isaij,ismpiaij;
ierr = PetscObjectBaseTypeCompare((PetscObject)Gmat,MATSEQAIJ,&isaij);CHKERRQ(ierr);
ierr = PetscObjectBaseTypeCompare((PetscObject)Gmat,MATMPIAIJ,&ismpiaij);CHKERRQ(ierr);
if (!isaij && !ismpiaij) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"Require (MPI)AIJ matrix type");
if (isaij) {
ierr = MatGetInfo(Gmat,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(Gmat,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(Gmat,&avals);CHKERRQ(ierr);
} else {
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)Gmat->data;
ierr = MatGetInfo(aij->A,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(aij->A,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(aij->A,&avals);CHKERRQ(ierr);
ierr = MatGetInfo(aij->B,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(aij->B,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(aij->B,&avals);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Gmat, &Istart, &Iend);CHKERRQ(ierr);
nloc = Iend - Istart;
ierr = MatGetSize(Gmat, &MM, &NN);CHKERRQ(ierr);
if (symm) {
ierr = MatTranspose(Gmat, MAT_INITIAL_MATRIX, &matTrans);CHKERRQ(ierr);
}
/* Determine upper bound on nonzeros needed in new filtered matrix */
ierr = PetscMalloc2(nloc, &d_nnz,nloc, &o_nnz);CHKERRQ(ierr);
for (Ii = Istart, jj = 0; Ii < Iend; Ii++, jj++) {
ierr = MatGetRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] = ncols;
o_nnz[jj] = ncols;
ierr = MatRestoreRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
if (symm) {
ierr = MatGetRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] += ncols;
o_nnz[jj] += ncols;
ierr = MatRestoreRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
}
if (d_nnz[jj] > nloc) d_nnz[jj] = nloc;
if (o_nnz[jj] > (MM-nloc)) o_nnz[jj] = MM - nloc;
}
ierr = MatGetType(Gmat,&mtype);CHKERRQ(ierr);
ierr = MatCreate(comm, &tGmat);CHKERRQ(ierr);
ierr = MatSetSizes(tGmat,nloc,nloc,MM,MM);CHKERRQ(ierr);
ierr = MatSetBlockSizes(tGmat, 1, 1);CHKERRQ(ierr);
ierr = MatSetType(tGmat, mtype);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(tGmat,0,d_nnz);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(tGmat,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
if (symm) {
ierr = MatDestroy(&matTrans);CHKERRQ(ierr);
} else {
/* all entries are generated locally so MatAssembly will be slightly faster for large process counts */
ierr = MatSetOption(tGmat,MAT_NO_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
}
for (Ii = Istart, nnz0 = nnz1 = 0; Ii < Iend; Ii++) {
ierr = MatGetRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++,nnz0++) {
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
if (PetscRealPart(sv) > vfilter) {
nnz1++;
if (symm) {
sv *= 0.5;
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(tGmat,1,&idx[jj],1,&Ii,&sv,ADD_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatRestoreRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
#if defined(PETSC_USE_INFO)
{
double t1 = (!nnz0) ? 1. : 100.*(double)nnz1/(double)nnz0, t2 = (!nloc) ? 1. : (double)nnz0/(double)nloc;
ierr = PetscInfo4(*a_Gmat,"\t %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%D)\n",t1,vfilter,t2,MM);CHKERRQ(ierr);
}
#endif
ierr = MatDestroy(&Gmat);CHKERRQ(ierr);
*a_Gmat = tGmat;
PetscFunctionReturn(0);
}
/*
MatConvert_Basic - Converts from any input format to another format. For
parallel formats, the new matrix distribution is determined by PETSc.
Does not do preallocation so in general will be slow
*/
PetscErrorCode MatConvert_Basic(Mat mat, MatType newtype,MatReuse reuse,Mat *newmat)
{
Mat M;
const PetscScalar *vwork;
PetscErrorCode ierr;
PetscInt i,j,nz,m,n,rstart,rend,lm,ln,prbs,pcbs,cstart,cend,*dnz,*onz;
const PetscInt *cwork;
PetscBool isseqsbaij,ismpisbaij,isseqbaij,ismpibaij,isseqdense,ismpidense;
PetscFunctionBegin;
ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr);
ierr = MatGetLocalSize(mat,&lm,&ln);CHKERRQ(ierr);
if (ln == n) ln = PETSC_DECIDE; /* try to preserve column ownership */
ierr = MatCreate(PetscObjectComm((PetscObject)mat),&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,lm,ln,m,n);CHKERRQ(ierr);
ierr = MatSetBlockSizes(M,mat->rmap->bs,mat->cmap->bs);CHKERRQ(ierr);
ierr = MatSetType(M,newtype);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(mat,&rstart,&rend);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQSBAIJ,&isseqsbaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)M,MATMPISBAIJ,&ismpisbaij);CHKERRQ(ierr);
if (isseqsbaij || ismpisbaij) {ierr = MatSetOption(M,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);}
ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQBAIJ,&isseqbaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)M,MATMPIBAIJ,&ismpibaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)M,MATMPIDENSE,&ismpidense);CHKERRQ(ierr);
if (isseqdense) {
ierr = MatSeqDenseSetPreallocation(M,NULL);CHKERRQ(ierr);
} else if (ismpidense) {
ierr = MatMPIDenseSetPreallocation(M,NULL);CHKERRQ(ierr);
} else {
/* Preallocation block sizes. (S)BAIJ matrices will have one index per block. */
prbs = (isseqbaij || ismpibaij || isseqsbaij || ismpisbaij) ? M->rmap->bs : 1;
pcbs = (isseqbaij || ismpibaij || isseqsbaij || ismpisbaij) ? M->cmap->bs : 1;
ierr = PetscMalloc2(lm/prbs,&dnz,lm/prbs,&onz);CHKERRQ(ierr);
ierr = MatGetOwnershipRangeColumn(mat,&cstart,&cend);CHKERRQ(ierr);
for (i=0; i<lm; i+=prbs) {
ierr = MatGetRow(mat,rstart+i,&nz,&cwork,NULL);CHKERRQ(ierr);
dnz[i] = 0;
onz[i] = 0;
for (j=0; j<nz; j+=pcbs) {
if ((isseqsbaij || ismpisbaij) && cwork[j] < rstart+i) continue;
if (cstart <= cwork[j] && cwork[j] < cend) dnz[i]++;
else onz[i]++;
}
ierr = MatRestoreRow(mat,rstart+i,&nz,&cwork,NULL);CHKERRQ(ierr);
}
ierr = MatXAIJSetPreallocation(M,M->rmap->bs,dnz,onz,dnz,onz);CHKERRQ(ierr);
ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
}
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(mat,i,&nz,&cwork,&vwork);CHKERRQ(ierr);
ierr = MatSetValues(M,1,&i,nz,cwork,vwork,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(mat,i,&nz,&cwork,&vwork);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (reuse == MAT_REUSE_MATRIX) {
ierr = MatHeaderReplace(mat,M);CHKERRQ(ierr);
} else {
*newmat = M;
}
PetscFunctionReturn(0);
}
PetscErrorCode MatSetLocalToGlobalMapping_IS(Mat A,ISLocalToGlobalMapping rmapping,ISLocalToGlobalMapping cmapping)
{
PetscErrorCode ierr;
PetscInt nr,rbs,nc,cbs;
Mat_IS *is = (Mat_IS*)A->data;
IS from,to;
Vec cglobal,rglobal;
PetscFunctionBegin;
PetscCheckSameComm(A,1,rmapping,2);
PetscCheckSameComm(A,1,cmapping,3);
/* Destroy any previous data */
ierr = VecDestroy(&is->x);CHKERRQ(ierr);
ierr = VecDestroy(&is->y);CHKERRQ(ierr);
ierr = VecScatterDestroy(&is->rctx);CHKERRQ(ierr);
ierr = VecScatterDestroy(&is->cctx);CHKERRQ(ierr);
ierr = MatDestroy(&is->A);CHKERRQ(ierr);
ierr = PetscSFDestroy(&is->sf);CHKERRQ(ierr);
ierr = PetscFree2(is->sf_rootdata,is->sf_leafdata);CHKERRQ(ierr);
/* Setup Layout and set local to global maps */
ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
ierr = PetscLayoutSetISLocalToGlobalMapping(A->rmap,rmapping);CHKERRQ(ierr);
ierr = PetscLayoutSetISLocalToGlobalMapping(A->cmap,cmapping);CHKERRQ(ierr);
/* Create the local matrix A */
ierr = ISLocalToGlobalMappingGetSize(rmapping,&nr);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetBlockSize(rmapping,&rbs);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetSize(cmapping,&nc);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetBlockSize(cmapping,&cbs);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF,&is->A);CHKERRQ(ierr);
ierr = MatSetType(is->A,MATAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(is->A,nr,nc,nr,nc);CHKERRQ(ierr);
ierr = MatSetBlockSizes(is->A,rbs,cbs);CHKERRQ(ierr);
ierr = MatSetOptionsPrefix(is->A,((PetscObject)A)->prefix);CHKERRQ(ierr);
ierr = MatAppendOptionsPrefix(is->A,"is_");CHKERRQ(ierr);
ierr = MatSetFromOptions(is->A);CHKERRQ(ierr);
/* Create the local work vectors */
ierr = MatCreateVecs(is->A,&is->x,&is->y);CHKERRQ(ierr);
/* setup the global to local scatters */
ierr = MatCreateVecs(A,&cglobal,&rglobal);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,nr,0,1,&to);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingApplyIS(rmapping,to,&from);CHKERRQ(ierr);
ierr = VecScatterCreate(rglobal,from,is->y,to,&is->rctx);CHKERRQ(ierr);
if (rmapping != cmapping) {
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,nc,0,1,&to);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingApplyIS(cmapping,to,&from);CHKERRQ(ierr);
ierr = VecScatterCreate(cglobal,from,is->x,to,&is->cctx);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)is->rctx);CHKERRQ(ierr);
is->cctx = is->rctx;
}
ierr = VecDestroy(&rglobal);CHKERRQ(ierr);
ierr = VecDestroy(&cglobal);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCGAMGProlongator_GEO(PC pc,const Mat Amat,const Mat Gmat,PetscCoarsenData *agg_lists,Mat *a_P_out)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx;
const PetscInt verbose = pc_gamg->verbose;
const PetscInt dim = pc_gamg->data_cell_cols, data_cols = pc_gamg->data_cell_cols;
PetscErrorCode ierr;
PetscInt Istart,Iend,nloc,my0,jj,kk,ncols,nLocalSelected,bs,*clid_flid;
Mat Prol;
PetscMPIInt rank, size;
MPI_Comm comm;
IS selected_2,selected_1;
const PetscInt *selected_idx;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
#if defined PETSC_USE_LOG
ierr = PetscLogEventBegin(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs; my0 = Istart/bs;
if ((Iend-Istart) % bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(Iend %D - Istart %D) % bs %D",Iend,Istart,bs);
/* get 'nLocalSelected' */
ierr = PetscCDGetMIS(agg_lists, &selected_1);CHKERRQ(ierr);
ierr = ISGetSize(selected_1, &jj);CHKERRQ(ierr);
ierr = PetscMalloc1(jj, &clid_flid);CHKERRQ(ierr);
ierr = ISGetIndices(selected_1, &selected_idx);CHKERRQ(ierr);
for (kk=0,nLocalSelected=0; kk<jj; kk++) {
PetscInt lid = selected_idx[kk];
if (lid<nloc) {
ierr = MatGetRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr);
if (ncols>1) clid_flid[nLocalSelected++] = lid; /* fiter out singletons */
ierr = MatRestoreRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr);
}
}
ierr = ISRestoreIndices(selected_1, &selected_idx);CHKERRQ(ierr);
ierr = ISDestroy(&selected_1);CHKERRQ(ierr); /* this is selected_1 in serial */
/* create prolongator, create P matrix */
ierr = MatCreate(comm, &Prol);CHKERRQ(ierr);
ierr = MatSetSizes(Prol,nloc*bs,nLocalSelected*bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Prol, bs, bs);CHKERRQ(ierr);
ierr = MatSetType(Prol, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Prol,3*data_cols,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Prol,3*data_cols,NULL,3*data_cols,NULL);CHKERRQ(ierr);
/* ierr = MatCreateAIJ(comm, */
/* nloc*bs, nLocalSelected*bs, */
/* PETSC_DETERMINE, PETSC_DETERMINE, */
/* 3*data_cols, NULL, */
/* 3*data_cols, NULL, */
/* &Prol); */
/* CHKERRQ(ierr); */
/* can get all points "removed" - but not on geomg */
ierr = MatGetSize(Prol, &kk, &jj);CHKERRQ(ierr);
if (jj==0) {
if (verbose) PetscPrintf(comm,"[%d]%s ERROE: no selected points on coarse grid\n",rank,__FUNCT__);
ierr = PetscFree(clid_flid);CHKERRQ(ierr);
ierr = MatDestroy(&Prol);CHKERRQ(ierr);
*a_P_out = NULL; /* out */
PetscFunctionReturn(0);
}
{
PetscReal *coords;
PetscInt data_stride;
PetscInt *crsGID = NULL;
Mat Gmat2;
if (dim != data_cols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"dim %D != data_cols %D",dim,data_cols);
/* grow ghost data for better coarse grid cover of fine grid */
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr);
#endif
/* messy method, squares graph and gets some data */
ierr = getGIDsOnSquareGraph(nLocalSelected, clid_flid, Gmat, &selected_2, &Gmat2, &crsGID);CHKERRQ(ierr);
/* llist is now not valid wrt squared graph, but will work as iterator in 'triangulateAndFormProl' */
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr);
#endif
/* create global vector of coorindates in 'coords' */
if (size > 1) {
ierr = PCGAMGGetDataWithGhosts(Gmat2, dim, pc_gamg->data, &data_stride, &coords);CHKERRQ(ierr);
} else {
coords = (PetscReal*)pc_gamg->data;
data_stride = pc_gamg->data_sz/pc_gamg->data_cell_cols;
}
ierr = MatDestroy(&Gmat2);CHKERRQ(ierr);
/* triangulate */
if (dim == 2) {
PetscReal metric,tm;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr);
#endif
ierr = triangulateAndFormProl(selected_2, data_stride, coords,nLocalSelected, clid_flid, agg_lists, crsGID, bs, Prol, &metric);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr);
#endif
ierr = PetscFree(crsGID);CHKERRQ(ierr);
/* clean up and create coordinates for coarse grid (output) */
if (size > 1) ierr = PetscFree(coords);CHKERRQ(ierr);
ierr = MPI_Allreduce(&metric, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr);
if (tm > 1.) { /* needs to be globalized - should not happen */
if (verbose) PetscPrintf(comm,"[%d]%s failed metric for coarse grid %e\n",rank,__FUNCT__,tm);
ierr = MatDestroy(&Prol);CHKERRQ(ierr);
Prol = NULL;
} else if (metric > .0) {
if (verbose) PetscPrintf(comm,"[%d]%s worst metric for coarse grid = %e\n",rank,__FUNCT__,metric);
}
} else SETERRQ(comm,PETSC_ERR_PLIB,"3D not implemented for 'geo' AMG");
{ /* create next coords - output */
PetscReal *crs_crds;
ierr = PetscMalloc1(dim*nLocalSelected, &crs_crds);CHKERRQ(ierr);
for (kk=0; kk<nLocalSelected; kk++) { /* grab local select nodes to promote - output */
PetscInt lid = clid_flid[kk];
for (jj=0; jj<dim; jj++) crs_crds[jj*nLocalSelected + kk] = pc_gamg->data[jj*nloc + lid];
}
ierr = PetscFree(pc_gamg->data);CHKERRQ(ierr);
pc_gamg->data = crs_crds; /* out */
pc_gamg->data_sz = dim*nLocalSelected;
}
ierr = ISDestroy(&selected_2);CHKERRQ(ierr);
}
*a_P_out = Prol; /* out */
ierr = PetscFree(clid_flid);CHKERRQ(ierr);
#if defined PETSC_USE_LOG
ierr = PetscLogEventEnd(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
PetscErrorCode MatPtAPSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat P,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
Mat Cmpi;
Mat_PtAPMPI *ptap;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
Mat_MPIAIJ *a =(Mat_MPIAIJ*)A->data,*p=(Mat_MPIAIJ*)P->data,*c;
Mat_SeqAIJ *ad =(Mat_SeqAIJ*)(a->A)->data,*ao=(Mat_SeqAIJ*)(a->B)->data;
Mat_SeqAIJ *p_loc,*p_oth;
PetscInt *pi_loc,*pj_loc,*pi_oth,*pj_oth,*pdti,*pdtj,*poti,*potj,*ptJ;
PetscInt *adi=ad->i,*aj,*aoi=ao->i,nnz;
PetscInt *lnk,*owners_co,*coi,*coj,i,k,pnz,row;
PetscInt am=A->rmap->n,pN=P->cmap->N,pm=P->rmap->n,pn=P->cmap->n;
PetscBT lnkbt;
MPI_Comm comm;
PetscMPIInt size,rank,tagi,tagj,*len_si,*len_s,*len_ri,icompleted=0;
PetscInt **buf_rj,**buf_ri,**buf_ri_k;
PetscInt len,proc,*dnz,*onz,*owners;
PetscInt nzi,*pti,*ptj;
PetscInt nrows,*buf_s,*buf_si,*buf_si_i,**nextrow,**nextci;
MPI_Request *swaits,*rwaits;
MPI_Status *sstatus,rstatus;
Mat_Merge_SeqsToMPI *merge;
PetscInt *api,*apj,*Jptr,apnz,*prmap=p->garray,pon,nspacedouble=0,j,ap_rmax=0;
PetscReal afill=1.0,afill_tmp;
PetscInt rmax;
#if defined(PTAP_PROFILE)
PetscLogDouble t0,t1,t2,t3,t4;
#endif
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t0);CHKERRQ(ierr);
#endif
/* check if matrix local sizes are compatible */
if (A->rmap->rstart != P->rmap->rstart || A->rmap->rend != P->rmap->rend) {
SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Arow (%D, %D) != Prow (%D,%D)",A->rmap->rstart,A->rmap->rend,P->rmap->rstart,P->rmap->rend);
}
if (A->cmap->rstart != P->rmap->rstart || A->cmap->rend != P->rmap->rend) {
SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Acol (%D, %D) != Prow (%D,%D)",A->cmap->rstart,A->cmap->rend,P->rmap->rstart,P->rmap->rend);
}
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/* create struct Mat_PtAPMPI and attached it to C later */
ierr = PetscNew(&ptap);CHKERRQ(ierr);
ierr = PetscNew(&merge);CHKERRQ(ierr);
ptap->merge = merge;
ptap->reuse = MAT_INITIAL_MATRIX;
/* get P_oth by taking rows of P (= non-zero cols of local A) from other processors */
ierr = MatGetBrowsOfAoCols_MPIAIJ(A,P,MAT_INITIAL_MATRIX,&ptap->startsj_s,&ptap->startsj_r,&ptap->bufa,&ptap->P_oth);CHKERRQ(ierr);
/* get P_loc by taking all local rows of P */
ierr = MatMPIAIJGetLocalMat(P,MAT_INITIAL_MATRIX,&ptap->P_loc);CHKERRQ(ierr);
p_loc = (Mat_SeqAIJ*)(ptap->P_loc)->data;
p_oth = (Mat_SeqAIJ*)(ptap->P_oth)->data;
pi_loc = p_loc->i; pj_loc = p_loc->j;
pi_oth = p_oth->i; pj_oth = p_oth->j;
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t1);CHKERRQ(ierr);
#endif
/* first, compute symbolic AP = A_loc*P = A_diag*P_loc + A_off*P_oth */
/*-------------------------------------------------------------------*/
ierr = PetscMalloc1((am+1),&api);CHKERRQ(ierr);
api[0] = 0;
/* create and initialize a linked list */
ierr = PetscLLCondensedCreate(pN,pN,&lnk,&lnkbt);CHKERRQ(ierr);
/* Initial FreeSpace size is fill*(nnz(A) + nnz(P)) -OOM for ex56, np=8k on Intrepid! */
ierr = PetscFreeSpaceGet((PetscInt)(fill*(adi[am]+aoi[am]+pi_loc[pm])),&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<am; i++) {
/* diagonal portion of A */
nzi = adi[i+1] - adi[i];
aj = ad->j + adi[i];
for (j=0; j<nzi; j++) {
row = aj[j];
pnz = pi_loc[row+1] - pi_loc[row];
Jptr = pj_loc + pi_loc[row];
/* add non-zero cols of P into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
/* off-diagonal portion of A */
nzi = aoi[i+1] - aoi[i];
aj = ao->j + aoi[i];
for (j=0; j<nzi; j++) {
row = aj[j];
pnz = pi_oth[row+1] - pi_oth[row];
Jptr = pj_oth + pi_oth[row];
ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
apnz = lnk[0];
api[i+1] = api[i] + apnz;
if (ap_rmax < apnz) ap_rmax = apnz;
/* if free space is not available, double the total space in the list */
if (current_space->local_remaining<apnz) {
ierr = PetscFreeSpaceGet(apnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, then initialize lnk */
ierr = PetscLLCondensedClean(pN,apnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
current_space->array += apnz;
current_space->local_used += apnz;
current_space->local_remaining -= apnz;
}
/* Allocate space for apj, initialize apj, and */
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1((api[am]+1),&apj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,apj);CHKERRQ(ierr);
afill_tmp = (PetscReal)api[am]/(adi[am]+aoi[am]+pi_loc[pm]+1);
if (afill_tmp > afill) afill = afill_tmp;
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t2);CHKERRQ(ierr);
#endif
/* determine symbolic Co=(p->B)^T*AP - send to others */
/*----------------------------------------------------*/
ierr = MatGetSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr);
/* then, compute symbolic Co = (p->B)^T*AP */
pon = (p->B)->cmap->n; /* total num of rows to be sent to other processors
>= (num of nonzero rows of C_seq) - pn */
ierr = PetscMalloc1((pon+1),&coi);CHKERRQ(ierr);
coi[0] = 0;
/* set initial free space to be fill*(nnz(p->B) + nnz(AP)) */
nnz = fill*(poti[pon] + api[am]);
ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<pon; i++) {
pnz = poti[i+1] - poti[i];
ptJ = potj + poti[i];
for (j=0; j<pnz; j++) {
row = ptJ[j]; /* row of AP == col of Pot */
apnz = api[row+1] - api[row];
Jptr = apj + api[row];
/* add non-zero cols of AP into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
nnz = lnk[0];
/* If free space is not available, double the total space in the list */
if (current_space->local_remaining<nnz) {
ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, and zero out denserows */
ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
current_space->array += nnz;
current_space->local_used += nnz;
current_space->local_remaining -= nnz;
coi[i+1] = coi[i] + nnz;
}
ierr = PetscMalloc1((coi[pon]+1),&coj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,coj);CHKERRQ(ierr);
afill_tmp = (PetscReal)coi[pon]/(poti[pon] + api[am]+1);
if (afill_tmp > afill) afill = afill_tmp;
ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr);
/* send j-array (coj) of Co to other processors */
/*----------------------------------------------*/
/* determine row ownership */
ierr = PetscLayoutCreate(comm,&merge->rowmap);CHKERRQ(ierr);
merge->rowmap->n = pn;
merge->rowmap->bs = 1;
ierr = PetscLayoutSetUp(merge->rowmap);CHKERRQ(ierr);
owners = merge->rowmap->range;
/* determine the number of messages to send, their lengths */
ierr = PetscMalloc2(size,&len_si,size,&sstatus);CHKERRQ(ierr);
ierr = PetscMemzero(len_si,size*sizeof(PetscMPIInt));CHKERRQ(ierr);
ierr = PetscCalloc1(size,&merge->len_s);CHKERRQ(ierr);
len_s = merge->len_s;
merge->nsend = 0;
ierr = PetscMalloc1((size+2),&owners_co);CHKERRQ(ierr);
proc = 0;
for (i=0; i<pon; i++) {
while (prmap[i] >= owners[proc+1]) proc++;
len_si[proc]++; /* num of rows in Co to be sent to [proc] */
len_s[proc] += coi[i+1] - coi[i];
}
len = 0; /* max length of buf_si[] */
owners_co[0] = 0;
for (proc=0; proc<size; proc++) {
owners_co[proc+1] = owners_co[proc] + len_si[proc];
if (len_si[proc]) {
merge->nsend++;
len_si[proc] = 2*(len_si[proc] + 1);
len += len_si[proc];
}
}
/* determine the number and length of messages to receive for coi and coj */
ierr = PetscGatherNumberOfMessages(comm,NULL,len_s,&merge->nrecv);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths2(comm,merge->nsend,merge->nrecv,len_s,len_si,&merge->id_r,&merge->len_r,&len_ri);CHKERRQ(ierr);
/* post the Irecv and Isend of coj */
ierr = PetscCommGetNewTag(comm,&tagj);CHKERRQ(ierr);
ierr = PetscPostIrecvInt(comm,tagj,merge->nrecv,merge->id_r,merge->len_r,&buf_rj,&rwaits);CHKERRQ(ierr);
ierr = PetscMalloc1((merge->nsend+1),&swaits);CHKERRQ(ierr);
for (proc=0, k=0; proc<size; proc++) {
if (!len_s[proc]) continue;
i = owners_co[proc];
ierr = MPI_Isend(coj+coi[i],len_s[proc],MPIU_INT,proc,tagj,comm,swaits+k);CHKERRQ(ierr);
k++;
}
/* receives and sends of coj are complete */
for (i=0; i<merge->nrecv; i++) {
ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr);
}
ierr = PetscFree(rwaits);CHKERRQ(ierr);
if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);}
/* send and recv coi */
/*-------------------*/
ierr = PetscCommGetNewTag(comm,&tagi);CHKERRQ(ierr);
ierr = PetscPostIrecvInt(comm,tagi,merge->nrecv,merge->id_r,len_ri,&buf_ri,&rwaits);CHKERRQ(ierr);
ierr = PetscMalloc1((len+1),&buf_s);CHKERRQ(ierr);
buf_si = buf_s; /* points to the beginning of k-th msg to be sent */
for (proc=0,k=0; proc<size; proc++) {
if (!len_s[proc]) continue;
/* form outgoing message for i-structure:
buf_si[0]: nrows to be sent
[1:nrows]: row index (global)
[nrows+1:2*nrows+1]: i-structure index
*/
/*-------------------------------------------*/
nrows = len_si[proc]/2 - 1;
buf_si_i = buf_si + nrows+1;
buf_si[0] = nrows;
buf_si_i[0] = 0;
nrows = 0;
for (i=owners_co[proc]; i<owners_co[proc+1]; i++) {
nzi = coi[i+1] - coi[i];
buf_si_i[nrows+1] = buf_si_i[nrows] + nzi; /* i-structure */
buf_si[nrows+1] = prmap[i] -owners[proc]; /* local row index */
nrows++;
}
ierr = MPI_Isend(buf_si,len_si[proc],MPIU_INT,proc,tagi,comm,swaits+k);CHKERRQ(ierr);
k++;
buf_si += len_si[proc];
}
i = merge->nrecv;
while (i--) {
ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr);
}
ierr = PetscFree(rwaits);CHKERRQ(ierr);
if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);}
ierr = PetscFree2(len_si,sstatus);CHKERRQ(ierr);
ierr = PetscFree(len_ri);CHKERRQ(ierr);
ierr = PetscFree(swaits);CHKERRQ(ierr);
ierr = PetscFree(buf_s);CHKERRQ(ierr);
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t3);CHKERRQ(ierr);
#endif
/* compute the local portion of C (mpi mat) */
/*------------------------------------------*/
ierr = MatGetSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr);
/* allocate pti array and free space for accumulating nonzero column info */
ierr = PetscMalloc1((pn+1),&pti);CHKERRQ(ierr);
pti[0] = 0;
/* set initial free space to be fill*(nnz(P) + nnz(AP)) */
nnz = fill*(pi_loc[pm] + api[am]);
ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr);
current_space = free_space;
ierr = PetscMalloc3(merge->nrecv,&buf_ri_k,merge->nrecv,&nextrow,merge->nrecv,&nextci);CHKERRQ(ierr);
for (k=0; k<merge->nrecv; k++) {
buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
nrows = *buf_ri_k[k];
nextrow[k] = buf_ri_k[k] + 1; /* next row number of k-th recved i-structure */
nextci[k] = buf_ri_k[k] + (nrows + 1); /* poins to the next i-structure of k-th recved i-structure */
}
ierr = MatPreallocateInitialize(comm,pn,pn,dnz,onz);CHKERRQ(ierr);
rmax = 0;
for (i=0; i<pn; i++) {
/* add pdt[i,:]*AP into lnk */
pnz = pdti[i+1] - pdti[i];
ptJ = pdtj + pdti[i];
for (j=0; j<pnz; j++) {
row = ptJ[j]; /* row of AP == col of Pt */
apnz = api[row+1] - api[row];
Jptr = apj + api[row];
/* add non-zero cols of AP into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
/* add received col data into lnk */
for (k=0; k<merge->nrecv; k++) { /* k-th received message */
if (i == *nextrow[k]) { /* i-th row */
nzi = *(nextci[k]+1) - *nextci[k];
Jptr = buf_rj[k] + *nextci[k];
ierr = PetscLLCondensedAddSorted(nzi,Jptr,lnk,lnkbt);CHKERRQ(ierr);
nextrow[k]++; nextci[k]++;
}
}
nnz = lnk[0];
/* if free space is not available, make more free space */
if (current_space->local_remaining<nnz) {
ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* copy data into free space, then initialize lnk */
ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
ierr = MatPreallocateSet(i+owners[rank],nnz,current_space->array,dnz,onz);CHKERRQ(ierr);
current_space->array += nnz;
current_space->local_used += nnz;
current_space->local_remaining -= nnz;
pti[i+1] = pti[i] + nnz;
if (nnz > rmax) rmax = nnz;
}
ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr);
ierr = PetscFree3(buf_ri_k,nextrow,nextci);CHKERRQ(ierr);
ierr = PetscMalloc1((pti[pn]+1),&ptj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,ptj);CHKERRQ(ierr);
afill_tmp = (PetscReal)pti[pn]/(pi_loc[pm] + api[am]+1);
if (afill_tmp > afill) afill = afill_tmp;
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
/* create symbolic parallel matrix Cmpi */
/*--------------------------------------*/
ierr = MatCreate(comm,&Cmpi);CHKERRQ(ierr);
ierr = MatSetSizes(Cmpi,pn,pn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Cmpi,P->cmap->bs,P->cmap->bs);CHKERRQ(ierr);
ierr = MatSetType(Cmpi,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Cmpi,0,dnz,0,onz);CHKERRQ(ierr);
ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
merge->bi = pti; /* Cseq->i */
merge->bj = ptj; /* Cseq->j */
merge->coi = coi; /* Co->i */
merge->coj = coj; /* Co->j */
merge->buf_ri = buf_ri;
merge->buf_rj = buf_rj;
merge->owners_co = owners_co;
merge->destroy = Cmpi->ops->destroy;
merge->duplicate = Cmpi->ops->duplicate;
/* Cmpi is not ready for use - assembly will be done by MatPtAPNumeric() */
Cmpi->assembled = PETSC_FALSE;
Cmpi->ops->destroy = MatDestroy_MPIAIJ_PtAP;
Cmpi->ops->duplicate = MatDuplicate_MPIAIJ_MatPtAP;
/* attach the supporting struct to Cmpi for reuse */
c = (Mat_MPIAIJ*)Cmpi->data;
c->ptap = ptap;
ptap->api = api;
ptap->apj = apj;
ptap->rmax = ap_rmax;
*C = Cmpi;
/* flag 'scalable' determines which implementations to be used:
0: do dense axpy in MatPtAPNumeric() - fast, but requires storage of a nonscalable dense array apa;
1: do sparse axpy in MatPtAPNumeric() - might slow, uses a sparse array apa */
/* set default scalable */
ptap->scalable = PETSC_TRUE;
ierr = PetscOptionsGetBool(((PetscObject)Cmpi)->prefix,"-matptap_scalable",&ptap->scalable,NULL);CHKERRQ(ierr);
if (!ptap->scalable) { /* Do dense axpy */
ierr = PetscCalloc1(pN,&ptap->apa);CHKERRQ(ierr);
} else {
ierr = PetscCalloc1(ap_rmax+1,&ptap->apa);CHKERRQ(ierr);
}
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t4);CHKERRQ(ierr);
if (rank==1) PetscPrintf(MPI_COMM_SELF," [%d] PtAPSymbolic %g/P + %g/AP + %g/comm + %g/PtAP = %g\n",rank,t1-t0,t2-t1,t3-t2,t4-t3,t4-t0);CHKERRQ(ierr);
#endif
#if defined(PETSC_USE_INFO)
if (pti[pn] != 0) {
ierr = PetscInfo3(Cmpi,"Reallocs %D; Fill ratio: given %G needed %G.\n",nspacedouble,fill,afill);CHKERRQ(ierr);
ierr = PetscInfo1(Cmpi,"Use MatPtAP(A,P,MatReuse,%G,&C) for best performance.\n",afill);CHKERRQ(ierr);
} else {
ierr = PetscInfo(Cmpi,"Empty matrix product\n");CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
PetscErrorCode MatGetMultiProcBlock_MPIAIJ(Mat mat, MPI_Comm subComm, MatReuse scall,Mat *subMat)
{
PetscErrorCode ierr;
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)mat->data;
Mat_SeqAIJ *aijB = (Mat_SeqAIJ*)aij->B->data;
PetscMPIInt commRank,subCommSize,subCommRank;
PetscMPIInt *commRankMap,subRank,rank,commsize;
PetscInt *garrayCMap,col,i,j,*nnz,newRow,newCol;
PetscFunctionBegin;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&commsize);CHKERRQ(ierr);
ierr = MPI_Comm_size(subComm,&subCommSize);CHKERRQ(ierr);
/* create subMat object with the relavent layout */
if (scall == MAT_INITIAL_MATRIX) {
ierr = MatCreate(subComm,subMat);CHKERRQ(ierr);
ierr = MatSetType(*subMat,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(*subMat,mat->rmap->n,mat->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*subMat,mat->rmap->bs,mat->cmap->bs);CHKERRQ(ierr);
/* need to setup rmap and cmap before Preallocation */
ierr = PetscLayoutSetBlockSize((*subMat)->rmap,mat->rmap->bs);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize((*subMat)->cmap,mat->cmap->bs);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*subMat)->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*subMat)->cmap);CHKERRQ(ierr);
}
/* create a map of comm_rank from subComm to comm - should commRankMap and garrayCMap be kept for reused? */
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&commRank);CHKERRQ(ierr);
ierr = MPI_Comm_rank(subComm,&subCommRank);CHKERRQ(ierr);
ierr = PetscMalloc1(subCommSize,&commRankMap);CHKERRQ(ierr);
ierr = MPI_Allgather(&commRank,1,MPI_INT,commRankMap,1,MPI_INT,subComm);CHKERRQ(ierr);
/* Traverse garray and identify column indices [of offdiag mat] that
should be discarded. For the ones not discarded, store the newCol+1
value in garrayCMap */
ierr = PetscCalloc1(aij->B->cmap->n,&garrayCMap);CHKERRQ(ierr);
for (i=0; i<aij->B->cmap->n; i++) {
col = aij->garray[i];
for (subRank=0; subRank<subCommSize; subRank++) {
rank = commRankMap[subRank];
if ((col >= mat->cmap->range[rank]) && (col < mat->cmap->range[rank+1])) {
garrayCMap[i] = (*subMat)->cmap->range[subRank] + col - mat->cmap->range[rank]+1;
break;
}
}
}
if (scall == MAT_INITIAL_MATRIX) {
/* Now compute preallocation for the offdiag mat */
ierr = PetscCalloc1(aij->B->rmap->n,&nnz);CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n; i++) {
for (j=aijB->i[i]; j<aijB->i[i+1]; j++) {
if (garrayCMap[aijB->j[j]]) nnz[i]++;
}
}
ierr = MatMPIAIJSetPreallocation(*(subMat),0,NULL,0,nnz);CHKERRQ(ierr);
/* reuse diag block with the new submat */
ierr = MatDestroy(&((Mat_MPIAIJ*)((*subMat)->data))->A);CHKERRQ(ierr);
((Mat_MPIAIJ*)((*subMat)->data))->A = aij->A;
ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr);
} else if (((Mat_MPIAIJ*)(*subMat)->data)->A != aij->A) {
PetscObject obj = (PetscObject)((Mat_MPIAIJ*)((*subMat)->data))->A;
ierr = PetscObjectReference((PetscObject)obj);CHKERRQ(ierr);
((Mat_MPIAIJ*)((*subMat)->data))->A = aij->A;
ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr);
}
/* Now traverse aij->B and insert values into subMat */
for (i=0; i<aij->B->rmap->n; i++) {
newRow = (*subMat)->rmap->range[subCommRank] + i;
for (j=aijB->i[i]; j<aijB->i[i+1]; j++) {
newCol = garrayCMap[aijB->j[j]];
if (newCol) {
newCol--; /* remove the increment */
ierr = MatSetValues(*subMat,1,&newRow,1,&newCol,(aijB->a+j),INSERT_VALUES);CHKERRQ(ierr);
}
}
}
/* assemble the submat */
ierr = MatAssemblyBegin(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* deallocate temporary data */
ierr = PetscFree(commRankMap);CHKERRQ(ierr);
ierr = PetscFree(garrayCMap);CHKERRQ(ierr);
if (scall == MAT_INITIAL_MATRIX) {
ierr = PetscFree(nnz);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatRARtSymbolic_SeqAIJ_SeqAIJ_colorrart(Mat A,Mat R,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
Mat P;
PetscInt *rti,*rtj;
Mat_RARt *rart;
MatColoring coloring;
MatTransposeColoring matcoloring;
ISColoring iscoloring;
Mat Rt_dense,RARt_dense;
Mat_SeqAIJ *c;
PetscFunctionBegin;
/* create symbolic P=Rt */
ierr = MatGetSymbolicTranspose_SeqAIJ(R,&rti,&rtj);CHKERRQ(ierr);
ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,R->cmap->n,R->rmap->n,rti,rtj,NULL,&P);CHKERRQ(ierr);
/* get symbolic C=Pt*A*P */
ierr = MatPtAPSymbolic_SeqAIJ_SeqAIJ_SparseAxpy(A,P,fill,C);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*C,PetscAbs(R->rmap->bs),PetscAbs(R->rmap->bs));CHKERRQ(ierr);
(*C)->ops->rartnumeric = MatRARtNumeric_SeqAIJ_SeqAIJ_colorrart;
/* create a supporting struct */
ierr = PetscNew(&rart);CHKERRQ(ierr);
c = (Mat_SeqAIJ*)(*C)->data;
c->rart = rart;
/* ------ Use coloring ---------- */
/* inode causes memory problem, don't know why */
if (c->inode.use) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"MAT_USE_INODES is not supported. Use '-mat_no_inode'");
/* Create MatTransposeColoring from symbolic C=R*A*R^T */
ierr = MatColoringCreate(*C,&coloring);CHKERRQ(ierr);
ierr = MatColoringSetDistance(coloring,2);CHKERRQ(ierr);
ierr = MatColoringSetType(coloring,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(coloring);CHKERRQ(ierr);
ierr = MatColoringApply(coloring,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&coloring);CHKERRQ(ierr);
ierr = MatTransposeColoringCreate(*C,iscoloring,&matcoloring);CHKERRQ(ierr);
rart->matcoloring = matcoloring;
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
/* Create Rt_dense */
ierr = MatCreate(PETSC_COMM_SELF,&Rt_dense);CHKERRQ(ierr);
ierr = MatSetSizes(Rt_dense,A->cmap->n,matcoloring->ncolors,A->cmap->n,matcoloring->ncolors);CHKERRQ(ierr);
ierr = MatSetType(Rt_dense,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(Rt_dense,NULL);CHKERRQ(ierr);
Rt_dense->assembled = PETSC_TRUE;
rart->Rt = Rt_dense;
/* Create RARt_dense = R*A*Rt_dense */
ierr = MatCreate(PETSC_COMM_SELF,&RARt_dense);CHKERRQ(ierr);
ierr = MatSetSizes(RARt_dense,(*C)->rmap->n,matcoloring->ncolors,(*C)->rmap->n,matcoloring->ncolors);CHKERRQ(ierr);
ierr = MatSetType(RARt_dense,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(RARt_dense,NULL);CHKERRQ(ierr);
rart->RARt = RARt_dense;
/* Allocate work array to store columns of A*R^T used in MatMatMatMultNumeric_SeqAIJ_SeqAIJ_SeqDense() */
ierr = PetscMalloc1(A->rmap->n*4,&rart->work);CHKERRQ(ierr);
rart->destroy = (*C)->ops->destroy;
(*C)->ops->destroy = MatDestroy_SeqAIJ_RARt;
/* clean up */
ierr = MatRestoreSymbolicTranspose_SeqAIJ(R,&rti,&rtj);CHKERRQ(ierr);
ierr = MatDestroy(&P);CHKERRQ(ierr);
#if defined(PETSC_USE_INFO)
{
PetscReal density= (PetscReal)(c->nz)/(RARt_dense->rmap->n*RARt_dense->cmap->n);
ierr = PetscInfo(*C,"C=R*(A*Rt) via coloring C - use sparse-dense inner products\n");CHKERRQ(ierr);
ierr = PetscInfo6(*C,"RARt_den %D %D; Rt %D %D (RARt->nz %D)/(m*ncolors)=%g\n",RARt_dense->rmap->n,RARt_dense->cmap->n,R->cmap->n,R->rmap->n,c->nz,density);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
