static PetscErrorCode DMTSConvertPlex(DM dm, DM *plex, PetscBool copy)
{
PetscBool isPlex;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr);
if (isPlex) {
*plex = dm;
ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
} else {
ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr);
if (!*plex) {
ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr);
if (copy) {
PetscInt i;
PetscObject obj;
const char *comps[3] = {"A","dmAux","dmCh"};
ierr = DMCopyDMTS(dm, *plex);CHKERRQ(ierr);
ierr = DMCopyDMSNES(dm, *plex);CHKERRQ(ierr);
for (i = 0; i < 3; i++) {
ierr = PetscObjectQuery((PetscObject) dm, comps[i], &obj);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) *plex, comps[i], obj);CHKERRQ(ierr);
}
}
} else {
ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode SetupMaterial(DM dm, DM dmAux, AppCtx *user)
{
void (*matFuncs[1])(const PetscReal x[], PetscScalar *u, void *ctx) = {nu_2d};
Vec nu;
PetscErrorCode ierr;
PetscFunctionBegin;
if (user->variableCoefficient != COEFF_FIELD) PetscFunctionReturn(0);
ierr = DMCreateLocalVector(dmAux, &nu);CHKERRQ(ierr);
ierr = DMPlexProjectFunctionLocal(dmAux, user->feAux, matFuncs, NULL, INSERT_ALL_VALUES, nu);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", (PetscObject) dmAux);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "A", (PetscObject) nu);CHKERRQ(ierr);
ierr = VecDestroy(&nu);CHKERRQ(ierr);
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);
}
/*@C
DMPlexTSGetGradientDM - Return gradient data layout
Input Parameters:
+ dm - The DM
- fv - The PetscFV
Output Parameter:
. dmGrad - The layout for gradient values
Level: developer
.seealso: DMPlexTSGetGeometryFVM(), DMPlexTSSetRHSFunctionLocal()
@*/
PetscErrorCode DMPlexTSGetGradientDM(DM dm, PetscFV fv, DM *dmGrad)
{
DMTS dmts;
PetscObject obj;
PetscBool computeGradients;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2);
PetscValidPointer(dmGrad,3);
ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr);
if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
ierr = DMGetDMTS(dm, &dmts);CHKERRQ(ierr);
ierr = PetscObjectQuery((PetscObject) dmts, "DMPlexTS_dmgrad_fvm", &obj);CHKERRQ(ierr);
if (!obj) {
DM dmGrad;
Vec faceGeometry, cellGeometry;
ierr = DMPlexTSGetGeometryFVM(dm, &faceGeometry, &cellGeometry, NULL);CHKERRQ(ierr);
ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometry, cellGeometry, &dmGrad);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dmts, "DMPlexTS_dmgrad_fvm", (PetscObject) dmGrad);CHKERRQ(ierr);
ierr = DMDestroy(&dmGrad);CHKERRQ(ierr);
}
ierr = PetscObjectQuery((PetscObject) dmts, "DMPlexTS_dmgrad_fvm", (PetscObject *) dmGrad);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode private_PetscViewerCreate_XDMF(MPI_Comm comm,const char filename[],PetscViewer *v)
{
long int *bytes;
PetscContainer container;
PetscViewer viewer;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscViewerCreate(comm,&viewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(viewer,FILE_MODE_WRITE);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(viewer,filename);CHKERRQ(ierr);
ierr = PetscMalloc1(1,&bytes);CHKERRQ(ierr);
bytes[0] = 0;
ierr = PetscContainerCreate(comm,&container);CHKERRQ(ierr);
ierr = PetscContainerSetPointer(container,(void*)bytes);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)viewer,"XDMFViewerContext",(PetscObject)container);CHKERRQ(ierr);
/* write xdmf header */
ierr = PetscViewerASCIIPrintf(viewer,"<?xml version=\"1.0\" encoding=\"utf-8\"?>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<Xdmf xmlns:xi=\"http://www.w3.org/2001/XInclude\" Version=\"2.99\">\n");CHKERRQ(ierr);
/* write xdmf domain */
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<Domain>\n");CHKERRQ(ierr);
*v = viewer;
PetscFunctionReturn(0);
}
static PetscErrorCode TestFieldProjection(DM dm, DM auxdm, DMLabel label, Vec la, const char name[], AppCtx *user)
{
PetscErrorCode (**afuncs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *);
void (**funcs)(PetscInt, PetscInt, PetscInt,
const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
Vec lx, lu;
PetscInt Nf, f;
PetscInt val[1] = {1};
char lname[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBeginUser;
if (auxdm) {
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", (PetscObject) auxdm);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "A", (PetscObject) la);CHKERRQ(ierr);
}
ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
ierr = PetscMalloc2(Nf, &funcs, Nf, &afuncs);CHKERRQ(ierr);
for (f = 0; f < Nf; ++f) afuncs[f] = linear;
funcs[0] = linear_vector;
funcs[1] = linear_scalar;
ierr = DMGetLocalVector(dm, &lu);CHKERRQ(ierr);
ierr = PetscStrcpy(lname, "Local Field Input ");CHKERRQ(ierr);
ierr = PetscStrcat(lname, name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) lu, lname);CHKERRQ(ierr);
if (!label) {ierr = DMProjectFunctionLocal(dm, 0.0, afuncs, NULL, INSERT_VALUES, lu);CHKERRQ(ierr);}
else {ierr = DMProjectFunctionLabelLocal(dm, 0.0, label, 1, val, 0, NULL, afuncs, NULL, INSERT_VALUES, lu);CHKERRQ(ierr);}
ierr = VecViewFromOptions(lu, NULL, "-local_input_view");CHKERRQ(ierr);
ierr = DMGetLocalVector(dm, &lx);CHKERRQ(ierr);
ierr = PetscStrcpy(lname, "Local Field ");CHKERRQ(ierr);
ierr = PetscStrcat(lname, name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) lx, lname);CHKERRQ(ierr);
if (!label) {ierr = DMProjectFieldLocal(dm, 0.0, lu, funcs, INSERT_VALUES, lx);CHKERRQ(ierr);}
else {ierr = DMProjectFieldLabelLocal(dm, 0.0, label, 1, val, 0, NULL, lu, funcs, INSERT_VALUES, lx);CHKERRQ(ierr);}
ierr = VecViewFromOptions(lx, NULL, "-local_field_view");CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &lx);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &lu);CHKERRQ(ierr);
ierr = PetscFree2(funcs, afuncs);CHKERRQ(ierr);
if (auxdm) {
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", NULL);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "A", NULL);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
MatColoring mc;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec,matcolor = PETSC_FALSE;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
if (!color) {ierr = PetscObjectQuery((PetscObject)B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
matcolor = PETSC_FALSE;
ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_fd_color_use_mat",&matcolor,NULL);CHKERRQ(ierr);
if (hascolor && !matcolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else {
ierr = MatColoringCreate(B,&mc);CHKERRQ(ierr);
ierr = MatColoringSetDistance(mc,2);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
Vec F;
ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,color,x1,snes);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
DMDestroyVI - Frees the DM_SNESVI object contained in the DM
- also resets the function pointers in the DM for createinterpolation() etc to use the original DM
*/
PetscErrorCode DMDestroyVI(DM dm)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!dm) PetscFunctionReturn(0);
ierr = PetscObjectCompose((PetscObject)dm,"VI",(PetscObject)PETSC_NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmlocalsnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (A != B) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode DMCoarsenHook_TSTheta(DM fine,DM coarse,void *ctx)
{
Vec X0,Xdot;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMCreateGlobalVector(coarse,&X0);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(coarse,&Xdot);CHKERRQ(ierr);
/* Oh noes, this would create a loop because the Vec holds a reference to the DM.
Making a PetscContainer to hold these Vecs would make the following call succeed, but would create a reference loop.
Need to decide on a way to break the reference counting loop.
*/
ierr = PetscObjectCompose((PetscObject)coarse,"TSTheta_X0",(PetscObject)X0);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)coarse,"TSTheta_Xdot",(PetscObject)Xdot);CHKERRQ(ierr);
ierr = VecDestroy(&X0);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MatFDColoringView_Draw(MatFDColoring fd,PetscViewer viewer)
{
PetscErrorCode ierr;
PetscBool isnull;
PetscDraw draw;
PetscReal xr,yr,xl,yl,h,w;
PetscFunctionBegin;
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0);
ierr = PetscObjectCompose((PetscObject)fd,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr);
xr = fd->N; yr = fd->M; h = yr/10.0; w = xr/10.0;
xr += w; yr += h; xl = -w; yl = -h;
ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr);
ierr = PetscDrawZoom(draw,MatFDColoringView_Draw_Zoom,fd);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)fd,"Zoomviewer",NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TestFunctionProjection(DM dm, DM auxdm, DMLabel label, Vec la, const char name[], AppCtx *user)
{
PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *);
Vec x, lx;
PetscInt Nf, f;
PetscInt val[1] = {1};
char lname[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBeginUser;
if (auxdm) {
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", (PetscObject) auxdm);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "A", (PetscObject) la);CHKERRQ(ierr);
}
ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
ierr = PetscMalloc1(Nf, &funcs);CHKERRQ(ierr);
for (f = 0; f < Nf; ++f) funcs[f] = linear;
ierr = DMGetGlobalVector(dm, &x);CHKERRQ(ierr);
ierr = PetscStrcpy(lname, "Function ");CHKERRQ(ierr);
ierr = PetscStrcat(lname, name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, lname);CHKERRQ(ierr);
if (!label) {ierr = DMProjectFunction(dm, 0.0, funcs, NULL, INSERT_VALUES, x);CHKERRQ(ierr);}
else {ierr = DMProjectFunctionLabel(dm, 0.0, label, 1, val, 0, NULL, funcs, NULL, INSERT_VALUES, x);CHKERRQ(ierr);}
ierr = VecViewFromOptions(x, NULL, "-func_view");CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(dm, &x);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm, &lx);CHKERRQ(ierr);
ierr = PetscStrcpy(lname, "Local Function ");CHKERRQ(ierr);
ierr = PetscStrcat(lname, name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) lx, lname);CHKERRQ(ierr);
if (!label) {ierr = DMProjectFunctionLocal(dm, 0.0, funcs, NULL, INSERT_VALUES, lx);CHKERRQ(ierr);}
else {ierr = DMProjectFunctionLabelLocal(dm, 0.0, label, 1, val, 0, NULL, funcs, NULL, INSERT_VALUES, lx);CHKERRQ(ierr);}
ierr = VecViewFromOptions(lx, NULL, "-local_func_view");CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &lx);CHKERRQ(ierr);
ierr = PetscFree(funcs);CHKERRQ(ierr);
if (auxdm) {
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", NULL);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "A", NULL);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode CreatePressureNullSpace(DM dm, AppCtx *user, MatNullSpace *nullSpace)
{
Vec vec, localVec;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = DMGetGlobalVector(dm, &vec);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm, &localVec);CHKERRQ(ierr);
ierr = VecSet(vec, 0.0);CHKERRQ(ierr);
/* Put a constant in for all pressures
Could change this to project the constant function onto the pressure space (when that is finished) */
{
PetscSection section;
PetscInt pStart, pEnd, p;
PetscScalar *a;
ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr);
ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
ierr = VecGetArray(localVec, &a);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt fDim, off, d;
ierr = PetscSectionGetFieldDof(section, p, 1, &fDim);CHKERRQ(ierr);
ierr = PetscSectionGetFieldOffset(section, p, 1, &off);CHKERRQ(ierr);
for (d = 0; d < fDim; ++d) a[off+d] = 1.0;
}
ierr = VecRestoreArray(localVec, &a);CHKERRQ(ierr);
}
ierr = DMLocalToGlobalBegin(dm, localVec, INSERT_VALUES, vec);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm, localVec, INSERT_VALUES, vec);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &localVec);CHKERRQ(ierr);
ierr = VecNormalize(vec, NULL);CHKERRQ(ierr);
if (user->debug) {
ierr = PetscPrintf(PetscObjectComm((PetscObject)dm), "Pressure Null Space\n");CHKERRQ(ierr);
ierr = VecView(vec, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)dm), PETSC_FALSE, 1, &vec, nullSpace);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(dm, &vec);CHKERRQ(ierr);
/* New style for field null spaces */
{
PetscObject pressure;
MatNullSpace nullSpacePres;
ierr = DMGetField(dm, 1, &pressure);CHKERRQ(ierr);
ierr = MatNullSpaceCreate(PetscObjectComm(pressure), PETSC_TRUE, 0, NULL, &nullSpacePres);CHKERRQ(ierr);
ierr = PetscObjectCompose(pressure, "nullspace", (PetscObject) nullSpacePres);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullSpacePres);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
PetscErrorCode (*func)(SNES,Vec,Vec,void*);
Vec F;
void *funcctx;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
else {ierr = PetscObjectQuery((PetscObject)*B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
*flag = SAME_NONZERO_PATTERN;
ierr = SNESGetFunction(snes,&F,&func,&funcctx);CHKERRQ(ierr);
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
if (hascolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
} else {
ierr = MatGetColoring(*B,MATCOLORINGSL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,(void*)funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)*B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(*B,color,x1,flag,snes);CHKERRQ(ierr);
if (*J != *B) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
DMPlexTSGetGeometryFVM - Return precomputed geometric data
Input Parameter:
. dm - The DM
Output Parameters:
+ facegeom - The values precomputed from face geometry
. cellgeom - The values precomputed from cell geometry
- minRadius - The minimum radius over the mesh of an inscribed sphere in a cell
Level: developer
.seealso: DMPlexTSSetRHSFunctionLocal()
@*/
PetscErrorCode DMPlexTSGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
{
DMTS dmts;
PetscObject obj;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
ierr = DMGetDMTS(dm, &dmts);CHKERRQ(ierr);
ierr = PetscObjectQuery((PetscObject) dmts, "DMPlexTS_facegeom_fvm", &obj);CHKERRQ(ierr);
if (!obj) {
Vec cellgeom, facegeom;
ierr = DMPlexComputeGeometryFVM(dm, &cellgeom, &facegeom);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dmts, "DMPlexTS_facegeom_fvm", (PetscObject) facegeom);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dmts, "DMPlexTS_cellgeom_fvm", (PetscObject) cellgeom);CHKERRQ(ierr);
ierr = VecDestroy(&facegeom);CHKERRQ(ierr);
ierr = VecDestroy(&cellgeom);CHKERRQ(ierr);
}
if (facegeom) {PetscValidPointer(facegeom, 2); ierr = PetscObjectQuery((PetscObject) dmts, "DMPlexTS_facegeom_fvm", (PetscObject *) facegeom);CHKERRQ(ierr);}
if (cellgeom) {PetscValidPointer(cellgeom, 3); ierr = PetscObjectQuery((PetscObject) dmts, "DMPlexTS_cellgeom_fvm", (PetscObject *) cellgeom);CHKERRQ(ierr);}
if (minRadius) {ierr = DMPlexGetMinRadius(dm, minRadius);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
PetscErrorCode ierr;
Mat A;
KSP ksp;
PC pc;
IS zero, one;
MatNullSpace nullsp;
Vec x, b;
MPI_Comm comm;
PetscInitialize(&argc, &argv, NULL, NULL);
comm = PETSC_COMM_WORLD;
ierr = MatCreate(comm, &A);CHKERRQ(ierr);
ierr = MatSetSizes(A, 4, 4, PETSC_DECIDE, PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A, &x, &b);CHKERRQ(ierr);
ierr = VecSet(x, 2.0);CHKERRQ(ierr);
ierr = VecSet(b, 12.0);CHKERRQ(ierr);
ierr = MatDiagonalSet(A, x, INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = ISCreateStride(comm, 2, 0, 1, &zero);CHKERRQ(ierr);
ierr = ISCreateStride(comm, 2, 2, 1, &one);CHKERRQ(ierr);
ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, &nullsp);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)zero, "nullspace",(PetscObject)nullsp);CHKERRQ(ierr);
ierr = KSPCreate(comm, &ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp, A, A);CHKERRQ(ierr);
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc, "0", zero);
ierr = PCFieldSplitSetIS(pc, "1", one);
ierr = KSPSolve(ksp, b, x);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullsp);CHKERRQ(ierr);
ierr = ISDestroy(&zero);CHKERRQ(ierr);
ierr = ISDestroy(&one);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
PetscErrorCode MatDestroy_SeqAIJ_RARt(Mat A)
{
PetscErrorCode ierr;
PetscContainer container;
Mat_RARt *rart=PETSC_NULL;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)A,"Mat_RARt",(PetscObject *)&container);CHKERRQ(ierr);
if (!container) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Container does not exit");
ierr = PetscContainerGetPointer(container,(void **)&rart);CHKERRQ(ierr);
A->ops->destroy = rart->destroy;
if (A->ops->destroy) {
ierr = (*A->ops->destroy)(A);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)A,"Mat_RARt",0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MyDMComputeFunction(DM dm,Vec x,Vec F)
{
PetscErrorCode ierr;
Mat J;
PetscFunctionBegin;
ierr = DMGetApplicationContext(dm,&J);CHKERRQ(ierr);
if (!J) {
ierr = DMCreateMatrix(dm,MATAIJ,&J);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)J,"DM",(PetscObject)PETSC_NULL);CHKERRQ(ierr);
ierr = FormMatrix(dm,J);CHKERRQ(ierr);
ierr = DMSetApplicationContext(dm,J);CHKERRQ(ierr);
ierr = DMSetApplicationContextDestroy(dm,(PetscErrorCode (*)(void**))MatDestroy);CHKERRQ(ierr);
}
ierr = MatMult(J,x,F);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
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);
}
PetscErrorCode MatMatMultSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat B,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
PetscInt start,end;
Mat_MatMatMultMPI *mult;
PetscContainer container;
PetscFunctionBegin;
if (A->cmap->rstart != B->rmap->rstart || A->cmap->rend != B->rmap->rend){
SETERRQ4(PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, (%D, %D) != (%D,%D)",A->cmap->rstart,A->cmap->rend,B->rmap->rstart,B->rmap->rend);
}
ierr = PetscNew(Mat_MatMatMultMPI,&mult);CHKERRQ(ierr);
/* create a seq matrix B_seq = submatrix of B by taking rows of B that equal to nonzero col of A */
ierr = MatGetBrowsOfAcols(A,B,MAT_INITIAL_MATRIX,&mult->isrowb,&mult->iscolb,&mult->brstart,&mult->B_seq);CHKERRQ(ierr);
/* create a seq matrix A_seq = submatrix of A by taking all local rows of A */
start = A->rmap->rstart; end = A->rmap->rend;
ierr = ISCreateStride(PETSC_COMM_SELF,end-start,start,1,&mult->isrowa);CHKERRQ(ierr);
ierr = MatGetLocalMatCondensed(A,MAT_INITIAL_MATRIX,&mult->isrowa,&mult->isrowb,&mult->A_loc);CHKERRQ(ierr);
/* compute C_seq = A_seq * B_seq */
ierr = MatMatMult_SeqAIJ_SeqAIJ(mult->A_loc,mult->B_seq,MAT_INITIAL_MATRIX,fill,&mult->C_seq);CHKERRQ(ierr);
/* create mpi matrix C by concatinating C_seq */
ierr = PetscObjectReference((PetscObject)mult->C_seq);CHKERRQ(ierr); /* prevent C_seq being destroyed by MatMerge() */
ierr = MatMerge(((PetscObject)A)->comm,mult->C_seq,B->cmap->n,MAT_INITIAL_MATRIX,C);CHKERRQ(ierr);
/* attach the supporting struct to C for reuse of symbolic C */
ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
ierr = PetscContainerSetPointer(container,mult);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*C),"Mat_MatMatMultMPI",(PetscObject)container);CHKERRQ(ierr);
ierr = PetscContainerSetUserDestroy(container,PetscContainerDestroy_Mat_MatMatMultMPI);CHKERRQ(ierr);
mult->MatDestroy = (*C)->ops->destroy;
mult->MatDuplicate = (*C)->ops->duplicate;
(*C)->ops->destroy = MatDestroy_MPIAIJ_MatMatMult;
(*C)->ops->duplicate = MatDuplicate_MPIAIJ_MatMatMult;
PetscFunctionReturn(0);
}
/*@
MatFDColoringCreate - Creates a matrix coloring context for finite difference
computation of Jacobians.
Collective on Mat
Input Parameters:
+ mat - the matrix containing the nonzero structure of the Jacobian
- iscoloring - the coloring of the matrix; usually obtained with MatColoringCreate() or DMCreateColoring()
Output Parameter:
. color - the new coloring context
Level: intermediate
.seealso: MatFDColoringDestroy(),SNESComputeJacobianDefaultColor(), ISColoringCreate(),
MatFDColoringSetFunction(), MatFDColoringSetFromOptions(), MatFDColoringApply(),
MatFDColoringView(), MatFDColoringSetParameters(), MatColoringCreate(), DMCreateColoring()
@*/
PetscErrorCode MatFDColoringCreate(Mat mat,ISColoring iscoloring,MatFDColoring *color)
{
MatFDColoring c;
MPI_Comm comm;
PetscErrorCode ierr;
PetscInt M,N;
PetscFunctionBegin;
PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
if (!mat->assembled) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"Matrix must be assembled by calls to MatAssemblyBegin/End();");
ierr = PetscLogEventBegin(MAT_FDColoringCreate,mat,0,0,0);CHKERRQ(ierr);
ierr = MatGetSize(mat,&M,&N);CHKERRQ(ierr);
if (M != N) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Only for square matrices");
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = PetscHeaderCreate(c,MAT_FDCOLORING_CLASSID,"MatFDColoring","Jacobian computation via finite differences with coloring","Mat",comm,MatFDColoringDestroy,MatFDColoringView);CHKERRQ(ierr);
c->ctype = iscoloring->ctype;
if (mat->ops->fdcoloringcreate) {
ierr = (*mat->ops->fdcoloringcreate)(mat,iscoloring,c);CHKERRQ(ierr);
} else SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Code not yet written for matrix type %s",((PetscObject)mat)->type_name);
ierr = MatCreateVecs(mat,NULL,&c->w1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)c,(PetscObject)c->w1);CHKERRQ(ierr);
ierr = VecDuplicate(c->w1,&c->w2);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)c,(PetscObject)c->w2);CHKERRQ(ierr);
c->error_rel = PETSC_SQRT_MACHINE_EPSILON;
c->umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
c->currentcolor = -1;
c->htype = "wp";
c->fset = PETSC_FALSE;
c->setupcalled = PETSC_FALSE;
*color = c;
ierr = PetscObjectCompose((PetscObject)mat,"SNESMatFDColoring",(PetscObject)c);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringCreate,mat,0,0,0);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);
}
int main(int argc,char **args)
{
Mat Amat;
PetscErrorCode ierr;
SNES snes;
KSP ksp;
MPI_Comm comm;
PetscMPIInt npe,rank;
PetscLogStage stage[7];
PetscBool test_nonzero_cols=PETSC_FALSE,use_nearnullspace=PETSC_TRUE;
Vec xx,bb;
PetscInt iter,i,N,dim=3,cells[3]={1,1,1},max_conv_its,local_sizes[7],run_type=1;
DM dm,distdm,basedm;
PetscBool flg;
char convType[256];
PetscReal Lx,mdisp[10],err[10];
const char * const options[10] = {"-ex56_dm_refine 0",
"-ex56_dm_refine 1",
"-ex56_dm_refine 2",
"-ex56_dm_refine 3",
"-ex56_dm_refine 4",
"-ex56_dm_refine 5",
"-ex56_dm_refine 6",
"-ex56_dm_refine 7",
"-ex56_dm_refine 8",
"-ex56_dm_refine 9"};
PetscFunctionBeginUser;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
comm = PETSC_COMM_WORLD;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &npe);CHKERRQ(ierr);
/* options */
ierr = PetscOptionsBegin(comm,NULL,"3D bilinear Q1 elasticity options","");CHKERRQ(ierr);
{
i = 3;
ierr = PetscOptionsIntArray("-cells", "Number of (flux tube) processor in each dimension", "ex56.c", cells, &i, NULL);CHKERRQ(ierr);
Lx = 1.; /* or ne for rod */
max_conv_its = 3;
ierr = PetscOptionsInt("-max_conv_its","Number of iterations in convergence study","",max_conv_its,&max_conv_its,NULL);CHKERRQ(ierr);
if (max_conv_its<=0 || max_conv_its>7) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_USER, "Bad number of iterations for convergence test (%D)",max_conv_its);
ierr = PetscOptionsReal("-lx","Length of domain","",Lx,&Lx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha","material coefficient inside circle","",s_soft_alpha,&s_soft_alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_nonzero_cols","nonzero test","",test_nonzero_cols,&test_nonzero_cols,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-use_mat_nearnullspace","MatNearNullSpace API test","",use_nearnullspace,&use_nearnullspace,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-run_type","0: twisting load on cantalever, 1: 3rd order accurate convergence test","",run_type,&run_type,NULL);CHKERRQ(ierr);
i = 3;
ierr = PetscOptionsInt("-mat_block_size","","",i,&i,&flg);CHKERRQ(ierr);
if (!flg || i!=3) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_USER, "'-mat_block_size 3' must be set (%D) and = 3 (%D)",flg,flg? i : 3);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Mesh Setup", &stage[6]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Setup", &stage[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Solve", &stage[1]);CHKERRQ(ierr);
/* create DM, Plex calls DMSetup */
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
ierr = DMPlexCreateHexBoxMesh(comm, dim, cells, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, &dm);CHKERRQ(ierr);
{
DMLabel label;
IS is;
ierr = DMCreateLabel(dm, "boundary");CHKERRQ(ierr);
ierr = DMGetLabel(dm, "boundary", &label);CHKERRQ(ierr);
ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
if (run_type==0) {
ierr = DMGetStratumIS(dm, "boundary", 1, &is);CHKERRQ(ierr);
ierr = DMCreateLabel(dm,"Faces");CHKERRQ(ierr);
if (is) {
PetscInt d, f, Nf;
const PetscInt *faces;
PetscInt csize;
PetscSection cs;
Vec coordinates ;
DM cdm;
ierr = ISGetLocalSize(is, &Nf);CHKERRQ(ierr);
ierr = ISGetIndices(is, &faces);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
ierr = DMGetDefaultSection(cdm, &cs);CHKERRQ(ierr);
/* Check for each boundary face if any component of its centroid is either 0.0 or 1.0 */
for (f = 0; f < Nf; ++f) {
PetscReal faceCoord;
PetscInt b,v;
PetscScalar *coords = NULL;
PetscInt Nv;
ierr = DMPlexVecGetClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
Nv = csize/dim; /* Calculate mean coordinate vector */
for (d = 0; d < dim; ++d) {
faceCoord = 0.0;
for (v = 0; v < Nv; ++v) faceCoord += PetscRealPart(coords[v*dim+d]);
faceCoord /= Nv;
for (b = 0; b < 2; ++b) {
if (PetscAbs(faceCoord - b) < PETSC_SMALL) { /* domain have not been set yet, still [0,1]^3 */
ierr = DMSetLabelValue(dm, "Faces", faces[f], d*2+b+1);CHKERRQ(ierr);
}
}
}
ierr = DMPlexVecRestoreClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is, &faces);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = DMGetLabel(dm, "Faces", &label);CHKERRQ(ierr);
ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
}
}
{
PetscInt dimEmbed, i;
PetscInt nCoords;
PetscScalar *coords,bounds[] = {0,Lx,-.5,.5,-.5,.5,}; /* x_min,x_max,y_min,y_max */
Vec coordinates;
if (run_type==1) {
for (i = 0; i < 2*dim; i++) bounds[i] = (i%2) ? 1 : 0;
}
ierr = DMGetCoordinatesLocal(dm,&coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDim(dm,&dimEmbed);CHKERRQ(ierr);
if (dimEmbed != dim) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"dimEmbed != dim %D",dimEmbed);CHKERRQ(ierr);
ierr = VecGetLocalSize(coordinates,&nCoords);CHKERRQ(ierr);
if (nCoords % dimEmbed) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Coordinate vector the wrong size");CHKERRQ(ierr);
ierr = VecGetArray(coordinates,&coords);CHKERRQ(ierr);
for (i = 0; i < nCoords; i += dimEmbed) {
PetscInt j;
PetscScalar *coord = &coords[i];
for (j = 0; j < dimEmbed; j++) {
coord[j] = bounds[2 * j] + coord[j] * (bounds[2 * j + 1] - bounds[2 * j]);
}
}
ierr = VecRestoreArray(coordinates,&coords);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(dm,coordinates);CHKERRQ(ierr);
}
/* convert to p4est, and distribute */
ierr = PetscOptionsBegin(comm, "", "Mesh conversion options", "DMPLEX");CHKERRQ(ierr);
ierr = PetscOptionsFList("-dm_type","Convert DMPlex to another format (should not be Plex!)","ex56.c",DMList,DMPLEX,convType,256,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
if (flg) {
DM newdm;
ierr = DMConvert(dm,convType,&newdm);CHKERRQ(ierr);
if (newdm) {
const char *prefix;
PetscBool isForest;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)newdm,prefix);CHKERRQ(ierr);
ierr = DMIsForest(newdm,&isForest);CHKERRQ(ierr);
if (isForest) {
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Converted to non Forest?");
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = newdm;
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Convert failed?");
} else {
/* Plex Distribute mesh over processes */
ierr = DMPlexDistribute(dm, 0, NULL, &distdm);CHKERRQ(ierr);
if (distdm) {
const char *prefix;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)distdm,prefix);CHKERRQ(ierr);
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = distdm;
}
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
basedm = dm; dm = NULL;
for (iter=0 ; iter<max_conv_its ; iter++) {
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
/* make new DM */
ierr = DMClone(basedm, &dm);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject) dm, "ex56_");CHKERRQ(ierr);
ierr = PetscObjectSetName( (PetscObject)dm,"Mesh");CHKERRQ(ierr);
ierr = PetscOptionsClearValue(NULL,"-ex56_dm_refine");CHKERRQ(ierr);
ierr = PetscOptionsInsertString(NULL,options[iter]);CHKERRQ(ierr);
ierr = DMSetFromOptions(dm);CHKERRQ(ierr); /* refinement done here in Plex, p4est */
/* snes */
ierr = SNESCreate(comm, &snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes, dm);CHKERRQ(ierr);
/* fem */
{
const PetscInt Ncomp = dim;
const PetscInt components[] = {0,1,2};
const PetscInt Nfid = 1, Npid = 1;
const PetscInt fid[] = {1}; /* The fixed faces (x=0) */
const PetscInt pid[] = {2}; /* The faces with loading (x=L_x) */
PetscFE fe;
PetscDS prob;
DM cdm = dm;
ierr = PetscFECreateDefault(dm, dim, dim, PETSC_FALSE, NULL, PETSC_DECIDE, &fe);CHKERRQ(ierr); /* elasticity */
ierr = PetscObjectSetName((PetscObject) fe, "deformation");CHKERRQ(ierr);
/* FEM prob */
ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
/* setup problem */
if (run_type==1) {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u_x4, f1_u_3d);CHKERRQ(ierr);
} else {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u, f1_u_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetBdResidual(prob, 0, f0_bd_u_3d, f1_bd_u);CHKERRQ(ierr);
}
/* bcs */
if (run_type==1) {
PetscInt id = 1;
ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", "boundary", 0, 0, NULL, (void (*)()) zero, 1, &id, NULL);CHKERRQ(ierr);
} else {
ierr = PetscDSAddBoundary(prob, DM_BC_ESSENTIAL, "fixed", "Faces", 0, Ncomp, components, (void (*)()) zero, Nfid, fid, NULL);CHKERRQ(ierr);
ierr = PetscDSAddBoundary(prob, DM_BC_NATURAL, "traction", "Faces", 0, Ncomp, components, NULL, Npid, pid, NULL);CHKERRQ(ierr);
}
while (cdm) {
ierr = DMSetDS(cdm,prob);CHKERRQ(ierr);
ierr = DMGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
}
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
}
/* vecs & mat */
ierr = DMCreateGlobalVector(dm,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx, &bb);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) bb, "b");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) xx, "u");CHKERRQ(ierr);
ierr = DMCreateMatrix(dm, &Amat);CHKERRQ(ierr);
ierr = VecGetSize(bb,&N);CHKERRQ(ierr);
local_sizes[iter] = N;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d global equations, %d vertices\n",rank,PETSC_FUNCTION_NAME,N,N/dim);CHKERRQ(ierr);
if (use_nearnullspace && N/dim > 1) {
/* Set up the near null space (a.k.a. rigid body modes) that will be used by the multigrid preconditioner */
DM subdm;
MatNullSpace nearNullSpace;
PetscInt fields = 0;
PetscObject deformation;
ierr = DMCreateSubDM(dm, 1, &fields, NULL, &subdm);CHKERRQ(ierr);
ierr = DMPlexCreateRigidBody(subdm, &nearNullSpace);CHKERRQ(ierr);
ierr = DMGetField(dm, 0, &deformation);CHKERRQ(ierr);
ierr = PetscObjectCompose(deformation, "nearnullspace", (PetscObject) nearNullSpace);CHKERRQ(ierr);
ierr = DMDestroy(&subdm);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nearNullSpace);CHKERRQ(ierr); /* created by DM and destroyed by Mat */
}
ierr = DMPlexSetSNESLocalFEM(dm,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, Amat, Amat, NULL, NULL);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = DMSetUp(dm);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stage[0]);CHKERRQ(ierr);
/* ksp */
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(ksp,PETSC_TRUE);CHKERRQ(ierr);
/* test BCs */
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
if (test_nonzero_cols) {
if (rank==0) ierr = VecSetValue(xx,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(xx);CHKERRQ(ierr);
ierr = VecAssemblyEnd(xx);CHKERRQ(ierr);
}
ierr = VecZeroEntries(bb);CHKERRQ(ierr);
ierr = VecGetSize(bb,&i);CHKERRQ(ierr);
local_sizes[iter] = i;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d equations in vector, %d vertices\n",rank,PETSC_FUNCTION_NAME,i,i/dim);CHKERRQ(ierr);
/* setup solver, dummy solve to really setup */
if (0) {
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,50);CHKERRQ(ierr);
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* solve */
ierr = PetscLogStagePush(stage[1]);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = VecNorm(xx,NORM_INFINITY,&mdisp[iter]);CHKERRQ(ierr);
ierr = DMViewFromOptions(dm, NULL, "-dm_view");CHKERRQ(ierr);
{
PetscViewer viewer = NULL;
PetscViewerFormat fmt;
ierr = PetscOptionsGetViewer(comm,"ex56_","-vec_view",&viewer,&fmt,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerPushFormat(viewer,fmt);CHKERRQ(ierr);
ierr = VecView(xx,viewer);CHKERRQ(ierr);
ierr = VecView(bb,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* Free work space */
ierr = DMDestroy(&dm);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&bb);CHKERRQ(ierr);
ierr = MatDestroy(&Amat);CHKERRQ(ierr);
}
ierr = DMDestroy(&basedm);CHKERRQ(ierr);
if (run_type==1) {
err[0] = 59.975208 - mdisp[0]; /* error with what I think is the exact solution */
} else {
err[0] = 171.038 - mdisp[0];
}
for (iter=1 ; iter<max_conv_its ; iter++) {
if (run_type==1) {
err[iter] = 59.975208 - mdisp[iter];
} else {
err[iter] = 171.038 - mdisp[iter];
}
PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %D) N=%12D, max displ=%9.7e, disp diff=%9.2e, error=%4.3e, rate=%3.2g\n",
rank,PETSC_FUNCTION_NAME,iter,local_sizes[iter],mdisp[iter],
mdisp[iter]-mdisp[iter-1],err[iter],log(err[iter-1]/err[iter])/log(2.));
}
ierr = PetscFinalize();
return ierr;
}
static PetscErrorCode MatPartitioningApply_Parmetis_Private(MatPartitioning part, PetscBool useND, IS *partitioning)
{
MatPartitioning_Parmetis *pmetis = (MatPartitioning_Parmetis*)part->data;
PetscErrorCode ierr;
PetscInt *locals = NULL;
Mat mat = part->adj,amat,pmat;
PetscBool flg;
PetscInt bs = 1;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIADJ,&flg);CHKERRQ(ierr);
if (flg) {
amat = mat;
ierr = PetscObjectReference((PetscObject)amat);CHKERRQ(ierr);
} else {
/* bs indicates if the converted matrix is "reduced" from the original and hence the
resulting partition results need to be stretched to match the original matrix */
ierr = MatConvert(mat,MATMPIADJ,MAT_INITIAL_MATRIX,&amat);CHKERRQ(ierr);
if (amat->rmap->n > 0) bs = mat->rmap->n/amat->rmap->n;
}
ierr = MatMPIAdjCreateNonemptySubcommMat(amat,&pmat);CHKERRQ(ierr);
ierr = MPI_Barrier(PetscObjectComm((PetscObject)part));CHKERRQ(ierr);
if (pmat) {
MPI_Comm pcomm,comm;
Mat_MPIAdj *adj = (Mat_MPIAdj*)pmat->data;
PetscInt *vtxdist = pmat->rmap->range;
PetscInt *xadj = adj->i;
PetscInt *adjncy = adj->j;
PetscInt *NDorder = NULL;
PetscInt itmp = 0,wgtflag=0, numflag=0, ncon=1, nparts=part->n, options[24], i, j;
real_t *tpwgts,*ubvec,itr=0.1;
int status;
ierr = PetscObjectGetComm((PetscObject)pmat,&pcomm);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
/* check that matrix has no diagonal entries */
{
PetscInt rstart;
ierr = MatGetOwnershipRange(pmat,&rstart,NULL);CHKERRQ(ierr);
for (i=0; i<pmat->rmap->n; i++) {
for (j=xadj[i]; j<xadj[i+1]; j++) {
if (adjncy[j] == i+rstart) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Row %d has diagonal entry; Parmetis forbids diagonal entry",i+rstart);
}
}
}
#endif
ierr = PetscMalloc1(pmat->rmap->n,&locals);CHKERRQ(ierr);
if (adj->values && !part->vertex_weights)
wgtflag = 1;
if (part->vertex_weights && !adj->values)
wgtflag = 2;
if (part->vertex_weights && adj->values)
wgtflag = 3;
if (PetscLogPrintInfo) {itmp = pmetis->printout; pmetis->printout = 127;}
ierr = PetscMalloc1(ncon*nparts,&tpwgts);CHKERRQ(ierr);
for (i=0; i<ncon; i++) {
for (j=0; j<nparts; j++) {
if (part->part_weights) {
tpwgts[i*nparts+j] = part->part_weights[i*nparts+j];
} else {
tpwgts[i*nparts+j] = 1./nparts;
}
}
}
ierr = PetscMalloc1(ncon,&ubvec);CHKERRQ(ierr);
for (i=0; i<ncon; i++) {
ubvec[i] = 1.05;
}
/* This sets the defaults */
options[0] = 0;
for (i=1; i<24; i++) {
options[i] = -1;
}
/* Duplicate the communicator to be sure that ParMETIS attribute caching does not interfere with PETSc. */
ierr = MPI_Comm_dup(pcomm,&comm);CHKERRQ(ierr);
if (useND) {
PetscInt *sizes, *seps, log2size, subd, *level;
PetscMPIInt size;
idx_t mtype = PARMETIS_MTYPE_GLOBAL, rtype = PARMETIS_SRTYPE_2PHASE, p_nseps = 1, s_nseps = 1;
real_t ubfrac = 1.05;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscMalloc1(pmat->rmap->n,&NDorder);CHKERRQ(ierr);
ierr = PetscMalloc3(2*size,&sizes,4*size,&seps,size,&level);CHKERRQ(ierr);
PetscStackCallParmetis(ParMETIS_V32_NodeND,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)&numflag,&mtype,&rtype,&p_nseps,&s_nseps,&ubfrac,NULL/* seed */,NULL/* dbglvl */,(idx_t*)NDorder,(idx_t*)(sizes),&comm));
log2size = PetscLog2Real(size);
subd = PetscPowInt(2,log2size);
ierr = MatPartitioningSizesToSep_Private(subd,sizes,seps,level);CHKERRQ(ierr);
for (i=0;i<pmat->rmap->n;i++) {
PetscInt loc;
ierr = PetscFindInt(NDorder[i],2*subd,seps,&loc);CHKERRQ(ierr);
if (loc < 0) {
loc = -(loc+1);
if (loc%2) { /* part of subdomain */
locals[i] = loc/2;
} else {
ierr = PetscFindInt(NDorder[i],2*(subd-1),seps+2*subd,&loc);CHKERRQ(ierr);
loc = loc < 0 ? -(loc+1)/2 : loc/2;
locals[i] = level[loc];
}
} else locals[i] = loc/2;
}
ierr = PetscFree3(sizes,seps,level);CHKERRQ(ierr);
} else {
if (pmetis->repartition) {
PetscStackCallParmetis(ParMETIS_V3_AdaptiveRepart,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)part->vertex_weights,(idx_t*)adj->values,(idx_t*)&wgtflag,(idx_t*)&numflag,(idx_t*)&ncon,(idx_t*)&nparts,tpwgts,ubvec,&itr,(idx_t*)options,(idx_t*)&pmetis->cuts,(idx_t*)locals,&comm));
} else {
PetscStackCallParmetis(ParMETIS_V3_PartKway,((idx_t*)vtxdist,(idx_t*)xadj,(idx_t*)adjncy,(idx_t*)part->vertex_weights,(idx_t*)adj->values,(idx_t*)&wgtflag,(idx_t*)&numflag,(idx_t*)&ncon,(idx_t*)&nparts,tpwgts,ubvec,(idx_t*)options,(idx_t*)&pmetis->cuts,(idx_t*)locals,&comm));
}
}
ierr = MPI_Comm_free(&comm);CHKERRQ(ierr);
ierr = PetscFree(tpwgts);CHKERRQ(ierr);
ierr = PetscFree(ubvec);CHKERRQ(ierr);
if (PetscLogPrintInfo) pmetis->printout = itmp;
if (bs > 1) {
PetscInt i,j,*newlocals;
ierr = PetscMalloc1(bs*pmat->rmap->n,&newlocals);CHKERRQ(ierr);
for (i=0; i<pmat->rmap->n; i++) {
for (j=0; j<bs; j++) {
newlocals[bs*i + j] = locals[i];
}
}
ierr = PetscFree(locals);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),bs*pmat->rmap->n,newlocals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),pmat->rmap->n,locals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr);
}
if (useND) {
IS ndis;
if (bs > 1) {
ierr = ISCreateBlock(PetscObjectComm((PetscObject)part),bs,pmat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),pmat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr);
}
ierr = ISSetPermutation(ndis);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*partitioning),"_petsc_matpartitioning_ndorder",(PetscObject)ndis);CHKERRQ(ierr);
ierr = ISDestroy(&ndis);CHKERRQ(ierr);
}
} else {
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),0,NULL,PETSC_COPY_VALUES,partitioning);CHKERRQ(ierr);
if (useND) {
IS ndis;
if (bs > 1) {
ierr = ISCreateBlock(PetscObjectComm((PetscObject)part),bs,0,NULL,PETSC_COPY_VALUES,&ndis);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)part),0,NULL,PETSC_COPY_VALUES,&ndis);CHKERRQ(ierr);
}
ierr = ISSetPermutation(ndis);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*partitioning),"_petsc_matpartitioning_ndorder",(PetscObject)ndis);CHKERRQ(ierr);
ierr = ISDestroy(&ndis);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&pmat);CHKERRQ(ierr);
ierr = MatDestroy(&amat);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* This assumes that the DM has been cloned prior to the call */
PetscErrorCode DMCreateSubDM_Section_Private(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
{
PetscSection section, sectionGlobal;
PetscInt *subIndices;
PetscInt subSize = 0, subOff = 0, nF, f, pStart, pEnd, p;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!numFields) PetscFunctionReturn(0);
ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr);
ierr = DMGetDefaultGlobalSection(dm, §ionGlobal);CHKERRQ(ierr);
if (!section) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting fields");
if (!sectionGlobal) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default global section for DM before splitting fields");
ierr = PetscSectionGetNumFields(section, &nF);CHKERRQ(ierr);
if (numFields > nF) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Number of requested fields %d greater than number of DM fields %d", numFields, nF);
if (is) {
ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt gdof;
ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
if (gdof > 0) {
for (f = 0; f < numFields; ++f) {
PetscInt fdof, fcdof;
ierr = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
subSize += fdof-fcdof;
}
}
}
ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt gdof, goff;
ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
if (gdof > 0) {
ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
PetscInt fdof, fcdof, fc, f2, poff = 0;
/* Can get rid of this loop by storing field information in the global section */
for (f2 = 0; f2 < fields[f]; ++f2) {
ierr = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
poff += fdof-fcdof;
}
ierr = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
subIndices[subOff] = goff+poff+fc;
}
}
}
}
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
}
if (subdm) {
PetscSection subsection;
PetscBool haveNull = PETSC_FALSE;
PetscInt f, nf = 0;
ierr = PetscSectionCreateSubsection(section, numFields, fields, &subsection);CHKERRQ(ierr);
ierr = DMSetDefaultSection(*subdm, subsection);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
(*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[fields[f]];
if ((*subdm)->nullspaceConstructors[f]) {
haveNull = PETSC_TRUE;
nf = f;
}
}
if (haveNull && is) {
MatNullSpace nullSpace;
ierr = (*(*subdm)->nullspaceConstructors[nf])(*subdm, nf, &nullSpace);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
}
if (dm->prob) {
PetscInt Nf;
ierr = PetscDSGetNumFields(dm->prob, &Nf);CHKERRQ(ierr);
if (nF != Nf) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "The number of DM fields %d does not match the number of Section fields %d", Nf, nF);
ierr = DMSetNumFields(*subdm, numFields);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
PetscObject disc;
ierr = DMGetField(dm, fields[f], &disc);CHKERRQ(ierr);
ierr = DMSetField(*subdm, f, disc);CHKERRQ(ierr);
}
if (numFields == 1 && is) {
PetscObject disc, space, pmat;
ierr = DMGetField(*subdm, 0, &disc);CHKERRQ(ierr);
ierr = PetscObjectQuery(disc, "nullspace", &space);CHKERRQ(ierr);
if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nullspace", space);CHKERRQ(ierr);}
ierr = PetscObjectQuery(disc, "nearnullspace", &space);CHKERRQ(ierr);
if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nearnullspace", space);CHKERRQ(ierr);}
ierr = PetscObjectQuery(disc, "pmat", &pmat);CHKERRQ(ierr);
if (pmat) {ierr = PetscObjectCompose((PetscObject) *is, "pmat", pmat);CHKERRQ(ierr);}
}
}
}
#if 0
/* We need a way to filter the original SF for given fields:
- Keeping the original section around it too much I think
- We could keep the distributed section, and subset it
*/
if (dm->sfNatural) {
PetscSF sfNatural;
ierr = PetscSectionCreateSubsection(dm->originalSection, numFields, fields, &(*subdm)->originalSection);CHKERRQ(ierr);
ierr = DMPlexCreateGlobalToNaturalPetscSF(*subdm, &sfNatural);CHKERRQ(ierr);
ierr = DMPlexSetGlobalToNaturalPetscSF(*subdm, sfNatural);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
/* This assumes that the DM has been cloned prior to the call */
PetscErrorCode DMCreateSubDM_Section_Private(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
{
PetscSection section, sectionGlobal;
PetscInt *subIndices;
PetscInt subSize = 0, subOff = 0, nF, f, pStart, pEnd, p;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!numFields) PetscFunctionReturn(0);
ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr);
ierr = DMGetDefaultGlobalSection(dm, §ionGlobal);CHKERRQ(ierr);
if (!section) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting fields");
if (!sectionGlobal) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default global section for DM before splitting fields");
ierr = PetscSectionGetNumFields(section, &nF);CHKERRQ(ierr);
if (numFields > nF) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Number of requested fields %d greater than number of DM fields %d", numFields, nF);
if (is) {
ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt gdof;
ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
if (gdof > 0) {
for (f = 0; f < numFields; ++f) {
PetscInt fdof, fcdof;
ierr = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
subSize += fdof-fcdof;
}
}
}
ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt gdof, goff;
ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
if (gdof > 0) {
ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
PetscInt fdof, fcdof, fc, f2, poff = 0;
/* Can get rid of this loop by storing field information in the global section */
for (f2 = 0; f2 < fields[f]; ++f2) {
ierr = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
poff += fdof-fcdof;
}
ierr = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
ierr = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
subIndices[subOff] = goff+poff+fc;
}
}
}
}
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
}
if (subdm) {
PetscSection subsection;
PetscBool haveNull = PETSC_FALSE;
PetscInt f, nf = 0;
ierr = PetscSectionCreateSubsection(section, numFields, fields, &subsection);CHKERRQ(ierr);
ierr = DMSetDefaultSection(*subdm, subsection);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
(*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[fields[f]];
if ((*subdm)->nullspaceConstructors[f]) {
haveNull = PETSC_TRUE;
nf = f;
}
}
if (haveNull) {
MatNullSpace nullSpace;
ierr = (*(*subdm)->nullspaceConstructors[nf])(*subdm, nf, &nullSpace);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
}
if (dm->fields) {
if (nF != dm->numFields) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "The number of DM fields %d does not match the number of Section fields %d", dm->numFields, nF);
ierr = DMSetNumFields(*subdm, numFields);CHKERRQ(ierr);
for (f = 0; f < numFields; ++f) {
ierr = PetscObjectListDuplicate(dm->fields[fields[f]]->olist, &(*subdm)->fields[f]->olist);CHKERRQ(ierr);
}
if (numFields == 1) {
MatNullSpace space;
Mat pmat;
ierr = PetscObjectQuery((*subdm)->fields[0], "nullspace", (PetscObject*) &space);CHKERRQ(ierr);
if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) space);CHKERRQ(ierr);}
ierr = PetscObjectQuery((*subdm)->fields[0], "nearnullspace", (PetscObject*) &space);CHKERRQ(ierr);
if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nearnullspace", (PetscObject) space);CHKERRQ(ierr);}
ierr = PetscObjectQuery((*subdm)->fields[0], "pmat", (PetscObject*) &pmat);CHKERRQ(ierr);
if (pmat) {ierr = PetscObjectCompose((PetscObject) *is, "pmat", (PetscObject) pmat);CHKERRQ(ierr);}
}
}
}
PetscFunctionReturn(0);
}
PetscErrorCode private_DMSwarmView_XDMF(DM dm,PetscViewer viewer)
{
PetscBool isswarm = PETSC_FALSE;
const char *viewername;
char datafile[PETSC_MAX_PATH_LEN];
PetscViewer fviewer;
PetscInt k,ng,dim;
Vec dvec;
long int *bytes = NULL;
PetscContainer container = NULL;
const char *dmname;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)viewer,"XDMFViewerContext",(PetscObject*)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void**)&bytes);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Valid to find attached data XDMFViewerContext");
ierr = PetscObjectTypeCompare((PetscObject)dm,DMSWARM,&isswarm);CHKERRQ(ierr);
if (!isswarm) SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Only valid for DMSwarm");
ierr = PetscObjectCompose((PetscObject)viewer,"DMSwarm",(PetscObject)dm);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscObjectGetName((PetscObject)dm,&dmname);CHKERRQ(ierr);
if (!dmname) {
ierr = DMGetOptionsPrefix(dm,&dmname);CHKERRQ(ierr);
}
if (!dmname) {
ierr = PetscViewerASCIIPrintf(viewer,"<Grid Name=\"DMSwarm\" GridType=\"Uniform\">\n");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"<Grid Name=\"DMSwarm[%s]\" GridType=\"Uniform\">\n",dmname);CHKERRQ(ierr);
}
/* create a sub-viewer for topology, geometry and all data fields */
/* name is viewer.name + "_swarm_fields.pbin" */
ierr = PetscViewerCreate(PetscObjectComm((PetscObject)viewer),&fviewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(fviewer,PETSCVIEWERBINARY);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipHeader(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipInfo(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(fviewer,FILE_MODE_WRITE);CHKERRQ(ierr);
ierr = PetscViewerFileGetName(viewer,&viewername);CHKERRQ(ierr);
ierr = private_CreateDataFileNameXDMF(viewername,datafile);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(fviewer,datafile);CHKERRQ(ierr);
ierr = DMSwarmGetSize(dm,&ng);CHKERRQ(ierr);
/* write topology header */
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<Topology Dimensions=\"%D\" TopologyType=\"Mixed\">\n",ng);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Int\" Dimensions=\"%D\" Seek=\"%D\">\n",ng*3,bytes[0]);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%s\n",datafile);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</DataItem>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</Topology>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
/* write topology data */
for (k=0; k<ng; k++) {
PetscInt pvertex[3];
pvertex[0] = 1;
pvertex[1] = 1;
pvertex[2] = k;
ierr = PetscViewerBinaryWrite(fviewer,pvertex,3,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
}
bytes[0] += sizeof(PetscInt) * ng * 3;
/* write geometry header */
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr);
switch (dim) {
case 1:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for 1D");
break;
case 2:
ierr = PetscViewerASCIIPrintf(viewer,"<Geometry Type=\"XY\">\n");CHKERRQ(ierr);
break;
case 3:
ierr = PetscViewerASCIIPrintf(viewer,"<Geometry Type=\"XYZ\">\n");CHKERRQ(ierr);
break;
}
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Float\" Precision=\"8\" Dimensions=\"%D %D\" Seek=\"%D\">\n",ng,dim,bytes[0]);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%s\n",datafile);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</DataItem>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</Geometry>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
/* write geometry data */
ierr = DMSwarmCreateGlobalVectorFromField(dm,DMSwarmPICField_coor,&dvec);CHKERRQ(ierr);
ierr = VecView(dvec,fviewer);CHKERRQ(ierr);
ierr = DMSwarmDestroyGlobalVectorFromField(dm,DMSwarmPICField_coor,&dvec);CHKERRQ(ierr);
bytes[0] += sizeof(PetscReal) * ng * dim;
ierr = PetscViewerDestroy(&fviewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MatPartitioningApply_PTScotch_Private(MatPartitioning part, PetscBool useND, IS *partitioning)
{
MPI_Comm pcomm,comm;
MatPartitioning_PTScotch *scotch = (MatPartitioning_PTScotch*)part->data;
PetscErrorCode ierr;
PetscMPIInt rank;
Mat mat = part->adj;
Mat_MPIAdj *adj = (Mat_MPIAdj*)mat->data;
PetscBool flg,distributed;
PetscBool proc_weight_flg;
PetscInt i,j,p,bs=1,nold;
PetscInt *NDorder = NULL;
PetscReal *vwgttab,deltval;
SCOTCH_Num *locals,*velotab,*veloloctab,*edloloctab,vertlocnbr,edgelocnbr,nparts=part->n;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)part,&pcomm);CHKERRQ(ierr);
/* Duplicate the communicator to be sure that PTSCOTCH attribute caching does not interfere with PETSc. */
ierr = MPI_Comm_dup(pcomm,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIADJ,&flg);CHKERRQ(ierr);
if (!flg) {
/* bs indicates if the converted matrix is "reduced" from the original and hence the
resulting partition results need to be stretched to match the original matrix */
nold = mat->rmap->n;
ierr = MatConvert(mat,MATMPIADJ,MAT_INITIAL_MATRIX,&mat);CHKERRQ(ierr);
if (mat->rmap->n > 0) bs = nold/mat->rmap->n;
adj = (Mat_MPIAdj*)mat->data;
}
proc_weight_flg = PETSC_TRUE;
ierr = PetscOptionsGetBool(NULL, NULL, "-mat_partitioning_ptscotch_proc_weight", &proc_weight_flg, NULL);CHKERRQ(ierr);
ierr = PetscMalloc1(mat->rmap->n+1,&locals);CHKERRQ(ierr);
if (useND) {
#if defined(PETSC_HAVE_SCOTCH_PARMETIS_V3_NODEND)
PetscInt *sizes, *seps, log2size, subd, *level, base = 0;
PetscMPIInt size;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
log2size = PetscLog2Real(size);
subd = PetscPowInt(2,log2size);
if (subd != size) SETERRQ(comm,PETSC_ERR_SUP,"Only power of 2 communicator sizes");
ierr = PetscMalloc1(mat->rmap->n,&NDorder);CHKERRQ(ierr);
ierr = PetscMalloc3(2*size,&sizes,4*size,&seps,size,&level);CHKERRQ(ierr);
SCOTCH_ParMETIS_V3_NodeND(mat->rmap->range,adj->i,adj->j,&base,NULL,NDorder,sizes,&comm);
ierr = MatPartitioningSizesToSep_Private(subd,sizes,seps,level);CHKERRQ(ierr);
for (i=0;i<mat->rmap->n;i++) {
PetscInt loc;
ierr = PetscFindInt(NDorder[i],2*subd,seps,&loc);CHKERRQ(ierr);
if (loc < 0) {
loc = -(loc+1);
if (loc%2) { /* part of subdomain */
locals[i] = loc/2;
} else {
ierr = PetscFindInt(NDorder[i],2*(subd-1),seps+2*subd,&loc);CHKERRQ(ierr);
loc = loc < 0 ? -(loc+1)/2 : loc/2;
locals[i] = level[loc];
}
} else locals[i] = loc/2;
}
ierr = PetscFree3(sizes,seps,level);CHKERRQ(ierr);
#else
SETERRQ(pcomm,PETSC_ERR_SUP,"Need libptscotchparmetis.a compiled with -DSCOTCH_METIS_PREFIX");
#endif
} else {
velotab = NULL;
if (proc_weight_flg) {
ierr = PetscMalloc1(nparts,&vwgttab);CHKERRQ(ierr);
ierr = PetscMalloc1(nparts,&velotab);CHKERRQ(ierr);
for (j=0; j<nparts; j++) {
if (part->part_weights) vwgttab[j] = part->part_weights[j]*nparts;
else vwgttab[j] = 1.0;
}
for (i=0; i<nparts; i++) {
deltval = PetscAbsReal(vwgttab[i]-PetscFloorReal(vwgttab[i]+0.5));
if (deltval>0.01) {
for (j=0; j<nparts; j++) vwgttab[j] /= deltval;
}
}
for (i=0; i<nparts; i++) velotab[i] = (SCOTCH_Num)(vwgttab[i] + 0.5);
ierr = PetscFree(vwgttab);CHKERRQ(ierr);
}
vertlocnbr = mat->rmap->range[rank+1] - mat->rmap->range[rank];
edgelocnbr = adj->i[vertlocnbr];
veloloctab = part->vertex_weights;
edloloctab = adj->values;
/* detect whether all vertices are located at the same process in original graph */
for (p = 0; !mat->rmap->range[p+1] && p < nparts; ++p);
distributed = (mat->rmap->range[p+1] == mat->rmap->N) ? PETSC_FALSE : PETSC_TRUE;
if (distributed) {
SCOTCH_Arch archdat;
SCOTCH_Dgraph grafdat;
SCOTCH_Dmapping mappdat;
SCOTCH_Strat stradat;
ierr = SCOTCH_dgraphInit(&grafdat,comm);CHKERRQ(ierr);
ierr = SCOTCH_dgraphBuild(&grafdat,0,vertlocnbr,vertlocnbr,adj->i,adj->i+1,veloloctab,
NULL,edgelocnbr,edgelocnbr,adj->j,NULL,edloloctab);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
ierr = SCOTCH_dgraphCheck(&grafdat);CHKERRQ(ierr);
#endif
ierr = SCOTCH_archInit(&archdat);CHKERRQ(ierr);
ierr = SCOTCH_stratInit(&stradat);CHKERRQ(ierr);
ierr = SCOTCH_stratDgraphMapBuild(&stradat,scotch->strategy,nparts,nparts,scotch->imbalance);CHKERRQ(ierr);
if (velotab) {
ierr = SCOTCH_archCmpltw(&archdat,nparts,velotab);CHKERRQ(ierr);
} else {
ierr = SCOTCH_archCmplt( &archdat,nparts);CHKERRQ(ierr);
}
ierr = SCOTCH_dgraphMapInit(&grafdat,&mappdat,&archdat,locals);CHKERRQ(ierr);
ierr = SCOTCH_dgraphMapCompute(&grafdat,&mappdat,&stradat);CHKERRQ(ierr);
SCOTCH_dgraphMapExit(&grafdat,&mappdat);
SCOTCH_archExit(&archdat);
SCOTCH_stratExit(&stradat);
SCOTCH_dgraphExit(&grafdat);
} else if (rank == p) {
SCOTCH_Graph grafdat;
SCOTCH_Strat stradat;
ierr = SCOTCH_graphInit(&grafdat);CHKERRQ(ierr);
ierr = SCOTCH_graphBuild(&grafdat,0,vertlocnbr,adj->i,adj->i+1,veloloctab,NULL,edgelocnbr,adj->j,edloloctab);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
ierr = SCOTCH_graphCheck(&grafdat);CHKERRQ(ierr);
#endif
ierr = SCOTCH_stratInit(&stradat);CHKERRQ(ierr);
ierr = SCOTCH_stratGraphMapBuild(&stradat,scotch->strategy,nparts,scotch->imbalance);CHKERRQ(ierr);
ierr = SCOTCH_graphPart(&grafdat,nparts,&stradat,locals);CHKERRQ(ierr);
SCOTCH_stratExit(&stradat);
SCOTCH_graphExit(&grafdat);
}
ierr = PetscFree(velotab);CHKERRQ(ierr);
}
ierr = MPI_Comm_free(&comm);CHKERRQ(ierr);
if (bs > 1) {
PetscInt *newlocals;
ierr = PetscMalloc1(bs*mat->rmap->n,&newlocals);CHKERRQ(ierr);
for (i=0;i<mat->rmap->n;i++) {
for (j=0;j<bs;j++) {
newlocals[bs*i+j] = locals[i];
}
}
ierr = PetscFree(locals);CHKERRQ(ierr);
ierr = ISCreateGeneral(pcomm,bs*mat->rmap->n,newlocals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(pcomm,mat->rmap->n,locals,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr);
}
if (useND) {
IS ndis;
if (bs > 1) {
ierr = ISCreateBlock(pcomm,bs,mat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(pcomm,mat->rmap->n,NDorder,PETSC_OWN_POINTER,&ndis);CHKERRQ(ierr);
}
ierr = ISSetPermutation(ndis);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)(*partitioning),"_petsc_matpartitioning_ndorder",(PetscObject)ndis);CHKERRQ(ierr);
ierr = ISDestroy(&ndis);CHKERRQ(ierr);
}
if (!flg) {
ierr = MatDestroy(&mat);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");
}
}
