PetscErrorCode private_PetscViewerDestroy_XDMF(PetscViewer *v)
{
PetscViewer viewer;
DM dm = NULL;
long int *bytes;
PetscContainer container = NULL;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!v) PetscFunctionReturn(0);
viewer = *v;
ierr = PetscObjectQuery((PetscObject)viewer,"DMSwarm",(PetscObject*)&dm);CHKERRQ(ierr);
if (dm) {
ierr = PetscViewerASCIIPrintf(viewer,"</Grid>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
/* close xdmf header */
ierr = PetscViewerASCIIPrintf(viewer,"</Domain>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</Xdmf>\n");CHKERRQ(ierr);
ierr = PetscObjectQuery((PetscObject)viewer,"XDMFViewerContext",(PetscObject*)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void**)&bytes);CHKERRQ(ierr);
ierr = PetscFree(bytes);CHKERRQ(ierr);
ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
*v = NULL;
PetscFunctionReturn(0);
}
/*
DMSetVI - Marks a DM as associated with a VI problem. This causes the interpolation/restriction operators to
be restricted to only those variables NOT associated with active constraints.
*/
PetscErrorCode DMSetVI(DM dm,IS inactive)
{
PetscErrorCode ierr;
PetscContainer isnes;
DM_SNESVI *dmsnesvi;
PetscFunctionBegin;
if (!dm) PetscFunctionReturn(0);
ierr = PetscObjectReference((PetscObject)inactive);CHKERRQ(ierr);
ierr = PetscObjectQuery((PetscObject)dm,"VI",(PetscObject *)&isnes);CHKERRQ(ierr);
if (!isnes) {
ierr = PetscContainerCreate(((PetscObject)dm)->comm,&isnes);CHKERRQ(ierr);
ierr = PetscContainerSetUserDestroy(isnes,(PetscErrorCode (*)(void*))DMDestroy_SNESVI);CHKERRQ(ierr);
ierr = PetscNew(DM_SNESVI,&dmsnesvi);CHKERRQ(ierr);
ierr = PetscContainerSetPointer(isnes,(void*)dmsnesvi);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"VI",(PetscObject)isnes);CHKERRQ(ierr);
ierr = PetscContainerDestroy(&isnes);CHKERRQ(ierr);
dmsnesvi->createinterpolation = dm->ops->createinterpolation;
dm->ops->createinterpolation = DMCreateInterpolation_SNESVI;
dmsnesvi->coarsen = dm->ops->coarsen;
dm->ops->coarsen = DMCoarsen_SNESVI;
dmsnesvi->createglobalvector = dm->ops->createglobalvector;
dm->ops->createglobalvector = DMCreateGlobalVector_SNESVI;
} else {
ierr = PetscContainerGetPointer(isnes,(void**)&dmsnesvi);CHKERRQ(ierr);
ierr = ISDestroy(&dmsnesvi->inactive);CHKERRQ(ierr);
}
ierr = DMClearGlobalVectors(dm);CHKERRQ(ierr);
ierr = ISGetLocalSize(inactive,&dmsnesvi->n);CHKERRQ(ierr);
dmsnesvi->inactive = inactive;
dmsnesvi->dm = dm;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscContainer container;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
ierr = PetscContainerDestroy(container);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode MatDestroy_MPIAIJ_MatMatMult(Mat A)
{
PetscErrorCode ierr;
PetscContainer container;
Mat_MatMatMultMPI *mult=PETSC_NULL;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)A,"Mat_MatMatMultMPI",(PetscObject *)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void **)&mult);CHKERRQ(ierr);
} else {
SETERRQ(PETSC_ERR_PLIB,"Container does not exit");
}
A->ops->destroy = mult->MatDestroy;
ierr = PetscObjectCompose((PetscObject)A,"Mat_MatMatMultMPI",0);CHKERRQ(ierr);
ierr = (*A->ops->destroy)(A);CHKERRQ(ierr);
ierr = PetscContainerDestroy(container);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
obj - the PETSc object where the scalar pointer came from
base - the Fortran array address
addr - the Fortran offset from base
N - the amount of data
lx - the array space that is to be passed to XXXXRestoreArray()
*/
PetscErrorCode PetscScalarAddressFromFortran(PetscObject obj,PetscScalar *base,size_t addr,PetscInt N,PetscScalar **lx)
{
PetscErrorCode ierr;
PetscInt shift;
PetscContainer container;
PetscScalar *tlx;
ierr = PetscObjectQuery(obj,"GetArrayPtr",(PetscObject *)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void**)lx);CHKERRQ(ierr);
tlx = base + addr;
shift = *(PetscInt*)*lx;
ierr = PetscMemcpy(*lx,tlx,N*sizeof(PetscScalar));CHKERRQ(ierr);
tlx = (PetscScalar*)(((char *)tlx) - shift);
ierr = PetscFree(tlx);CHKERRQ(ierr);
ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
ierr = PetscObjectCompose(obj,"GetArrayPtr",0);CHKERRQ(ierr);
} else {
*lx = base + addr;
}
return 0;
}
PetscErrorCode MatMatMultSymbolic_MPIAIJ_MPIDense(Mat A,Mat B,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
Mat_MPIAIJ *aij = (Mat_MPIAIJ*) A->data;
PetscInt nz = aij->B->cmap->n;
PetscContainer cont;
MPIAIJ_MPIDense *contents;
VecScatter ctx = aij->Mvctx;
VecScatter_MPI_General *from = (VecScatter_MPI_General*) ctx->fromdata;
VecScatter_MPI_General *to = ( VecScatter_MPI_General*) ctx->todata;
PetscInt m=A->rmap->n,n=B->cmap->n;
PetscFunctionBegin;
ierr = MatCreate(((PetscObject)B)->comm,C);CHKERRQ(ierr);
ierr = MatSetSizes(*C,m,n,A->rmap->N,B->cmap->N);CHKERRQ(ierr);
ierr = MatSetType(*C,MATMPIDENSE);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscContainerCreate(((PetscObject)A)->comm,&cont);CHKERRQ(ierr);
ierr = PetscNew(MPIAIJ_MPIDense,&contents);CHKERRQ(ierr);
ierr = PetscContainerSetPointer(cont,contents);CHKERRQ(ierr);
ierr = PetscContainerSetUserDestroy(cont,MPIAIJ_MPIDenseDestroy);CHKERRQ(ierr);
/* Create work matrix used to store off processor rows of B needed for local product */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,nz,B->cmap->N,PETSC_NULL,&contents->workB);CHKERRQ(ierr);
/* Create work arrays needed */
ierr = PetscMalloc4(B->cmap->N*from->starts[from->n],PetscScalar,&contents->rvalues,
B->cmap->N*to->starts[to->n],PetscScalar,&contents->svalues,
from->n,MPI_Request,&contents->rwaits,
to->n,MPI_Request,&contents->swaits);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*C),"workB",(PetscObject)cont);CHKERRQ(ierr);
ierr = PetscContainerDestroy(cont);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void
assemble_matrix(EquationSystems & es, const std::string & system_name)
{
EigenProblem * p = es.parameters.get<EigenProblem *>("_eigen_problem");
EigenSystem & eigen_system = es.get_system<EigenSystem>(system_name);
if (!p->isNonlinearEigenvalueSolver())
{
p->computeJacobian(
*eigen_system.current_local_solution.get(), *eigen_system.matrix_A, Moose::KT_NONEIGEN);
}
else
{
Mat petsc_mat_A = static_cast<PetscMatrix<Number> &>(*eigen_system.matrix_A).mat();
PetscObjectComposeFunction((PetscObject)petsc_mat_A,
"formJacobian",
Moose::SlepcSupport::mooseSlepcEigenFormJacobianA);
PetscObjectComposeFunction((PetscObject)petsc_mat_A,
"formFunction",
Moose::SlepcSupport::mooseSlepcEigenFormFunctionA);
PetscContainer container;
PetscContainerCreate(eigen_system.comm().get(), &container);
PetscContainerSetPointer(container, p);
PetscObjectCompose((PetscObject)petsc_mat_A, "formJacobianCtx", nullptr);
PetscObjectCompose((PetscObject)petsc_mat_A, "formJacobianCtx", (PetscObject)container);
PetscObjectCompose((PetscObject)petsc_mat_A, "formFunctionCtx", nullptr);
PetscObjectCompose((PetscObject)petsc_mat_A, "formFunctionCtx", (PetscObject)container);
PetscContainerDestroy(&container);
// Let libmesh do not close matrices before solve
eigen_system.eigen_solver->set_close_matrix_before_solve(false);
}
if (eigen_system.generalized())
{
if (eigen_system.matrix_B)
{
if (!p->isNonlinearEigenvalueSolver())
{
p->computeJacobian(
*eigen_system.current_local_solution.get(), *eigen_system.matrix_B, Moose::KT_EIGEN);
}
else
{
Mat petsc_mat_B = static_cast<PetscMatrix<Number> &>(*eigen_system.matrix_B).mat();
PetscObjectComposeFunction((PetscObject)petsc_mat_B,
"formJacobian",
Moose::SlepcSupport::mooseSlepcEigenFormJacobianB);
PetscObjectComposeFunction((PetscObject)petsc_mat_B,
"formFunction",
Moose::SlepcSupport::mooseSlepcEigenFormFunctionB);
PetscContainer container;
PetscContainerCreate(eigen_system.comm().get(), &container);
PetscContainerSetPointer(container, p);
PetscObjectCompose((PetscObject)petsc_mat_B, "formFunctionCtx", nullptr);
PetscObjectCompose((PetscObject)petsc_mat_B, "formFunctionCtx", (PetscObject)container);
PetscObjectCompose((PetscObject)petsc_mat_B, "formJacobianCtx", nullptr);
PetscObjectCompose((PetscObject)petsc_mat_B, "formJacobianCtx", (PetscObject)container);
PetscContainerDestroy(&container);
}
}
else
mooseError("It is a generalized eigenvalue problem but matrix B is empty\n");
}
}
PetscErrorCode MatRARtSymbolic_SeqAIJ_SeqAIJ(Mat A,Mat R,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
Mat P;
PetscInt *rti,*rtj;
Mat_RARt *rart;
PetscContainer container;
MatTransposeColoring matcoloring;
ISColoring iscoloring;
Mat Rt_dense,RARt_dense;
PetscLogDouble GColor=0.0,MCCreate=0.0,MDenCreate=0.0,t0,tf,etime=0.0;
Mat_SeqAIJ *c;
PetscFunctionBegin;
ierr = PetscGetTime(&t0);CHKERRQ(ierr);
/* 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,PETSC_NULL,&P);CHKERRQ(ierr);
/* get symbolic C=Pt*A*P */
ierr = MatPtAPSymbolic_SeqAIJ_SeqAIJ(A,P,fill,C);CHKERRQ(ierr);
(*C)->rmap->bs = R->rmap->bs;
(*C)->cmap->bs = R->rmap->bs;
/* create a supporting struct */
ierr = PetscNew(Mat_RARt,&rart);CHKERRQ(ierr);
/* attach the supporting struct to C */
ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
ierr = PetscContainerSetPointer(container,rart);CHKERRQ(ierr);
ierr = PetscContainerSetUserDestroy(container,PetscContainerDestroy_Mat_RARt);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*C),"Mat_RARt",(PetscObject)container);CHKERRQ(ierr);
ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
ierr = PetscGetTime(&tf);CHKERRQ(ierr);
etime += tf - t0;
/* Create MatTransposeColoring from symbolic C=R*A*R^T */
c=(Mat_SeqAIJ*)(*C)->data;
ierr = PetscGetTime(&t0);CHKERRQ(ierr);
ierr = MatGetColoring(*C,MATCOLORINGLF,&iscoloring);CHKERRQ(ierr);
ierr = PetscGetTime(&tf);CHKERRQ(ierr);
GColor += tf - t0;
ierr = PetscGetTime(&t0);CHKERRQ(ierr);
ierr = MatTransposeColoringCreate(*C,iscoloring,&matcoloring);CHKERRQ(ierr);
rart->matcoloring = matcoloring;
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = PetscGetTime(&tf);CHKERRQ(ierr);
MCCreate += tf - t0;
ierr = PetscGetTime(&t0);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,PETSC_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,PETSC_NULL);CHKERRQ(ierr);
rart->RARt = RARt_dense;
/* Allocate work array to store columns of A*R^T used in MatMatMatMultNumeric_SeqAIJ_SeqAIJ_SeqDense() */
ierr = PetscMalloc(A->rmap->n*4*sizeof(PetscScalar),&rart->work);CHKERRQ(ierr);
ierr = PetscGetTime(&tf);CHKERRQ(ierr);
MDenCreate += tf - t0;
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 = PetscInfo6(*C,"RARt_den %D %D; Rt_den %D %D, (RARt->nz %D)/(m*ncolors)=%g\n",RARt_dense->rmap->n,RARt_dense->cmap->n,Rt_dense->rmap->n,Rt_dense->cmap->n,c->nz,density);CHKERRQ(ierr);
ierr = PetscInfo5(*C,"Sym = GetColor %g + MColorCreate %g + MDenCreate %g + other %g = %g\n",GColor,MCCreate,MDenCreate,etime,GColor+MCCreate+MDenCreate+etime);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
