PetscErrorCode VecDuplicate_Shared(Vec win,Vec *v)
{
PetscErrorCode ierr;
Vec_MPI *w = (Vec_MPI*)win->data;
PetscScalar *array;
PetscFunctionBegin;
/* first processor allocates entire array and sends it's address to the others */
ierr = PetscSharedMalloc(PetscObjectComm((PetscObject)win),win->map->n*sizeof(PetscScalar),win->map->N*sizeof(PetscScalar),(void**)&array);CHKERRQ(ierr);
ierr = VecCreate(PetscObjectComm((PetscObject)win),v);CHKERRQ(ierr);
ierr = VecSetSizes(*v,win->map->n,win->map->N);CHKERRQ(ierr);
ierr = VecCreate_MPI_Private(*v,PETSC_FALSE,w->nghost,array);CHKERRQ(ierr);
ierr = PetscLayoutReference(win->map,&(*v)->map);CHKERRQ(ierr);
/* New vector should inherit stashing property of parent */
(*v)->stash.donotstash = win->stash.donotstash;
(*v)->stash.ignorenegidx = win->stash.ignorenegidx;
ierr = PetscObjectListDuplicate(((PetscObject)win)->olist,&((PetscObject)*v)->olist);CHKERRQ(ierr);
ierr = PetscFunctionListDuplicate(((PetscObject)win)->qlist,&((PetscObject)*v)->qlist);CHKERRQ(ierr);
(*v)->ops->duplicate = VecDuplicate_Shared;
(*v)->bstash.bs = win->bstash.bs;
PetscFunctionReturn(0);
}
PetscErrorCode VecDuplicate_Seq(Vec win,Vec *V)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecCreate(PetscObjectComm((PetscObject)win),V);CHKERRQ(ierr);
ierr = VecSetSizes(*V,win->map->n,win->map->n);CHKERRQ(ierr);
ierr = VecSetType(*V,((PetscObject)win)->type_name);CHKERRQ(ierr);
ierr = PetscLayoutReference(win->map,&(*V)->map);CHKERRQ(ierr);
ierr = PetscObjectListDuplicate(((PetscObject)win)->olist,&((PetscObject)(*V))->olist);CHKERRQ(ierr);
ierr = PetscFunctionListDuplicate(((PetscObject)win)->qlist,&((PetscObject)(*V))->qlist);CHKERRQ(ierr);
(*V)->ops->view = win->ops->view;
(*V)->stash.ignorenegidx = win->stash.ignorenegidx;
PetscFunctionReturn(0);
}
static PetscErrorCode VecDuplicate_MPI(Vec win,Vec *v)
{
PetscErrorCode ierr;
Vec_MPI *vw,*w = (Vec_MPI*)win->data;
PetscScalar *array;
PetscFunctionBegin;
ierr = VecCreate(PetscObjectComm((PetscObject)win),v);CHKERRQ(ierr);
ierr = PetscLayoutReference(win->map,&(*v)->map);CHKERRQ(ierr);
ierr = VecCreate_MPI_Private(*v,PETSC_TRUE,w->nghost,0);CHKERRQ(ierr);
vw = (Vec_MPI*)(*v)->data;
ierr = PetscMemcpy((*v)->ops,win->ops,sizeof(struct _VecOps));CHKERRQ(ierr);
/* save local representation of the parallel vector (and scatter) if it exists */
if (w->localrep) {
ierr = VecGetArray(*v,&array);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,win->map->bs,win->map->n+w->nghost,array,&vw->localrep);CHKERRQ(ierr);
ierr = PetscMemcpy(vw->localrep->ops,w->localrep->ops,sizeof(struct _VecOps));CHKERRQ(ierr);
ierr = VecRestoreArray(*v,&array);CHKERRQ(ierr);
ierr = PetscLogObjectParent(*v,vw->localrep);CHKERRQ(ierr);
vw->localupdate = w->localupdate;
if (vw->localupdate) {
ierr = PetscObjectReference((PetscObject)vw->localupdate);CHKERRQ(ierr);
}
}
/* New vector should inherit stashing property of parent */
(*v)->stash.donotstash = win->stash.donotstash;
(*v)->stash.ignorenegidx = win->stash.ignorenegidx;
ierr = PetscObjectListDuplicate(((PetscObject)win)->olist,&((PetscObject)(*v))->olist);CHKERRQ(ierr);
ierr = PetscFunctionListDuplicate(((PetscObject)win)->qlist,&((PetscObject)(*v))->qlist);CHKERRQ(ierr);
(*v)->map->bs = win->map->bs;
(*v)->bstash.bs = win->bstash.bs;
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);
}
