PetscErrorCode DMLabelGetStratumSize(DMLabel label, PetscInt value, PetscInt *size)
{
PetscInt v;
PetscFunctionBegin;
PetscValidPointer(size, 3);
*size = 0;
for(v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) {
*size = label->stratumSizes[v];
break;
}
}
PetscFunctionReturn(0);
}
/*@C
DMPlexGetStratumSize - Get the number of points in a label stratum
Not Collective
Input Parameters:
+ dm - The DMPlex object
. name - The label name
- value - The stratum value
Output Parameter:
. size - The stratum size
Level: beginner
.keywords: mesh
.seealso: DMLabelGetStratumSize(), DMPlexGetLabelSize(), DMPlexGetLabelIds()
@*/
PetscErrorCode DMPlexGetStratumSize(DM dm, const char name[], PetscInt value, PetscInt *size)
{
DMLabel label;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
PetscValidCharPointer(name, 2);
PetscValidPointer(size, 4);
ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
*size = 0;
if (!label) PetscFunctionReturn(0);
ierr = DMLabelGetStratumSize(label, value, size);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DMCreateLocalVector_Redundant(DM dm,Vec *lvec)
{
PetscErrorCode ierr;
DM_Redundant *red = (DM_Redundant*)dm->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidPointer(lvec,2);
*lvec = 0;
ierr = VecCreate(PETSC_COMM_SELF,lvec);CHKERRQ(ierr);
ierr = VecSetSizes(*lvec,red->N,red->N);CHKERRQ(ierr);
ierr = VecSetType(*lvec,dm->vectype);CHKERRQ(ierr);
ierr = VecSetDM(*lvec,dm);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);
}
/*@C
DMPlexGetLabelIdIS - Get the integer ids in a label
Not Collective
Input Parameters:
+ mesh - The DMPlex object
- name - The label name
Output Parameter:
. ids - The integer ids, or PETSC_NULL if the label does not exist
Level: beginner
.keywords: mesh
.seealso: DMLabelGetValueIS(), DMPlexGetLabelSize()
@*/
PetscErrorCode DMPlexGetLabelIdIS(DM dm, const char name[], IS *ids)
{
DMLabel label;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
PetscValidCharPointer(name, 2);
PetscValidPointer(ids, 3);
ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
*ids = PETSC_NULL;
if (!label) PetscFunctionReturn(0);
ierr = DMLabelGetValueIS(label, ids);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
#undef __FUNCT__
#define __FUNCT__ "DMSlicedCreate"
/*@C
DMSlicedCreate - Creates a DM object, used to manage data for a unstructured problem
Collective on MPI_Comm
Input Parameter:
+ comm - the processors that will share the global vector
. bs - the block size
. nlocal - number of vector entries on this process
. Nghosts - number of ghost points needed on this process
. ghosts - global indices of all ghost points for this process
. d_nnz - matrix preallocation information representing coupling within this process
- o_nnz - matrix preallocation information representing coupling between this process and other processes
Output Parameters:
. slice - the slice object
Notes:
This DM does not support DMCreateLocalVector(), DMGlobalToLocalBegin(), and DMGlobalToLocalEnd() instead one directly uses
VecGhostGetLocalForm() and VecGhostRestoreLocalForm() to access the local representation and VecGhostUpdateBegin() and VecGhostUpdateEnd() to update
the ghost points.
One can use DMGlobalToLocalBegin(), and DMGlobalToLocalEnd() instead of VecGhostUpdateBegin() and VecGhostUpdateEnd().
Level: advanced
.seealso DMDestroy(), DMCreateGlobalVector(), DMSetType(), DMSLICED, DMSlicedSetGhosts(), DMSlicedSetPreallocation(), VecGhostUpdateBegin(), VecGhostUpdateEnd(),
VecGhostGetLocalForm(), VecGhostRestoreLocalForm()
@*/
PetscErrorCode DMSlicedCreate(MPI_Comm comm,PetscInt bs,PetscInt nlocal,PetscInt Nghosts,const PetscInt ghosts[], const PetscInt d_nnz[],const PetscInt o_nnz[],DM *dm)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(dm,2);
ierr = DMCreate(comm,dm);CHKERRQ(ierr);
ierr = DMSetType(*dm,DMSLICED);CHKERRQ(ierr);
ierr = DMSlicedSetGhosts(*dm,bs,nlocal,Nghosts,ghosts);CHKERRQ(ierr);
if (d_nnz) {
ierr = DMSlicedSetPreallocation(*dm,0, d_nnz,0,o_nnz);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
TSAdaptChoose - choose which method and step size to use for the next step
Logically Collective
Input Arguments:
+ adapt - adaptive contoller
- h - current step size
Output Arguments:
+ next_sc - optional, scheme to use for the next step
. next_h - step size to use for the next step
- accept - PETSC_TRUE to accept the current step, PETSC_FALSE to repeat the current step with the new step size
Note:
The input value of parameter accept is retained from the last time step, so it will be PETSC_FALSE if the step is
being retried after an initial rejection.
Level: developer
.seealso: TSAdapt, TSAdaptCandidatesClear(), TSAdaptCandidateAdd()
@*/
PetscErrorCode TSAdaptChoose(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept)
{
PetscErrorCode ierr;
PetscInt ncandidates = adapt->candidates.n;
PetscInt scheme = 0;
PetscReal wlte = -1.0;
PetscFunctionBegin;
PetscValidHeaderSpecific(adapt,TSADAPT_CLASSID,1);
PetscValidHeaderSpecific(ts,TS_CLASSID,2);
if (next_sc) PetscValidIntPointer(next_sc,4);
PetscValidPointer(next_h,5);
PetscValidIntPointer(accept,6);
if (next_sc) *next_sc = 0;
/* Do not mess with adaptivity while handling events*/
if (ts->event && ts->event->status != TSEVENT_NONE) {
*next_h = h;
*accept = PETSC_TRUE;
PetscFunctionReturn(0);
}
ierr = (*adapt->ops->choose)(adapt,ts,h,&scheme,next_h,accept,&wlte);CHKERRQ(ierr);
if (scheme < 0 || (ncandidates > 0 && scheme >= ncandidates)) SETERRQ2(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_OUTOFRANGE,"Chosen scheme %D not in valid range 0..%D",scheme,ncandidates-1);
if (*next_h < 0) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_OUTOFRANGE,"Computed step size %g must be positive",(double)*next_h);
if (next_sc) *next_sc = scheme;
if (*accept && ts->exact_final_time == TS_EXACTFINALTIME_MATCHSTEP) {
/* Reduce time step if it overshoots max time */
if (ts->ptime + ts->time_step + *next_h >= ts->max_time) {
PetscReal next_dt = ts->max_time - (ts->ptime + ts->time_step);
if (next_dt > PETSC_SMALL) *next_h = next_dt;
else ts->reason = TS_CONVERGED_TIME;
}
}
if (adapt->monitor) {
const char *sc_name = (scheme < ncandidates) ? adapt->candidates.name[scheme] : "";
ierr = PetscViewerASCIIAddTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
if (wlte < 0) {
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt '%s': step %3D %s t=%-11g+%10.3e family='%s' scheme=%D:'%s' dt=%-10.3e\n",((PetscObject)adapt)->type_name,ts->steps,*accept ? "accepted" : "rejected",(double)ts->ptime,(double)h,((PetscObject)ts)->type_name,scheme,sc_name,(double)*next_h);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt '%s': step %3D %s t=%-11g+%10.3e wlte=%5.3g family='%s' scheme=%D:'%s' dt=%-10.3e\n",((PetscObject)adapt)->type_name,ts->steps,*accept ? "accepted" : "rejected",(double)ts->ptime,(double)h,(double)wlte,((PetscObject)ts)->type_name,scheme,sc_name,(double)*next_h);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
PetscObjectTypeCompare - Determines whether a PETSc object is of a particular type.
Not Collective
Input Parameters:
+ obj - any PETSc object, for example a Vec, Mat or KSP.
This must be cast with a (PetscObject), for example,
PetscObjectTypeCompare((PetscObject)mat);
- type_name - string containing a type name
Output Parameter:
. same - PETSC_TRUE if they are the same, else PETSC_FALSE
Level: intermediate
.seealso: VecGetType(), KSPGetType(), PCGetType(), SNESGetType()
Concepts: comparing^object types
Concepts: types^comparing
Concepts: object type^comparpeing
@*/
PetscErrorCode PetscObjectTypeCompare(PetscObject obj,const char type_name[],PetscBool *same)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!obj) *same = PETSC_FALSE;
else if (!type_name && !obj->type_name) *same = PETSC_TRUE;
else if (!type_name || !obj->type_name) *same = PETSC_FALSE;
else {
PetscValidHeader(obj,1);
PetscValidCharPointer(type_name,2);
PetscValidPointer(same,3);
ierr = PetscStrcmp((char*)(obj->type_name),type_name,same);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
DMPlexGetNumLabels - Return the number of labels defined by the mesh
Not Collective
Input Parameter:
. dm - The DMPlex object
Output Parameter:
. numLabels - the number of Labels
Level: intermediate
.keywords: mesh
.seealso: DMPlexGetLabelValue(), DMPlexSetLabelValue(), DMPlexGetStratumIS()
@*/
PetscErrorCode DMPlexGetNumLabels(DM dm, PetscInt *numLabels)
{
DM_Plex *mesh = (DM_Plex *) dm->data;
DMLabel next = mesh->labels;
PetscInt n = 0;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
PetscValidPointer(numLabels, 2);
while(next) {
++n;
next = next->next;
}
*numLabels = n;
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelGetStratumIS(DMLabel label, PetscInt value, IS *points)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(points, 3);
*points = PETSC_NULL;
for(v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) {
ierr = ISCreateGeneral(PETSC_COMM_SELF, label->stratumSizes[v], &label->points[label->stratumOffsets[v]], PETSC_COPY_VALUES, points);CHKERRQ(ierr);
break;
}
}
PetscFunctionReturn(0);
}
/*@
ISRestoreNonlocalIS - Restore the IS obtained with ISGetNonlocalIS().
Not collective.
Input Parameter:
+ is - the index set
- complement - index set of is's nonlocal indices
Level: intermediate
Concepts: index sets^getting nonlocal indices
Concepts: index sets^restoring nonlocal indices
.seealso: ISGetNonlocalIS(), ISGetNonlocalIndices(), ISRestoreNonlocalIndices()
@*/
PetscErrorCode ISRestoreNonlocalIS(IS is, IS *complement)
{
PetscErrorCode ierr;
PetscInt refcnt;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(complement,2);
if (*complement != is->complement) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Complement IS being restored was not obtained with ISGetNonlocalIS()");
ierr = PetscObjectGetReference((PetscObject)(is->complement), &refcnt);
CHKERRQ(ierr);
if (refcnt <= 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Duplicate call to ISRestoreNonlocalIS() detected");
ierr = PetscObjectDereference((PetscObject)(is->complement));
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
EPSGetRG - Obtain the region object associated to the eigensolver.
Not Collective
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
Output Parameter:
. rg - region context
Level: advanced
.seealso: EPSSetRG()
@*/
PetscErrorCode EPSGetRG(EPS eps,RG *rg)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
PetscValidPointer(rg,2);
if (!eps->rg) {
ierr = RGCreate(PetscObjectComm((PetscObject)eps),&eps->rg);
CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)eps->rg);
CHKERRQ(ierr);
}
*rg = eps->rg;
PetscFunctionReturn(0);
}
/*@C
RGCreate - Creates an RG context.
Collective on MPI_Comm
Input Parameter:
. comm - MPI communicator
Output Parameter:
. newrg - location to put the RG context
Level: beginner
.seealso: RGDestroy(), RG
@*/
PetscErrorCode RGCreate(MPI_Comm comm,RG *newrg)
{
RG rg;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(newrg,2);
*newrg = 0;
ierr = RGInitializePackage();CHKERRQ(ierr);
ierr = SlepcHeaderCreate(rg,_p_RG,struct _RGOps,RG_CLASSID,"RG","Region","RG",comm,RGDestroy,RGView);CHKERRQ(ierr);
rg->complement = PETSC_FALSE;
rg->data = NULL;
*newrg = rg;
PetscFunctionReturn(0);
}
PetscErrorCode DMCoarsenHierarchy_DA(DM da,PetscInt nlevels,DM dac[])
{
PetscErrorCode ierr;
PetscInt i;
PetscFunctionBegin;
PetscValidHeaderSpecific(da,DM_CLASSID,1);
if (nlevels < 0) SETERRQ(((PetscObject)da)->comm,PETSC_ERR_ARG_OUTOFRANGE,"nlevels cannot be negative");
if (nlevels == 0) PetscFunctionReturn(0);
PetscValidPointer(dac,3);
ierr = DMCoarsen(da,((PetscObject)da)->comm,&dac[0]);CHKERRQ(ierr);
for (i=1; i<nlevels; i++) {
ierr = DMCoarsen(dac[i-1],((PetscObject)da)->comm,&dac[i]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
EPSGetBV - Obtain the basis vectors object associated to the eigensolver object.
Not Collective
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
Output Parameter:
. V - basis vectors context
Level: advanced
.seealso: EPSSetBV()
@*/
PetscErrorCode EPSGetBV(EPS eps,BV *V)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
PetscValidPointer(V,2);
if (!eps->V) {
ierr = BVCreate(PetscObjectComm((PetscObject)eps),&eps->V);
CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)eps->V);
CHKERRQ(ierr);
}
*V = eps->V;
PetscFunctionReturn(0);
}
/*@C
EPSGetST - Obtain the spectral transformation (ST) object associated
to the eigensolver object.
Not Collective
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
Output Parameter:
. st - spectral transformation context
Level: beginner
.seealso: EPSSetST()
@*/
PetscErrorCode EPSGetST(EPS eps,ST *st)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
PetscValidPointer(st,2);
if (!eps->st) {
ierr = STCreate(PetscObjectComm((PetscObject)eps),&eps->st);
CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)eps->st);
CHKERRQ(ierr);
}
*st = eps->st;
PetscFunctionReturn(0);
}
/*@C
EPSGetDS - Obtain the direct solver object associated to the eigensolver object.
Not Collective
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
Output Parameter:
. ds - direct solver context
Level: advanced
.seealso: EPSSetDS()
@*/
PetscErrorCode EPSGetDS(EPS eps,DS *ds)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
PetscValidPointer(ds,2);
if (!eps->ds) {
ierr = DSCreate(PetscObjectComm((PetscObject)eps),&eps->ds);
CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)eps,(PetscObject)eps->ds);
CHKERRQ(ierr);
}
*ds = eps->ds;
PetscFunctionReturn(0);
}
/*@
MatISGetMPIXAIJ - Converts MATIS matrix into a parallel AIJ format
Input Parameter:
. mat - the matrix (should be of type MATIS)
. reuse - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
Output Parameter:
. newmat - the matrix in AIJ format
Level: developer
Notes: mat and *newmat cannot be the same object when MAT_REUSE_MATRIX is requested.
.seealso: MATIS
@*/
PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatReuse reuse, Mat *newmat)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
PetscValidLogicalCollectiveEnum(mat,reuse,2);
PetscValidPointer(newmat,3);
if (reuse != MAT_INITIAL_MATRIX) {
PetscValidHeaderSpecific(*newmat,MAT_CLASSID,3);
PetscCheckSameComm(mat,1,*newmat,3);
if (mat == *newmat) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse the same matrix");
}
ierr = PetscUseMethod(mat,"MatISGetMPIXAIJ_C",(Mat,MatReuse,Mat*),(mat,reuse,newmat));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
ISRestoreTotalIndices - Restore the index array obtained with ISGetTotalIndices().
Not Collective.
Input Parameter:
+ is - the index set
- indices - index array; must be the array obtained with ISGetTotalIndices()
Level: intermediate
Concepts: index sets^getting nonlocal indices
Concepts: index sets^restoring nonlocal indices
.seealso: ISRestoreTotalIndices(), ISGetNonlocalIndices()
@*/
PetscErrorCode ISRestoreTotalIndices(IS is, const PetscInt *indices[])
{
PetscErrorCode ierr;
PetscMPIInt size;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(indices,2);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is), &size);CHKERRQ(ierr);
if (size == 1) {
ierr = (*is->ops->restoreindices)(is,indices);CHKERRQ(ierr);
} else {
if (is->total != *indices) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Index array pointer being restored does not point to the array obtained from the IS.");
}
PetscFunctionReturn(0);
}
/*@
ISOnComm - Split a parallel IS on subcomms (usually self) or concatenate index sets on subcomms into a parallel index set
Collective on IS and comm
Input Arguments:
+ is - index set
. comm - communicator for new index set
- mode - copy semantics, PETSC_USE_POINTER for no-copy if possible, otherwise PETSC_COPY_VALUES
Output Arguments:
. newis - new IS on comm
Level: advanced
Notes:
It is usually desirable to create a parallel IS and look at the local part when necessary.
This function is useful if serial ISs must be created independently, or to view many
logically independent serial ISs.
The input IS must have the same type on every process.
.seealso: ISSplit()
@*/
PetscErrorCode ISOnComm(IS is,MPI_Comm comm,PetscCopyMode mode,IS *newis)
{
PetscErrorCode ierr;
PetscMPIInt match;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(newis,3);
ierr = MPI_Comm_compare(PetscObjectComm((PetscObject)is),comm,&match);CHKERRQ(ierr);
if (mode != PETSC_COPY_VALUES && (match == MPI_IDENT || match == MPI_CONGRUENT)) {
ierr = PetscObjectReference((PetscObject)is);CHKERRQ(ierr);
*newis = is;
} else {
ierr = (*is->ops->oncomm)(is,comm,mode,newis);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode DMInterpolationCreate(MPI_Comm comm, DMInterpolationInfo *ctx)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(ctx, 2);
ierr = PetscMalloc(sizeof(struct _DMInterpolationInfo), ctx);CHKERRQ(ierr);
(*ctx)->comm = comm;
(*ctx)->dim = -1;
(*ctx)->nInput = 0;
(*ctx)->points = NULL;
(*ctx)->cells = NULL;
(*ctx)->n = -1;
(*ctx)->coords = NULL;
PetscFunctionReturn(0);
}
/*@C
PetscDrawHGCreate - Creates a histogram data structure.
Collective over PetscDraw
Input Parameters:
+ draw - The window where the graph will be made
- bins - The number of bins to use
Output Parameters:
. hist - The histogram context
Level: intermediate
Concepts: histogram^creating
.seealso: PetscDrawHGDestroy()
@*/
PetscErrorCode PetscDrawHGCreate(PetscDraw draw, int bins, PetscDrawHG *hist)
{
PetscBool isnull;
PetscDrawHG h;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(draw, PETSC_DRAW_CLASSID,1);
PetscValidLogicalCollectiveInt(draw,bins,2);
PetscValidPointer(hist,3);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
if (isnull) {*hist = NULL; PetscFunctionReturn(0);}
ierr = PetscHeaderCreate(h, PETSC_DRAWHG_CLASSID, "PetscDrawHG", "Histogram", "Draw", PetscObjectComm((PetscObject)draw), PetscDrawHGDestroy, NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)draw,(PetscObject)h);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)draw);CHKERRQ(ierr);
h->win = draw;
h->view = NULL;
h->destroy = NULL;
h->color = PETSC_DRAW_GREEN;
h->xmin = PETSC_MAX_REAL;
h->xmax = PETSC_MIN_REAL;
h->ymin = 0.;
h->ymax = 1.;
h->numBins = bins;
h->maxBins = bins;
ierr = PetscMalloc1(h->maxBins,&h->bins);CHKERRQ(ierr);
h->numValues = 0;
h->maxValues = CHUNKSIZE;
h->calcStats = PETSC_FALSE;
h->integerBins = PETSC_FALSE;
ierr = PetscMalloc1(h->maxValues,&h->values);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)h,(h->maxBins + h->maxValues)*sizeof(PetscReal));CHKERRQ(ierr);
ierr = PetscDrawAxisCreate(draw,&h->axis);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)h,(PetscObject)h->axis);CHKERRQ(ierr);
*hist = h;
PetscFunctionReturn(0);
}
/*@
PetscViewerGetSubcomm - Creates a new PetscViewer (same type as the old)
that lives on a subgroup of processors
Collective on PetscViewer
Input Parameter:
+ viewer - the PetscViewer to be duplicated
- subcomm - MPI communicator
Output Parameter:
. outviewer - new PetscViewer
Level: advanced
Notes: Call PetscViewerRestoreSubcomm() to return this PetscViewer, NOT PetscViewerDestroy()
This is used to view a sequential or a parallel object that is part of a larger
parallel object. For example redundant PC view could use this to obtain a
PetscViewer that is used within a subcommunicator on one duplicated preconditioner.
Concepts: PetscViewer^sequential version
.seealso: PetscViewerSocketOpen(), PetscViewerASCIIOpen(), PetscViewerDrawOpen(), PetscViewerRestoreSubcomm()
@*/
PetscErrorCode PetscViewerGetSubcomm(PetscViewer viewer,MPI_Comm subcomm,PetscViewer *outviewer)
{
PetscErrorCode ierr;
PetscMPIInt size;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1);
PetscValidPointer(outviewer,3);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)viewer),&size);CHKERRQ(ierr);
if (size == 1) {
ierr = PetscObjectReference((PetscObject)viewer);CHKERRQ(ierr);
*outviewer = viewer;
} else if (viewer->ops->getsubcomm) {
ierr = (*viewer->ops->getsubcomm)(viewer,subcomm,outviewer);CHKERRQ(ierr);
} else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get subcommunicator PetscViewer for type %s",((PetscObject)viewer)->type_name);
PetscFunctionReturn(0);
}
/*@
ISCreateBlock - Creates a data structure for an index set containing
a list of integers. The indices are relative to entries, not blocks.
Collective on MPI_Comm
Input Parameters:
+ comm - the MPI communicator
. bs - number of elements in each block
. n - the length of the index set (the number of blocks)
. idx - the list of integers, one for each block and count of block not indices
- mode - see PetscCopyMode, only PETSC_COPY_VALUES and PETSC_OWN_POINTER are supported in this routine
Output Parameter:
. is - the new index set
Notes:
When the communicator is not MPI_COMM_SELF, the operations on the
index sets, IS, are NOT conceptually the same as MPI_Group operations.
The index sets are then distributed sets of indices and thus certain operations
on them are collective.
Example:
If you wish to index the values {0,1,6,7}, then use
a block size of 2 and idx of {0,3}.
Level: beginner
Concepts: IS^block
Concepts: index sets^block
Concepts: block^index set
.seealso: ISCreateStride(), ISCreateGeneral(), ISAllGather()
@*/
PetscErrorCode ISCreateBlock(MPI_Comm comm,PetscInt bs,PetscInt n,const PetscInt idx[],PetscCopyMode mode,IS *is)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(is,5);
if (n < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"length < 0");
if (n) PetscValidIntPointer(idx,4);
ierr = ISCreate(comm,is);
CHKERRQ(ierr);
ierr = ISSetType(*is,ISBLOCK);
CHKERRQ(ierr);
ierr = ISBlockSetIndices(*is,bs,n,idx,mode);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESComputeObjective - Computes the objective.
Collective on SNES
Input Parameter:
+ snes - the SNES context
- X - the state vector
Output Parameter:
. ob - the objective value
Level: advanced
.keywords: SNES, nonlinear, compute, objective
.seealso: SNESSetObjective(), SNESGetSolution()
@*/
PetscErrorCode SNESComputeObjective(SNES snes,Vec X,PetscReal *ob)
{
PetscErrorCode ierr;
DM dm;
DMSNES sdm;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidPointer(ob,3);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetDMSNES(dm,&sdm);CHKERRQ(ierr);
if (sdm->ops->computeobjective) {
ierr = (sdm->ops->computeobjective)(snes,X,ob,sdm->objectivectx);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE, "Must call SNESSetObjective() before SNESComputeObjective().");
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelGetStratumSize(DMLabel label, PetscInt value, PetscInt *size)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidPointer(size, 3);
*size = 0;
for (v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) {
ierr = DMLabelMakeValid_Private(label, v);CHKERRQ(ierr);
*size = label->stratumSizes[v];
break;
}
}
PetscFunctionReturn(0);
}
/*@
MatMFFDSetHHistory - Sets an array to collect a history of the
differencing values (h) computed for the matrix-free product.
Logically Collective on Mat
Input Parameters:
+ J - the matrix-free matrix context
. histroy - space to hold the history
- nhistory - number of entries in history, if more entries are generated than
nhistory, then the later ones are discarded
Level: advanced
Notes:
Use MatMFFDResetHHistory() to reset the history counter and collect
a new batch of differencing parameters, h.
.keywords: SNES, matrix-free, h history, differencing history
.seealso: MatMFFDGetH(), MatCreateSNESMF(),
MatMFFDResetHHistory(), MatMFFDSetFunctionError()
@*/
PetscErrorCode MatMFFDSetHHistory(Mat J,PetscScalar history[],PetscInt nhistory)
{
MatMFFD ctx = (MatMFFD)J->data;
PetscErrorCode ierr;
PetscBool match;
PetscFunctionBegin;
PetscValidHeaderSpecific(J,MAT_CLASSID,1);
if (history) PetscValidPointer(history,2);
PetscValidLogicalCollectiveInt(J,nhistory,3);
ierr = PetscObjectTypeCompare((PetscObject)J,MATMFFD,&match);CHKERRQ(ierr);
if (!match) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONG,"Not a MFFD matrix");
ctx->historyh = history;
ctx->maxcurrenth = nhistory;
ctx->currenth = 0.;
PetscFunctionReturn(0);
}
/*@C
BVCreate - Creates a basis vectors context.
Collective on MPI_Comm
Input Parameter:
. comm - MPI communicator
Output Parameter:
. bv - location to put the basis vectors context
Level: beginner
.seealso: BVSetUp(), BVDestroy(), BV
@*/
PetscErrorCode BVCreate(MPI_Comm comm,BV *newbv)
{
PetscErrorCode ierr;
BV bv;
PetscFunctionBegin;
PetscValidPointer(newbv,2);
*newbv = 0;
ierr = BVInitializePackage();CHKERRQ(ierr);
ierr = SlepcHeaderCreate(bv,_p_BV,struct _BVOps,BV_CLASSID,"BV","Basis Vectors","BV",comm,BVDestroy,BVView);CHKERRQ(ierr);
bv->t = NULL;
bv->n = -1;
bv->N = -1;
bv->m = 0;
bv->l = 0;
bv->k = 0;
bv->nc = 0;
bv->orthog_type = BV_ORTHOG_CGS;
bv->orthog_ref = BV_ORTHOG_REFINE_IFNEEDED;
bv->orthog_eta = 0.7071;
bv->matrix = NULL;
bv->indef = PETSC_FALSE;
bv->Bx = NULL;
bv->xid = 0;
bv->xstate = 0;
bv->cv[0] = NULL;
bv->cv[1] = NULL;
bv->ci[0] = -1;
bv->ci[1] = -1;
bv->st[0] = -1;
bv->st[1] = -1;
bv->id[0] = 0;
bv->id[1] = 0;
bv->h = NULL;
bv->c = NULL;
bv->omega = NULL;
bv->work = NULL;
bv->lwork = 0;
bv->data = NULL;
*newbv = bv;
PetscFunctionReturn(0);
}
PetscErrorCode TaoLineSearchCreate(MPI_Comm comm, TaoLineSearch *newls)
{
PetscErrorCode ierr;
TaoLineSearch ls;
PetscFunctionBegin;
PetscValidPointer(newls,2);
*newls = NULL;
#ifndef PETSC_USE_DYNAMIC_LIBRARIES
ierr = TaoLineSearchInitializePackage();CHKERRQ(ierr);
#endif
ierr = PetscHeaderCreate(ls,_p_TaoLineSearch,struct _TaoLineSearchOps,TAOLINESEARCH_CLASSID,"TaoLineSearch",0,0,comm,TaoLineSearchDestroy,TaoLineSearchView);CHKERRQ(ierr);
ls->bounded = 0;
ls->max_funcs=30;
ls->ftol = 0.0001;
ls->gtol = 0.9;
#if defined(PETSC_USE_REAL_SINGLE)
ls->rtol = 1.0e-5;
#else
ls->rtol = 1.0e-10;
#endif
ls->stepmin=1.0e-20;
ls->stepmax=1.0e+20;
ls->step=1.0;
ls->nfeval=0;
ls->ngeval=0;
ls->nfgeval=0;
ls->ops->computeobjective=0;
ls->ops->computegradient=0;
ls->ops->computeobjectiveandgradient=0;
ls->ops->computeobjectiveandgts=0;
ls->ops->setup=0;
ls->ops->apply=0;
ls->ops->view=0;
ls->ops->setfromoptions=0;
ls->ops->reset=0;
ls->ops->destroy=0;
ls->setupcalled=PETSC_FALSE;
ls->usetaoroutines=PETSC_FALSE;
*newls = ls;
PetscFunctionReturn(0);
}
/*@
PCMGGetRestriction - Gets the function to be used to restrict vector
from level l to l-1.
Logically Collective on PC and Mat
Input Parameters:
+ pc - the multigrid context
- l - the level (0 is coarsest) to supply [Do not supply 0]
Output Parameter:
. mat - the restriction matrix
Level: advanced
.keywords: MG, get, multigrid, restriction, level
.seealso: PCMGGetInterpolation(), PCMGSetRestriction(), PCMGGetRScale()
@*/
PetscErrorCode PCMGGetRestriction(PC pc,PetscInt l,Mat *mat)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(pc,PC_CLASSID,1);
PetscValidPointer(mat,3);
if (!mglevels) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must set MG levels before calling");
if (l <= 0 || mg->nlevels <= l) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_OUTOFRANGE,"Level %D must be in range {1,...,%D}",l,mg->nlevels-1);
if (!mglevels[l]->restrct) {
if (!mglevels[l]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must call PCMGSetRestriction() or PCMGSetInterpolation()");
ierr = PCMGSetRestriction(pc,l,mglevels[l]->interpolate);CHKERRQ(ierr);
}
*mat = mglevels[l]->restrct;
PetscFunctionReturn(0);
}
