/*@C
PetscObjectGetFortranCallback - get fortran callback function pointer and context
Logically Collective
Input Arguments:
+ obj - object on which to get callback
. cbtype - callback type
- cid - address of callback Id
Output Arguments:
+ func - Fortran function (or NULL if not needed)
- ctx - Fortran context (or NULL if not needed)
Level: developer
.seealso: PetscObjectSetFortranCallback()
@*/
PetscErrorCode PetscObjectGetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId cid,void (**func)(void),void **ctx)
{
PetscFortranCallback *cb;
PetscFunctionBegin;
PetscValidHeader(obj,1);
if (PetscUnlikely(cid < PETSC_SMALLEST_FORTRAN_CALLBACK)) SETERRQ(obj->comm,PETSC_ERR_ARG_CORRUPT,"Fortran callback Id invalid");
if (PetscUnlikely(cid >= PETSC_SMALLEST_FORTRAN_CALLBACK+obj->num_fortrancallback[cbtype])) SETERRQ(obj->comm,PETSC_ERR_ARG_CORRUPT,"Fortran callback not set on this object");
cb = &obj->fortrancallback[cbtype][cid-PETSC_SMALLEST_FORTRAN_CALLBACK];
if (func) *func = cb->func;
if (ctx) *ctx = cb->ctx;
PetscFunctionReturn(0);
}
/*@
PetscSortedRemoveDupsInt - Removes all duplicate entries of a sorted input array
Not Collective
Input Parameters:
+ n - number of values
- ii - sorted array of integers
Output Parameter:
. n - number of non-redundant values
Level: intermediate
Concepts: sorting^ints
.seealso: PetscSortInt()
@*/
PetscErrorCode PetscSortedRemoveDupsInt(PetscInt *n,PetscInt ii[])
{
PetscInt i,s = 0,N = *n, b = 0;
PetscFunctionBegin;
for (i=0; i<N-1; i++) {
if (PetscUnlikely(ii[b+s+1] < ii[b])) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Input array is not sorted");
if (ii[b+s+1] != ii[b]) {
ii[b+1] = ii[b+s+1]; b++;
} else s++;
}
*n = N - s;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscTruth flg = PETSC_TRUE;
PetscInitialize(&argc,&argv,(char *)0,help);
if (PetscLikely(flg)) {
/* do something */
}
if (PetscUnlikely(flg)) {
/* do something */
}
PetscFinalize();
return 0;
}
PetscErrorCode MatSetValuesLocal_HYPREStruct_3d(Mat mat,PetscInt nrow,const PetscInt irow[],PetscInt ncol,const PetscInt icol[],const PetscScalar y[],InsertMode addv)
{
PetscErrorCode ierr;
PetscInt i,j,stencil,index[3],row,entries[7];
const PetscScalar *values = y;
Mat_HYPREStruct *ex = (Mat_HYPREStruct*) mat->data;
PetscFunctionBegin;
if (PetscUnlikely(ncol >= 7)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"ncol %D >= 7 too large",ncol);
for (i=0; i<nrow; i++) {
for (j=0; j<ncol; j++) {
stencil = icol[j] - irow[i];
if (!stencil) {
entries[j] = 3;
} else if (stencil == -1) {
entries[j] = 2;
} else if (stencil == 1) {
entries[j] = 4;
} else if (stencil == -ex->gnx) {
entries[j] = 1;
} else if (stencil == ex->gnx) {
entries[j] = 5;
} else if (stencil == -ex->gnxgny) {
entries[j] = 0;
} else if (stencil == ex->gnxgny) {
entries[j] = 6;
} else SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Local row %D local column %D have bad stencil %D",irow[i],icol[j],stencil);
}
row = ex->gindices[irow[i]] - ex->rstart;
index[0] = ex->xs + (row % ex->nx);
index[1] = ex->ys + ((row/ex->nx) % ex->ny);
index[2] = ex->zs + (row/(ex->nxny));
if (addv == ADD_VALUES) {
PetscStackCallStandard(HYPRE_StructMatrixAddToValues,(ex->hmat,(HYPRE_Int *)index,ncol,(HYPRE_Int *)entries,(PetscScalar*)values));
} else {
PetscStackCallStandard(HYPRE_StructMatrixSetValues,(ex->hmat,(HYPRE_Int *)index,ncol,(HYPRE_Int *)entries,(PetscScalar*)values));
}
values += ncol;
}
PetscFunctionReturn(0);
}
