int main(int argc, char **argv)
{
PetscBool transform = PETSC_FALSE;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc, &argv, NULL, help);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL, "-transform", &transform, NULL);CHKERRQ(ierr);
if (transform) {ierr = PetscPrintf(PETSC_COMM_WORLD, "Using random transforms");CHKERRQ(ierr);}
ierr = TestTriangle(PETSC_COMM_SELF, PETSC_FALSE, transform);CHKERRQ(ierr);
ierr = TestTriangle(PETSC_COMM_SELF, PETSC_TRUE, transform);CHKERRQ(ierr);
ierr = TestQuadrilateral(PETSC_COMM_SELF, PETSC_FALSE, transform);CHKERRQ(ierr);
ierr = TestQuadrilateral(PETSC_COMM_SELF, PETSC_TRUE, transform);CHKERRQ(ierr);
ierr = TestTetrahedron(PETSC_COMM_SELF, PETSC_FALSE, transform);CHKERRQ(ierr);
ierr = TestTetrahedron(PETSC_COMM_SELF, PETSC_TRUE, transform);CHKERRQ(ierr);
ierr = TestHexahedron(PETSC_COMM_SELF, PETSC_FALSE, transform);CHKERRQ(ierr);
ierr = TestHexahedron(PETSC_COMM_SELF, PETSC_TRUE, transform);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
PetscBool usempiio = PETSC_FALSE;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = PetscOptionsGetBool(NULL,"-usempiio",&usempiio,NULL);CHKERRQ(ierr);
if (!usempiio) {
ierr = TestDMDAVec(PETSC_FALSE);CHKERRQ(ierr);
} else {
#if defined(PETSC_HAVE_MPIIO)
ierr = TestDMDAVec(PETSC_TRUE);CHKERRQ(ierr);
#else
ierr = PetscPrintf(PETSC_COMM_WORLD,"Warning: Executing TestDMDAVec(PETSC_TRUE) requires a working MPI-2 implementation\n");CHKERRQ(ierr);
#endif
}
ierr = PetscFinalize();
return 0;
}
/*@
PetscDrawLGSetFromOptions - Sets options related to the PetscDrawLG
Collective on PetscDrawLG
Options Database:
Level: intermediate
Concepts: line graph^creating
.seealso: PetscDrawLGDestroy(), PetscDrawLGCreate()
@*/
PetscErrorCode PetscDrawLGSetFromOptions(PetscDrawLG lg)
{
PetscErrorCode ierr;
PetscBool usemarkers,set;
PetscDrawMarkerType markertype;
PetscFunctionBegin;
PetscValidHeaderSpecific(lg,PETSC_DRAWLG_CLASSID,1);
ierr = PetscDrawGetMarkerType(lg->win,&markertype);CHKERRQ(ierr);
ierr = PetscOptionsGetEnum(((PetscObject)lg)->options,((PetscObject)lg)->prefix,"-lg_marker_type",PetscDrawMarkerTypes,(PetscEnum*)&markertype,&set);CHKERRQ(ierr);
if (set) {
ierr = PetscDrawLGSetUseMarkers(lg,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscDrawSetMarkerType(lg->win,markertype);CHKERRQ(ierr);
}
usemarkers = lg->use_markers;
ierr = PetscOptionsGetBool(((PetscObject)lg)->options,((PetscObject)lg)->prefix,"-lg_use_markers",&usemarkers,&set);CHKERRQ(ierr);
if (set) {ierr = PetscDrawLGSetUseMarkers(lg,usemarkers);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
PetscErrorCode PetscDrawSetUpColormap_Shared(Display *display,int screen,Visual *visual,Colormap colormap)
{
int i;
XColor colordef,ecolordef;
PetscBool fast = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
if (colormap) gColormap = colormap;
else gColormap = DefaultColormap(display,screen);
/* set the basic colors into the color map */
for (i=0; i<PETSC_DRAW_BASIC_COLORS; i++) {
XAllocNamedColor(display,gColormap,colornames[i],&colordef,&ecolordef);
gCmapping[i] = colordef.pixel;
}
/* set the contour colors into the colormap */
ierr = PetscOptionsGetBool(NULL,NULL,"-draw_fast",&fast,NULL);CHKERRQ(ierr);
if (!fast) {
int ncolors = 256-PETSC_DRAW_BASIC_COLORS;
unsigned char *red,*green,*blue;
ierr = PetscMalloc3(ncolors,&red,ncolors,&green,ncolors,&blue);CHKERRQ(ierr);
ierr = PetscDrawUtilitySetCmap(NULL,ncolors,red,green,blue);CHKERRQ(ierr);
for (i=0; i<ncolors; i++) {
colordef.red = (unsigned short)(red[i] << 8);
colordef.green = (unsigned short)(green[i] << 8);
colordef.blue = (unsigned short)(blue[i] << 8);
colordef.flags = DoRed|DoGreen|DoBlue;
XAllocColor(display,gColormap,&colordef);
gCmapping[PETSC_DRAW_BASIC_COLORS + i] = colordef.pixel;
}
ierr = PetscFree3(red,green,blue);CHKERRQ(ierr);
}
ierr = PetscInfo(0,"Successfully allocated colors\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PetscSplitReductionCreate - Creates a data structure to contain the queued information.
*/
static PetscErrorCode PetscSplitReductionCreate(MPI_Comm comm,PetscSplitReduction **sr)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscNew(PetscSplitReduction,sr);CHKERRQ(ierr);
(*sr)->numopsbegin = 0;
(*sr)->numopsend = 0;
(*sr)->state = STATE_BEGIN;
(*sr)->maxops = 32;
ierr = PetscMalloc(2*32*sizeof(PetscScalar),&(*sr)->lvalues);CHKERRQ(ierr);
ierr = PetscMalloc(2*32*sizeof(PetscScalar),&(*sr)->gvalues);CHKERRQ(ierr);
ierr = PetscMalloc(32*sizeof(void*),&(*sr)->invecs);CHKERRQ(ierr);
(*sr)->comm = comm;
(*sr)->request = MPI_REQUEST_NULL;
ierr = PetscMalloc(32*sizeof(PetscInt),&(*sr)->reducetype);CHKERRQ(ierr);
(*sr)->async = PETSC_FALSE;
#if defined(PETSC_HAVE_MPIX_IALLREDUCE) || defined(PETSC_HAVE_PAMI) || defined(PETSC_HAVE_DCMF)
(*sr)->async = PETSC_TRUE; /* Enable by default */
ierr = PetscOptionsGetBool(PETSC_NULL,"-splitreduction_async",&(*sr)->async,PETSC_NULL);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode PetscSFCreate_Window(PetscSF sf)
{
PetscSF_Window *w = (PetscSF_Window*)sf->data;
PetscErrorCode ierr;
PetscFunctionBegin;
sf->ops->SetUp = PetscSFSetUp_Window;
sf->ops->SetFromOptions = PetscSFSetFromOptions_Window;
sf->ops->Reset = PetscSFReset_Window;
sf->ops->Destroy = PetscSFDestroy_Window;
sf->ops->View = PetscSFView_Window;
sf->ops->Duplicate = PetscSFDuplicate_Window;
sf->ops->BcastBegin = PetscSFBcastBegin_Window;
sf->ops->BcastEnd = PetscSFBcastEnd_Window;
sf->ops->ReduceBegin = PetscSFReduceBegin_Window;
sf->ops->ReduceEnd = PetscSFReduceEnd_Window;
sf->ops->FetchAndOpBegin = PetscSFFetchAndOpBegin_Window;
sf->ops->FetchAndOpEnd = PetscSFFetchAndOpEnd_Window;
ierr = PetscNewLog(sf,&w);CHKERRQ(ierr);
sf->data = (void*)w;
w->sync = PETSCSF_WINDOW_SYNC_FENCE;
ierr = PetscObjectComposeFunction((PetscObject)sf,"PetscSFWindowSetSyncType_C",PetscSFWindowSetSyncType_Window);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)sf,"PetscSFWindowGetSyncType_C",PetscSFWindowGetSyncType_Window);CHKERRQ(ierr);
#if defined(OMPI_MAJOR_VERSION) && (OMPI_MAJOR_VERSION < 1 || (OMPI_MAJOR_VERSION == 1 && OMPI_MINOR_VERSION <= 6))
{
PetscBool ackbug = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-acknowledge_ompi_onesided_bug",&ackbug,NULL);CHKERRQ(ierr);
if (ackbug) {
ierr = PetscInfo(sf,"Acknowledged Open MPI bug, proceeding anyway. Expect memory corruption.\n");CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)sf),PETSC_ERR_LIB,"Open MPI is known to be buggy (https://svn.open-mpi.org/trac/ompi/ticket/1905 and 2656), use -acknowledge_ompi_onesided_bug to proceed");
}
#endif
PetscFunctionReturn(0);
}
/*@C
PFDestroy - Destroys PF context that was created with PFCreate().
Collective on PF
Input Parameter:
. pf - the function context
Level: beginner
.keywords: PF, destroy
.seealso: PFCreate(), PFSet(), PFSetType()
@*/
PetscErrorCode PFDestroy(PF *pf)
{
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
if (!*pf) PetscFunctionReturn(0);
PetscValidHeaderSpecific((*pf),PF_CLASSID,1);
if (--((PetscObject)(*pf))->refct > 0) PetscFunctionReturn(0);
ierr = PetscOptionsGetBool(((PetscObject)(*pf))->prefix,"-pf_view",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(((PetscObject)(*pf))->comm,&viewer);CHKERRQ(ierr);
ierr = PFView((*pf),viewer);CHKERRQ(ierr);
}
/* if memory was published with AMS then destroy it */
ierr = PetscObjectDepublish((*pf));CHKERRQ(ierr);
if ((*pf)->ops->destroy) {ierr = (*(*pf)->ops->destroy)((*pf)->data);CHKERRQ(ierr);}
ierr = PetscHeaderDestroy(pf);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscInt M = -10,N = -8;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
DM da;
Vec global1,global2,global3;
DMDABoundaryType bx = DMDA_BOUNDARY_NONE,by = DMDA_BOUNDARY_NONE;
DMDAStencilType stype = DMDA_STENCIL_BOX;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(PETSC_NULL,"-star_stencil",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) stype = DMDA_STENCIL_STAR;
/* Create distributed array and get vectors */
ierr = DMDACreate2d(PETSC_COMM_WORLD,bx,by,stype,M,N,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,&da);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global3);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global3);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global3);CHKERRQ(ierr);
ierr = DMGetGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global1);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global3);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(da,&global2);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*@C
PetscMatlabEngineCreate - Creates a MATLAB engine object
Not Collective
Input Parameters:
+ comm - a separate MATLAB engine is started for each process in the communicator
- machine - name of machine where MATLAB engine is to be run (usually NULL)
Output Parameter:
. mengine - the resulting object
Options Database:
. -matlab_engine_graphics - allow the MATLAB engine to display graphics
Level: advanced
.seealso: PetscMatlabEngineDestroy(), PetscMatlabEnginePut(), PetscMatlabEngineGet(),
PetscMatlabEngineEvaluate(), PetscMatlabEngineGetOutput(), PetscMatlabEnginePrintOutput(),
PETSC_MATLAB_ENGINE_(), PetscMatlabEnginePutArray(), PetscMatlabEngineGetArray(), PetscMatlabEngine
@*/
PetscErrorCode PetscMatlabEngineCreate(MPI_Comm comm,const char machine[],PetscMatlabEngine *mengine)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
char buffer[256];
PetscMatlabEngine e;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
if (MATLABENGINE_CLASSID == -1) {
ierr = PetscClassIdRegister("MATLAB Engine",&MATLABENGINE_CLASSID);CHKERRQ(ierr);
}
ierr = PetscOptionsGetBool(NULL,NULL,"-matlab_engine_graphics",&flg,NULL);CHKERRQ(ierr);
ierr = PetscHeaderCreate(e,MATLABENGINE_CLASSID,"MatlabEngine","MATLAB Engine","Sys",comm,PetscMatlabEngineDestroy,NULL);CHKERRQ(ierr);
if (!machine) machine = "\0";
ierr = PetscStrcpy(buffer,PETSC_MATLAB_COMMAND);CHKERRQ(ierr);
if (!flg) {
ierr = PetscStrcat(buffer," -nodisplay ");CHKERRQ(ierr);
}
ierr = PetscStrcat(buffer," -nojvm ");CHKERRQ(ierr);
ierr = PetscInfo2(0,"Starting MATLAB engine on %s with command %s\n",machine,buffer);CHKERRQ(ierr);
e->ep = engOpen(buffer);
if (!e->ep) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Unable to start MATLAB engine on %s",machine);
engOutputBuffer(e->ep,e->buffer,1024);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
sprintf(buffer,"MPI_Comm_rank = %d; MPI_Comm_size = %d;\n",rank,size);
engEvalString(e->ep, buffer);
ierr = PetscInfo1(0,"Started MATLAB engine on %s\n",machine);CHKERRQ(ierr);
*mengine = e;
PetscFunctionReturn(0);
}
/*@
MatPartitioningApply - Gets a partitioning for a matrix.
Collective on Mat
Input Parameters:
. matp - the matrix partitioning object
Output Parameters:
. partitioning - the partitioning. For each local node this tells the processor
number that that node is assigned to.
Options Database Keys:
To specify the partitioning through the options database, use one of
the following
$ -mat_partitioning_type parmetis, -mat_partitioning current
To see the partitioning result
$ -mat_partitioning_view
Level: beginner
The user can define additional partitionings; see MatPartitioningRegister().
.keywords: matrix, get, partitioning
.seealso: MatPartitioningRegister(), MatPartitioningCreate(),
MatPartitioningDestroy(), MatPartitioningSetAdjacency(), ISPartitioningToNumbering(),
ISPartitioningCount()
@*/
PetscErrorCode MatPartitioningApply(MatPartitioning matp,IS *partitioning)
{
PetscErrorCode ierr;
PetscBool flag = PETSC_FALSE;
PetscFunctionBegin;
PetscValidHeaderSpecific(matp,MAT_PARTITIONING_CLASSID,1);
PetscValidPointer(partitioning,2);
if (!matp->adj->assembled) SETERRQ(PetscObjectComm((PetscObject)matp),PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
if (matp->adj->factortype) SETERRQ(PetscObjectComm((PetscObject)matp),PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
if (!matp->ops->apply) SETERRQ(PetscObjectComm((PetscObject)matp),PETSC_ERR_ARG_WRONGSTATE,"Must set type with MatPartitioningSetFromOptions() or MatPartitioningSetType()");
ierr = PetscLogEventBegin(MAT_Partitioning,matp,0,0,0);CHKERRQ(ierr);
ierr = (*matp->ops->apply)(matp,partitioning);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_Partitioning,matp,0,0,0);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-mat_partitioning_view",&flag,NULL);CHKERRQ(ierr);
if (flag) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)matp),&viewer);CHKERRQ(ierr);
ierr = MatPartitioningView(matp,viewer);CHKERRQ(ierr);
ierr = ISView(*partitioning,viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PetscSSEIsEnabled(MPI_Comm comm,PetscBool *lflag,PetscBool *gflag)
{
PetscErrorCode ierr;
PetscBool disabled_option;
PetscFunctionBegin;
if (petsc_sse_local_is_untested && petsc_sse_global_is_untested) {
disabled_option = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-disable_sse",&disabled_option,NULL);CHKERRQ(ierr);
if (disabled_option) {
petsc_sse_local_is_untested = PETSC_FALSE;
petsc_sse_enabled_local = PETSC_FALSE;
petsc_sse_global_is_untested = PETSC_FALSE;
petsc_sse_enabled_global = PETSC_FALSE;
}
if (petsc_sse_local_is_untested) {
ierr = PetscSSEHardwareTest(&petsc_sse_enabled_local);CHKERRQ(ierr);
if (petsc_sse_enabled_local) {
ierr = PetscSSEOSEnabledTest(&petsc_sse_enabled_local);CHKERRQ(ierr);
}
petsc_sse_local_is_untested = PETSC_FALSE;
}
if (gflag && petsc_sse_global_is_untested) {
ierr = MPI_Allreduce(&petsc_sse_enabled_local,&petsc_sse_enabled_global,1,MPIU_BOOL,MPI_LAND,comm);CHKERRQ(ierr);
petsc_sse_global_is_untested = PETSC_FALSE;
}
}
if (lflag) *lflag = petsc_sse_enabled_local;
if (gflag) *gflag = petsc_sse_enabled_global;
PetscFunctionReturn(0);
}
/*@C
MatGetColoring - Gets a coloring for a matrix, from its sparsity structure,
to reduce the number of function evaluations needed to compute a sparse Jacobian via differencing.
Collective on Mat
Input Parameters:
. mat - the matrix
. type - type of coloring, one of the following:
$ MATCOLORINGNATURAL - natural (one color for each column, very slow)
$ MATCOLORINGSL - smallest-last
$ MATCOLORINGLF - largest-first
$ MATCOLORINGID - incidence-degree
Output Parameters:
. iscoloring - the coloring
Options Database Keys:
To specify the coloring through the options database, use one of
the following
$ -mat_coloring_type natural, -mat_coloring_type sl, -mat_coloring_type lf,
$ -mat_coloring_type id
To see the coloring use
$ -mat_coloring_view
Level: intermediate
Notes:
$ A graph coloring C(A) is a division of vertices so that two vertices of the same color do not share any common edges.
$ A suitable coloring for a smoother is simply C(A).
$ A suitable coloring for efficient Jacobian computation is a division of the columns so that two columns of the same color do not share any common rows.
$ This corresponds to C(A^{T} A). This is what MatGetColoring() computes.
The user can define additional colorings; see MatColoringRegisterDynamic().
For parallel matrices currently converts to sequential matrix and uses the sequential coloring
on that.
The colorings SL, LF, and ID are obtained via the Minpack software that was
converted to C using f2c.
For BAIJ matrices this colors the blocks. The true number of colors would be block size times the number of colors
returned here.
References:
$ Thomas F. Coleman and Jorge J. More, Estimation of Sparse {J}acobian Matrices and Graph Coloring Problems,
$ SIAM Journal on Numerical Analysis, 1983, pages 187-209, volume 20
$ Jorge J. Mor\'{e} and Danny C. Sorenson and Burton S. Garbow and Kenneth E. Hillstrom, The {MINPACK} Project,
$ Sources and Development of Mathematical Software, Wayne R. Cowell editor, 1984, pages 88-111
.keywords: matrix, get, coloring
.seealso: MatGetColoringTypeFromOptions(), MatColoringRegisterDynamic(), MatFDColoringCreate(),
SNESDefaultComputeJacobianColor()
@*/
PetscErrorCode MatGetColoring(Mat mat,MatColoringType type,ISColoring *iscoloring)
{
PetscBool flag;
PetscErrorCode ierr,(*r)(Mat,MatColoringType,ISColoring *);
char tname[PETSC_MAX_PATH_LEN];
MPI_Comm comm;
PetscFunctionBegin;
PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
PetscValidPointer(iscoloring,3);
if (!mat->assembled) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
if (mat->factortype) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
/* look for type on command line */
if (!MatColoringRegisterAllCalled) {ierr = MatColoringRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
ierr = PetscOptionsGetString(((PetscObject)mat)->prefix,"-mat_coloring_type",tname,256,&flag);CHKERRQ(ierr);
if (flag) { type = tname; }
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = PetscFunctionListFind(comm,MatColoringList,type,PETSC_TRUE,(void (**)(void)) &r);CHKERRQ(ierr);
if (!r) SETERRQ1(((PetscObject)mat)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Unknown or unregistered type: %s",type);
ierr = PetscLogEventBegin(MAT_GetColoring,mat,0,0,0);CHKERRQ(ierr);
ierr = (*r)(mat,type,iscoloring);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_GetColoring,mat,0,0,0);CHKERRQ(ierr);
ierr = PetscInfo1(mat,"Number of colors %d\n",(*iscoloring)->n);CHKERRQ(ierr);
flag = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-mat_coloring_view",&flag,PETSC_NULL);CHKERRQ(ierr);
if (flag) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout((*iscoloring)->comm,&viewer);CHKERRQ(ierr);
ierr = ISColoringView(*iscoloring,viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
PetscSplitReductionCreate - Creates a data structure to contain the queued information.
*/
static PetscErrorCode PetscSplitReductionCreate(MPI_Comm comm,PetscSplitReduction **sr)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscNew(sr);CHKERRQ(ierr);
(*sr)->numopsbegin = 0;
(*sr)->numopsend = 0;
(*sr)->state = STATE_BEGIN;
(*sr)->maxops = 32;
ierr = PetscMalloc1(2*32,&(*sr)->lvalues);CHKERRQ(ierr);
ierr = PetscMalloc1(2*32,&(*sr)->gvalues);CHKERRQ(ierr);
ierr = PetscMalloc1(32,&(*sr)->invecs);CHKERRQ(ierr);
(*sr)->comm = comm;
(*sr)->request = MPI_REQUEST_NULL;
ierr = PetscMalloc1(32,&(*sr)->reducetype);CHKERRQ(ierr);
(*sr)->async = PETSC_FALSE;
#if defined(PETSC_HAVE_MPI_IALLREDUCE) || defined(PETSC_HAVE_MPIX_IALLREDUCE)
(*sr)->async = PETSC_TRUE; /* Enable by default */
#endif
/* always check for option; so that tests that run on systems without support don't warn about unhandled options */
ierr = PetscOptionsGetBool(NULL,NULL,"-splitreduction_async",&(*sr)->async,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode GetParams(AppCtx *user)
{
PetscErrorCode ierr;
PetscBool flg;
PetscFunctionBeginUser;
/* Set default parameters */
user->tsmonitor = PETSC_FALSE;
user->xmin = 0.0; user->xmax = 1.0;
user->ymin = 0.0; user->ymax = 1.0;
user->T = 0.0002; user->dt = 0.0001;
user->gamma = 3.2E-4; user->theta_c = 0;
ierr = PetscOptionsGetBool(NULL,"-ts_monitor",&user->tsmonitor,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-xmin",&user->xmin,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-xmax",&user->xmax,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-ymin",&user->ymin,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-ymax",&user->ymax,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-T",&user->T,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-dt",&user->dt,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-gamma",&user->gamma,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-theta_c",&user->theta_c,&flg);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
AOCreate - Creates an application ordering.
Collective on MPI_Comm
Input Parameters:
. comm - MPI communicator that is to share AO
Output Parameter:
. ao - the new application ordering
Options Database Key:
+ -ao_type <aotype> - create ao with particular format
- -ao_view - call AOView() at the conclusion of AOCreate()
Level: beginner
.keywords: AO, create
.seealso: AOSetIS(), AODestroy(), AOPetscToApplication(), AOApplicationToPetsc()
@*/
PetscErrorCode AOCreate(MPI_Comm comm,AO *ao)
{
PetscErrorCode ierr;
AO aonew;
PetscBool opt;
PetscFunctionBegin;
PetscValidPointer(ao,2);
*ao = PETSC_NULL;
#ifndef PETSC_USE_DYNAMIC_LIBRARIES
ierr = AOInitializePackage(PETSC_NULL);CHKERRQ(ierr);
#endif
ierr = PetscHeaderCreate(aonew,_p_AO,struct _AOOps,AO_CLASSID,-1,"AO","Application Ordering","AO",comm,AODestroy,AOView);CHKERRQ(ierr);
ierr = PetscMemzero(aonew->ops, sizeof(struct _AOOps));CHKERRQ(ierr);
*ao = aonew;
opt = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL, "-ao_view", &opt,PETSC_NULL);CHKERRQ(ierr);
if (opt) {
ierr = AOView(aonew, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc, char* argv[])
{
int status = 0;
#ifdef CH_USE_PETSC
PetscInt nlev;
PetscErrorCode ierr;
char string[64];
PetscBool set;
PetscInitialize(&argc,&argv,(char*)0,help);
PetscOptionsGetInt(PETSC_NULL,"-n",&s_nCells0,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-bc_debug",&s_debug,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-plot_fas",&s_amrfas,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-plot_mg",&s_amrmg,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-corner_stencil",&s_corner_stencil,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-matlab",&s_matlab,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-plot",&s_plot,PETSC_NULL);
PetscOptionsGetReal(PETSC_NULL,"-error_thresh",&s_error_thresh,PETSC_NULL);
PetscOptionsGetInt(PETSC_NULL,"-blocking_factor",&s_blockingfactor,PETSC_NULL);
PetscOptionsGetInt(PETSC_NULL,"-order",&s_order,PETSC_NULL);
PetscOptionsGetInt(PETSC_NULL,"-nesting",&s_nesting,PETSC_NULL);
PetscOptionsGetInt(PETSC_NULL,"-max_box_size",&s_maxboxsz,PETSC_NULL);
PetscOptionsGetInt(PETSC_NULL,"-refinement_ratio",&s_refRatio,PETSC_NULL);
PetscOptionsGetString(PETSC_NULL,"-amr_type",string,64,&set);
if (set && strcmp(string,"error")==0) s_amr_type_iserror = true;
else s_amr_type_iserror = false;
nlev = 4;
PetscOptionsGetInt(PETSC_NULL,"-nlevels",&nlev,PETSC_NULL);
ierr = go(nlev,status); CHKERRQ(ierr);
CH_TIMER_REPORT();
ierr = PetscFinalize(); CHKERRQ(ierr);
#endif
return status;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr; /* used to check for functions returning nonzeros */
PetscReal zero=0.0;
Vec x; /* solution vector */
Mat H;
Tao tao; /* Tao solver context */
PetscBool flg, test_lmvm = PETSC_FALSE;
PetscMPIInt size,rank; /* number of processes running */
AppCtx user; /* user-defined application context */
TaoConvergedReason reason;
PetscInt its, recycled_its=0, oneshot_its=0;
/* Initialize TAO and PETSc */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (size >1) SETERRQ(PETSC_COMM_SELF,1,"Incorrect number of processors");
/* Initialize problem parameters */
user.n = 2; user.alpha = 99.0; user.chained = PETSC_FALSE;
/* Check for command line arguments to override defaults */
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&user.n,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-alpha",&user.alpha,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-chained",&user.chained,&flg);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-test_lmvm",&test_lmvm,&flg);CHKERRQ(ierr);
/* Allocate vectors for the solution and gradient */
ierr = VecCreateSeq(PETSC_COMM_SELF,user.n,&x);CHKERRQ(ierr);
ierr = MatCreateSeqBAIJ(PETSC_COMM_SELF,2,user.n,user.n,1,NULL,&H);CHKERRQ(ierr);
/* The TAO code begins here */
/* Create TAO solver with desired solution method */
ierr = TaoCreate(PETSC_COMM_SELF,&tao);CHKERRQ(ierr);
ierr = TaoSetType(tao,TAOLMVM);CHKERRQ(ierr);
/* Set solution vec and an initial guess */
ierr = VecSet(x, zero);CHKERRQ(ierr);
ierr = TaoSetInitialVector(tao,x);CHKERRQ(ierr);
/* Set routines for function, gradient, hessian evaluation */
ierr = TaoSetObjectiveAndGradientRoutine(tao,FormFunctionGradient,&user);CHKERRQ(ierr);
ierr = TaoSetHessianRoutine(tao,H,H,FormHessian,&user);CHKERRQ(ierr);
/* Check for TAO command line options */
ierr = TaoSetFromOptions(tao);CHKERRQ(ierr);
/* Solve the problem */
ierr = TaoSetTolerances(tao, 1.e-5, 0.0, 0.0);CHKERRQ(ierr);
ierr = TaoSetMaximumIterations(tao, 5);CHKERRQ(ierr);
ierr = TaoLMVMRecycle(tao, PETSC_TRUE);CHKERRQ(ierr);
reason = TAO_CONTINUE_ITERATING;
while (reason != TAO_CONVERGED_GATOL) {
ierr = TaoSolve(tao);CHKERRQ(ierr);
ierr = TaoGetConvergedReason(tao, &reason);CHKERRQ(ierr);
ierr = TaoGetIterationNumber(tao, &its);CHKERRQ(ierr);
recycled_its += its;
ierr = PetscPrintf(PETSC_COMM_SELF, "-----------------------\n");CHKERRQ(ierr);
}
/* Disable recycling and solve again! */
ierr = TaoSetMaximumIterations(tao, 100);CHKERRQ(ierr);
ierr = TaoLMVMRecycle(tao, PETSC_FALSE);CHKERRQ(ierr);
ierr = VecSet(x, zero);CHKERRQ(ierr);
ierr = TaoSolve(tao);CHKERRQ(ierr);
ierr = TaoGetConvergedReason(tao, &reason);CHKERRQ(ierr);
if (reason != TAO_CONVERGED_GATOL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_NOT_CONVERGED, "Solution failed to converge!");
ierr = TaoGetIterationNumber(tao, &oneshot_its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, "-----------------------\n");CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, "recycled its: %D | oneshot its: %D\n", recycled_its, oneshot_its);CHKERRQ(ierr);
if (recycled_its != oneshot_its) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_NOT_CONVERGED, "LMVM recycling does not work!");
ierr = TaoDestroy(&tao);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&H);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* KSP context */
PetscErrorCode ierr;
PetscInt n = 10,its, dim,p = 1,use_random;
PetscScalar none = -1.0,pfive = 0.5;
PetscReal norm;
PetscRandom rctx;
TestType type;
PetscBool flg;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-p",&p,PETSC_NULL);CHKERRQ(ierr);
switch (p) {
case 1: type = TEST_1; dim = n; break;
case 2: type = TEST_2; dim = n; break;
case 3: type = TEST_3; dim = n; break;
case 4: type = HELMHOLTZ_1; dim = n*n; break;
case 5: type = HELMHOLTZ_2; dim = n*n; break;
default: type = TEST_1; dim = n;
}
/* Create vectors */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,dim);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr);
use_random = 1;
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-norandom",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
use_random = 0;
ierr = VecSet(u,pfive);CHKERRQ(ierr);
} else {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
}
/* Create and assemble matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = FormTestMatrix(A,n,type);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-printout",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(b,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* Create KSP context; set operators and options; solve linear system */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Check error */
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %G,Iterations %D\n",norm,its);CHKERRQ(ierr);
/* Free work space */
ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
Vec x1,b1,x2,b2; /* solution and RHS vectors for systems #1 and #2 */
Vec u; /* exact solution vector */
Mat C1,C2; /* matrices for systems #1 and #2 */
KSP ksp1,ksp2; /* KSP contexts for systems #1 and #2 */
PetscInt ntimes = 3; /* number of times to solve the linear systems */
PetscLogEvent CHECK_ERROR; /* event number for error checking */
PetscInt ldim,low,high,iglobal,Istart,Iend,Istart2,Iend2;
PetscInt Ii,J,i,j,m = 3,n = 2,its,t;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscScalar v;
PetscMPIInt rank,size;
#if defined (PETSC_USE_LOG)
PetscLogStage stages[3];
#endif
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-t",&ntimes,PETSC_NULL);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 2*size;
/*
Register various stages for profiling
*/
ierr = PetscLogStageRegister("Prelim setup",&stages[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Linear System 1",&stages[1]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Linear System 2",&stages[2]);CHKERRQ(ierr);
/*
Register a user-defined event for profiling (error checking).
*/
CHECK_ERROR = 0;
ierr = PetscLogEventRegister("Check Error",KSP_CLASSID,&CHECK_ERROR);CHKERRQ(ierr);
/* - - - - - - - - - - - - Stage 0: - - - - - - - - - - - - - -
Preliminary Setup
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscLogStagePush(stages[0]);CHKERRQ(ierr);
/*
Create data structures for first linear system.
- Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
- Create parallel vectors.
- When using VecSetSizes(), we specify only the vector's global
dimension; the parallel partitioning is determined at runtime.
- Note: We form 1 vector from scratch and then duplicate as needed.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&C1);CHKERRQ(ierr);
ierr = MatSetSizes(C1,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C1);CHKERRQ(ierr);
ierr = MatSetUp(C1);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C1,&Istart,&Iend);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,m*n);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b1);CHKERRQ(ierr);
ierr = VecDuplicate(u,&x1);CHKERRQ(ierr);
/*
Create first linear solver context.
Set runtime options (e.g., -pc_type <type>).
Note that the first linear system uses the default option
names, while the second linear systme uses a different
options prefix.
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp1);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp1);CHKERRQ(ierr);
/*
Set user-defined monitoring routine for first linear system.
*/
ierr = PetscOptionsGetBool(PETSC_NULL,"-my_ksp_monitor",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {ierr = KSPMonitorSet(ksp1,MyKSPMonitor,PETSC_NULL,0);CHKERRQ(ierr);}
/*
Create data structures for second linear system.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&C2);CHKERRQ(ierr);
ierr = MatSetSizes(C2,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C2);CHKERRQ(ierr);
ierr = MatSetUp(C2);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C2,&Istart2,&Iend2);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b2);CHKERRQ(ierr);
ierr = VecDuplicate(u,&x2);CHKERRQ(ierr);
/*
Create second linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp2);CHKERRQ(ierr);
/*
Set different options prefix for second linear system.
Set runtime options (e.g., -s2_pc_type <type>)
*/
ierr = KSPAppendOptionsPrefix(ksp2,"s2_");CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp2);CHKERRQ(ierr);
/*
Assemble exact solution vector in parallel. Note that each
processor needs to set only its local part of the vector.
*/
ierr = VecGetLocalSize(u,&ldim);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(u,&low,&high);CHKERRQ(ierr);
for (i=0; i<ldim; i++) {
iglobal = i + low;
v = (PetscScalar)(i + 100*rank);
ierr = VecSetValues(u,1,&iglobal,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(u);CHKERRQ(ierr);
ierr = VecAssemblyEnd(u);CHKERRQ(ierr);
/*
Log the number of flops for computing vector entries
*/
ierr = PetscLogFlops(2.0*ldim);CHKERRQ(ierr);
/*
End curent profiling stage
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* --------------------------------------------------------------
Linear solver loop:
Solve 2 different linear systems several times in succession
-------------------------------------------------------------- */
for (t=0; t<ntimes; t++) {
/* - - - - - - - - - - - - Stage 1: - - - - - - - - - - - - - -
Assemble and solve first linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Begin profiling stage #1
*/
ierr = PetscLogStagePush(stages[1]);CHKERRQ(ierr);
/*
Initialize all matrix entries to zero. MatZeroEntries() retains
the nonzero structure of the matrix for sparse formats.
*/
if (t > 0) {ierr = MatZeroEntries(C1);CHKERRQ(ierr);}
/*
Set matrix entries in parallel. Also, log the number of flops
for computing matrix entries.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global row and columns of matrix entries.
*/
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(C1,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
for (Ii=Istart; Ii<Iend; Ii++) { /* Make matrix nonsymmetric */
v = -1.0*(t+0.5); i = Ii/n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
}
ierr = PetscLogFlops(2.0*(Iend-Istart));CHKERRQ(ierr);
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Indicate same nonzero structure of successive linear system matrices
*/
ierr = MatSetOption(C1,MAT_NEW_NONZERO_LOCATIONS,PETSC_TRUE);CHKERRQ(ierr);
/*
Compute right-hand-side vector
*/
ierr = MatMult(C1,u,b1);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
- The flag SAME_NONZERO_PATTERN indicates that the
preconditioning matrix has identical nonzero structure
as during the last linear solve (although the values of
the entries have changed). Thus, we can save some
work in setting up the preconditioner (e.g., no need to
redo symbolic factorization for ILU/ICC preconditioners).
- If the nonzero structure of the matrix is different during
the second linear solve, then the flag DIFFERENT_NONZERO_PATTERN
must be used instead. If you are unsure whether the
matrix structure has changed or not, use the flag
DIFFERENT_NONZERO_PATTERN.
- Caution: If you specify SAME_NONZERO_PATTERN, PETSc
believes your assertion and does not check the structure
of the matrix. If you erroneously claim that the structure
is the same when it actually is not, the new preconditioner
will not function correctly. Thus, use this optimization
feature with caution!
*/
ierr = KSPSetOperators(ksp1,C1,C1,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Use the previous solution of linear system #1 as the initial
guess for the next solve of linear system #1. The user MUST
call KSPSetInitialGuessNonzero() in indicate use of an initial
guess vector; otherwise, an initial guess of zero is used.
*/
if (t>0) {
ierr = KSPSetInitialGuessNonzero(ksp1,PETSC_TRUE);CHKERRQ(ierr);
}
/*
Solve the first linear system. Here we explicitly call
KSPSetUp() for more detailed performance monitoring of
certain preconditioners, such as ICC and ILU. This call
is optional, ase KSPSetUp() will automatically be called
within KSPSolve() if it hasn't been called already.
*/
ierr = KSPSetUp(ksp1);CHKERRQ(ierr);
ierr = KSPSolve(ksp1,b1,x1);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp1,&its);CHKERRQ(ierr);
/*
Check error of solution to first linear system
*/
ierr = CheckError(u,x1,b1,its,1.e-4,CHECK_ERROR);CHKERRQ(ierr);
/* - - - - - - - - - - - - Stage 2: - - - - - - - - - - - - - -
Assemble and solve second linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Conclude profiling stage #1; begin profiling stage #2
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stages[2]);CHKERRQ(ierr);
/*
Initialize all matrix entries to zero
*/
if (t > 0) {ierr = MatZeroEntries(C2);CHKERRQ(ierr);}
/*
Assemble matrix in parallel. Also, log the number of flops
for computing matrix entries.
- To illustrate the features of parallel matrix assembly, we
intentionally set the values differently from the way in
which the matrix is distributed across the processors. Each
entry that is not owned locally will be sent to the appropriate
processor during MatAssemblyBegin() and MatAssemblyEnd().
- For best efficiency the user should strive to set as many
entries locally as possible.
*/
for (i=0; i<m; i++) {
for (j=2*rank; j<2*rank+2; j++) {
v = -1.0; Ii = j + n*i;
if (i>0) {J = Ii - n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 6.0 + t*0.5; ierr = MatSetValues(C2,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
}
for (Ii=Istart2; Ii<Iend2; Ii++) { /* Make matrix nonsymmetric */
v = -1.0*(t+0.5); i = Ii/n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
}
ierr = MatAssemblyBegin(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(2.0*(Iend-Istart));CHKERRQ(ierr);
/*
Indicate same nonzero structure of successive linear system matrices
*/
ierr = MatSetOption(C2,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr);
/*
Compute right-hand-side vector
*/
ierr = MatMult(C2,u,b2);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix. Indicate same nonzero
structure of successive preconditioner matrices by setting flag
SAME_NONZERO_PATTERN.
*/
ierr = KSPSetOperators(ksp2,C2,C2,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Solve the second linear system
*/
ierr = KSPSetUp(ksp2);CHKERRQ(ierr);
ierr = KSPSolve(ksp2,b2,x2);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp2,&its);CHKERRQ(ierr);
/*
Check error of solution to second linear system
*/
ierr = CheckError(u,x2,b2,its,1.e-4,CHECK_ERROR);CHKERRQ(ierr);
/*
Conclude profiling stage #2
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
}
/* --------------------------------------------------------------
End of linear solver loop
-------------------------------------------------------------- */
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp1);CHKERRQ(ierr); ierr = KSPDestroy(&ksp2);CHKERRQ(ierr);
ierr = VecDestroy(&x1);CHKERRQ(ierr); ierr = VecDestroy(&x2);CHKERRQ(ierr);
ierr = VecDestroy(&b1);CHKERRQ(ierr); ierr = VecDestroy(&b2);CHKERRQ(ierr);
ierr = MatDestroy(&C1);CHKERRQ(ierr); ierr = MatDestroy(&C2);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscReal norm; /* norm of solution error */
PetscInt dim,i,j,Ii,J,Istart,Iend,n = 6,its,use_random;
PetscErrorCode ierr;
PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa;
PetscRandom rctx;
PetscReal h2,sigma1 = 100.0;
PetscBool flg = PETSC_FALSE;
PetscScalar a = 1.0+PETSC_i;
PetscInitialize(&argc,&args,(char*)0,help);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,1,"This example requires complex numbers");
#endif
a=1.0+PETSC_i;
printf("%g+%gi\n",(double)PetscRealPart(a),(double)PetscImaginaryPart(a));
ierr = PetscOptionsGetReal(NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
dim = n*n;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors. Determine which
rows of the matrix are locally owned.
*/
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
/*
Set matrix elements in parallel.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global rows and columns of matrix entries.
*/
ierr = PetscOptionsGetBool(NULL,"-norandom",&flg,NULL);CHKERRQ(ierr);
if (flg) use_random = 0;
else use_random = 1;
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
} else {
sigma2 = 10.0*PETSC_i;
}
h2 = 1.0/((n+1)*(n+1));
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);}
v = 4.0 - sigma1*h2 + sigma2*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors.
- When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
we specify only the vector's global
dimension; the parallel partitioning is determined at runtime.
- Note: We form 1 vector from scratch and then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,dim);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
} else {
ierr = VecSet(u,pfive);CHKERRQ(ierr);
}
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Print the first 3 entries of x; this demonstrates extraction of the
real and imaginary components of the complex vector, x.
*/
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-print_x3",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = VecGetArray(x,&xa);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"The first three entries of x are:\n");CHKERRQ(ierr);
for (i=0; i<3; i++) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"x[%D] = %g + %g i\n",i,(double)PetscRealPart(xa[i]),(double)PetscImaginaryPart(xa[i]));CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xa);CHKERRQ(ierr);
}
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g iterations %D\n",(double)norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*@C
VecInitializePackage - This function initializes everything in the Vec package. It is called
from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to VecCreate()
when using static libraries.
Level: developer
.keywords: Vec, initialize, package
.seealso: PetscInitialize()
@*/
PetscErrorCode VecInitializePackage(void)
{
char logList[256];
char *className;
PetscBool opt;
PetscErrorCode ierr;
PetscInt i;
PetscFunctionBegin;
if (VecPackageInitialized) PetscFunctionReturn(0);
VecPackageInitialized = PETSC_TRUE;
/* Register Classes */
ierr = PetscClassIdRegister("Vector",&VEC_CLASSID);CHKERRQ(ierr);
ierr = PetscClassIdRegister("Vector Scatter",&VEC_SCATTER_CLASSID);CHKERRQ(ierr);
/* Register Constructors */
ierr = VecRegisterAll();CHKERRQ(ierr);
/* Register Events */
ierr = PetscLogEventRegister("VecView", VEC_CLASSID,&VEC_View);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMax", VEC_CLASSID,&VEC_Max);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMin", VEC_CLASSID,&VEC_Min);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecDotBarrier", VEC_CLASSID,&VEC_DotBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecDot", VEC_CLASSID,&VEC_Dot);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecDotNormBarr", VEC_CLASSID,&VEC_DotNormBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecDotNorm2", VEC_CLASSID,&VEC_DotNorm);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMDotBarrier", VEC_CLASSID,&VEC_MDotBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMDot", VEC_CLASSID,&VEC_MDot);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecTDot", VEC_CLASSID,&VEC_TDot);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMTDot", VEC_CLASSID,&VEC_MTDot);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecNormBarrier", VEC_CLASSID,&VEC_NormBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecNorm", VEC_CLASSID,&VEC_Norm);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecScale", VEC_CLASSID,&VEC_Scale);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecCopy", VEC_CLASSID,&VEC_Copy);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecSet", VEC_CLASSID,&VEC_Set);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecAXPY", VEC_CLASSID,&VEC_AXPY);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecAYPX", VEC_CLASSID,&VEC_AYPX);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecAXPBYCZ", VEC_CLASSID,&VEC_AXPBYPCZ);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecWAXPY", VEC_CLASSID,&VEC_WAXPY);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecMAXPY", VEC_CLASSID,&VEC_MAXPY);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecSwap", VEC_CLASSID,&VEC_Swap);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecOps", VEC_CLASSID,&VEC_Ops);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecAssemblyBegin", VEC_CLASSID,&VEC_AssemblyBegin);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecAssemblyEnd", VEC_CLASSID,&VEC_AssemblyEnd);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecPointwiseMult", VEC_CLASSID,&VEC_PointwiseMult);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecSetValues", VEC_CLASSID,&VEC_SetValues);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecLoad", VEC_CLASSID,&VEC_Load);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecScatterBarrie", VEC_CLASSID,&VEC_ScatterBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecScatterBegin", VEC_CLASSID,&VEC_ScatterBegin);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecScatterEnd", VEC_CLASSID,&VEC_ScatterEnd);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecSetRandom", VEC_CLASSID,&VEC_SetRandom);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecReduceArith", VEC_CLASSID,&VEC_ReduceArithmetic);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecReduceBarrier", VEC_CLASSID,&VEC_ReduceBarrier);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecReduceComm", VEC_CLASSID,&VEC_ReduceCommunication);CHKERRQ(ierr); /* must follow barrier */
ierr = PetscLogEventRegister("VecReduceBegin", VEC_CLASSID,&VEC_ReduceBegin);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecReduceEnd", VEC_CLASSID,&VEC_ReduceEnd);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecNormalize", VEC_CLASSID,&VEC_Normalize);CHKERRQ(ierr);
#if defined(PETSC_HAVE_CUSP)
ierr = PetscLogEventRegister("VecCUSPCopyTo", VEC_CLASSID,&VEC_CUSPCopyToGPU);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecCUSPCopyFrom", VEC_CLASSID,&VEC_CUSPCopyFromGPU);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecCopyToSome", VEC_CLASSID,&VEC_CUSPCopyToGPUSome);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecCopyFromSome", VEC_CLASSID,&VEC_CUSPCopyFromGPUSome);CHKERRQ(ierr);
#endif
#if defined(PETSC_HAVE_VIENNACL)
ierr = PetscLogEventRegister("VecViennaCLCopyTo", VEC_CLASSID,&VEC_ViennaCLCopyToGPU);CHKERRQ(ierr);
ierr = PetscLogEventRegister("VecViennaCLCopyFrom", VEC_CLASSID,&VEC_ViennaCLCopyFromGPU);CHKERRQ(ierr);
#endif
/* Turn off high traffic events by default */
ierr = PetscLogEventSetActiveAll(VEC_DotBarrier, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_DotNormBarrier, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_MDotBarrier, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_NormBarrier, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_SetValues, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_ScatterBarrier, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_ReduceBarrier, PETSC_FALSE);CHKERRQ(ierr);
/* Process info exclusions */
ierr = PetscOptionsGetString(NULL, "-info_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "vec", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscInfoDeactivateClass(VEC_CLASSID);CHKERRQ(ierr);
}
}
/* Process summary exclusions */
ierr = PetscOptionsGetString(NULL, "-log_summary_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "vec", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscLogEventDeactivateClass(VEC_CLASSID);CHKERRQ(ierr);
}
}
/* Special processing */
opt = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL, "-log_sync", &opt,NULL);CHKERRQ(ierr);
if (opt) {
ierr = PetscLogEventSetActiveAll(VEC_ScatterBarrier, PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_NormBarrier, PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_DotBarrier, PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_DotNormBarrier, PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_MDotBarrier, PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogEventSetActiveAll(VEC_ReduceBarrier, PETSC_TRUE);CHKERRQ(ierr);
}
/*
Create the special MPI reduction operation that may be used by VecNorm/DotBegin()
*/
ierr = MPI_Op_create(PetscSplitReduction_Local,1,&PetscSplitReduction_Op);CHKERRQ(ierr);
ierr = MPI_Op_create(VecMax_Local,2,&VecMax_Local_Op);CHKERRQ(ierr);
ierr = MPI_Op_create(VecMin_Local,2,&VecMin_Local_Op);CHKERRQ(ierr);
/* Register the different norm types for cached norms */
for (i=0; i<4; i++) {
ierr = PetscObjectComposedDataRegister(NormIds+i);CHKERRQ(ierr);
}
/* Register finalization routine */
ierr = PetscRegisterFinalize(VecFinalizePackage);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank;
PetscInt M=8,dof=1,stencil_width=1,i,start,end,P=5,N = 6,m=PETSC_DECIDE,n=PETSC_DECIDE,p=PETSC_DECIDE,pt = 0,st = 0;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE,flg2,flg3;
DMDABoundaryType periodic;
DMDAStencilType stencil_type;
DM da;
Vec local,global,local_copy;
PetscScalar value;
PetscReal norm,work;
PetscViewer viewer;
char filename[64];
FILE *file;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-M",&M,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-N",&N,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-dof",&dof,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-stencil_width",&stencil_width,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-periodic",&pt,NULL);CHKERRQ(ierr);
periodic = (DMDABoundaryType) pt;
ierr = PetscOptionsGetInt(NULL,"-stencil_type",&st,NULL);CHKERRQ(ierr);
stencil_type = (DMDAStencilType) st;
ierr = PetscOptionsHasName(NULL,"-2d",&flg2);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-3d",&flg3);CHKERRQ(ierr);
if (flg2) {
ierr = DMDACreate2d(PETSC_COMM_WORLD,periodic,periodic,stencil_type,M,N,m,n,dof,stencil_width,
NULL,NULL,&da);CHKERRQ(ierr);
} else if (flg3) {
ierr = DMDACreate3d(PETSC_COMM_WORLD,periodic,periodic,periodic,stencil_type,M,N,P,m,n,p,dof,stencil_width,
NULL,NULL,NULL,&da);CHKERRQ(ierr);
} else {
ierr = DMDACreate1d(PETSC_COMM_WORLD,periodic,M,dof,stencil_width,NULL,&da);CHKERRQ(ierr);
}
ierr = DMCreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DMCreateLocalVector(da,&local);CHKERRQ(ierr);
ierr = VecDuplicate(local,&local_copy);CHKERRQ(ierr);
/* zero out vectors so that ghostpoints are zero */
value = 0;
ierr = VecSet(local,value);CHKERRQ(ierr);
ierr = VecSet(local_copy,value);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(global,&start,&end);CHKERRQ(ierr);
for (i=start; i<end; i++) {
value = i + 1;
ierr = VecSetValues(global,1,&i,&value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(global);CHKERRQ(ierr);
ierr = VecAssemblyEnd(global);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DMDALocalToLocalBegin(da,local,INSERT_VALUES,local_copy);CHKERRQ(ierr);
ierr = DMDALocalToLocalEnd(da,local,INSERT_VALUES,local_copy);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-save",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
sprintf(filename,"local.%d",rank);
ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIGetPointer(viewer,&file);CHKERRQ(ierr);
ierr = VecView(local,viewer);CHKERRQ(ierr);
fprintf(file,"Vector with correct ghost points\n");
ierr = VecView(local_copy,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
ierr = VecAXPY(local_copy,-1.0,local);CHKERRQ(ierr);
ierr = VecNorm(local_copy,NORM_MAX,&work);CHKERRQ(ierr);
ierr = MPI_Allreduce(&work,&norm,1,MPIU_REAL,MPIU_MAX,PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of difference %G should be zero\n",norm);CHKERRQ(ierr);
ierr = VecDestroy(&local_copy);CHKERRQ(ierr);
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
Vec x, b, u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PC pc; /* preconditioner context */
PetscReal norm; /* norm of solution error */
PetscErrorCode ierr;
PetscInt i,n = 10,col[3],its;
PetscMPIInt size;
PetscScalar one = 1.0,value[3];
PetscBool nonzeroguess = PETSC_FALSE;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor example only!");
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-nonzero_guess",&nonzeroguess,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create vectors. Note that we form 1 vector from scratch and
then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, "Solution");CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr);
/*
Create matrix. When using MatCreate(), the matrix format can
be specified at runtime.
Performance tuning note: For problems of substantial size,
preallocation of matrix memory is crucial for attaining good
performance. See the matrix chapter of the users manual for details.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Assemble matrix
*/
value[0] = -1.0; value[1] = 2.0; value[2] = -1.0;
for (i=1; i<n-1; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
i = n - 1; col[0] = n - 2; col[1] = n - 1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
ierr = VecSet(u,one);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
/*
Set linear solver defaults for this problem (optional).
- By extracting the KSP and PC contexts from the KSP context,
we can then directly call any KSP and PC routines to set
various options.
- The following four statements are optional; all of these
parameters could alternatively be specified at runtime via
KSPSetFromOptions();
*/
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,1.e-5,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
These options will override those specified above as long as
KSPSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
if (nonzeroguess) {
PetscScalar p = .5;
ierr = VecSet(x,p);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Solve linear system
*/
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/*
View solver info; we could instead use the option -ksp_view to
print this info to the screen at the conclusion of KSPSolve().
*/
ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g, Iterations %D\n",(double)norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_view).
*/
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode VecView_MPI_Draw_DA1d(Vec xin,PetscViewer v)
{
DM da;
PetscErrorCode ierr;
PetscMPIInt rank,size,tag1,tag2;
PetscInt i,n,N,step,istart,isize,j,nbounds;
MPI_Status status;
PetscReal coors[4],ymin,ymax,min,max,xmin = 0.0,xmax = 0.0,tmp = 0.0,xgtmp = 0.0;
const PetscScalar *array,*xg;
PetscDraw draw;
PetscBool isnull,showpoints = PETSC_FALSE;
MPI_Comm comm;
PetscDrawAxis axis;
Vec xcoor;
DMBoundaryType bx;
const PetscReal *bounds;
PetscInt *displayfields;
PetscInt k,ndisplayfields;
PetscBool hold;
PetscFunctionBegin;
ierr = PetscViewerDrawGetDraw(v,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0);
ierr = PetscViewerDrawGetBounds(v,&nbounds,&bounds);CHKERRQ(ierr);
ierr = VecGetDM(xin,&da);CHKERRQ(ierr);
if (!da) SETERRQ(PetscObjectComm((PetscObject)xin),PETSC_ERR_ARG_WRONG,"Vector not generated from a DMDA");
ierr = PetscOptionsGetBool(NULL,"-draw_vec_mark_points",&showpoints,NULL);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&N,0,0,0,0,0,&step,0,&bx,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&istart,0,0,&isize,0,0);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&array);CHKERRQ(ierr);
ierr = VecGetLocalSize(xin,&n);CHKERRQ(ierr);
n = n/step;
/* get coordinates of nodes */
ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr);
if (!xcoor) {
ierr = DMDASetUniformCoordinates(da,0.0,1.0,0.0,0.0,0.0,0.0);CHKERRQ(ierr);
ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr);
}
ierr = VecGetArrayRead(xcoor,&xg);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)xin,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/*
Determine the min and max x coordinate in plot
*/
if (!rank) {
xmin = PetscRealPart(xg[0]);
}
if (rank == size-1) {
xmax = PetscRealPart(xg[n-1]);
}
ierr = MPI_Bcast(&xmin,1,MPIU_REAL,0,comm);CHKERRQ(ierr);
ierr = MPI_Bcast(&xmax,1,MPIU_REAL,size-1,comm);CHKERRQ(ierr);
ierr = DMDASelectFields(da,&ndisplayfields,&displayfields);CHKERRQ(ierr);
for (k=0; k<ndisplayfields; k++) {
j = displayfields[k];
ierr = PetscViewerDrawGetDraw(v,k,&draw);CHKERRQ(ierr);
ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr);
/*
Determine the min and max y coordinate in plot
*/
min = 1.e20; max = -1.e20;
for (i=0; i<n; i++) {
if (PetscRealPart(array[j+i*step]) < min) min = PetscRealPart(array[j+i*step]);
if (PetscRealPart(array[j+i*step]) > max) max = PetscRealPart(array[j+i*step]);
}
if (min + 1.e-10 > max) {
min -= 1.e-5;
max += 1.e-5;
}
if (j < nbounds) {
min = PetscMin(min,bounds[2*j]);
max = PetscMax(max,bounds[2*j+1]);
}
ierr = MPI_Reduce(&min,&ymin,1,MPIU_REAL,MPIU_MIN,0,comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&max,&ymax,1,MPIU_REAL,MPIU_MAX,0,comm);CHKERRQ(ierr);
ierr = PetscViewerDrawGetHold(v,&hold);CHKERRQ(ierr);
if (!hold) {
ierr = PetscDrawSynchronizedClear(draw);CHKERRQ(ierr);
}
ierr = PetscViewerDrawGetDrawAxis(v,k,&axis);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)draw,(PetscObject)axis);CHKERRQ(ierr);
if (!rank) {
const char *title;
ierr = PetscDrawAxisSetLimits(axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(axis);CHKERRQ(ierr);
ierr = PetscDrawGetCoordinates(draw,coors,coors+1,coors+2,coors+3);CHKERRQ(ierr);
ierr = DMDAGetFieldName(da,j,&title);CHKERRQ(ierr);
if (title) {ierr = PetscDrawSetTitle(draw,title);CHKERRQ(ierr);}
}
ierr = MPI_Bcast(coors,4,MPIU_REAL,0,comm);CHKERRQ(ierr);
if (rank) {
ierr = PetscDrawSetCoordinates(draw,coors[0],coors[1],coors[2],coors[3]);CHKERRQ(ierr);
}
/* draw local part of vector */
ierr = PetscObjectGetNewTag((PetscObject)xin,&tag1);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)xin,&tag2);CHKERRQ(ierr);
if (rank < size-1) { /*send value to right */
ierr = MPI_Send((void*)&array[j+(n-1)*step],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr);
ierr = MPI_Send((void*)&xg[n-1],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr);
}
if (!rank && bx == DM_BOUNDARY_PERIODIC && size > 1) { /* first processor sends first value to last */
ierr = MPI_Send((void*)&array[j],1,MPIU_REAL,size-1,tag2,comm);CHKERRQ(ierr);
}
for (i=1; i<n; i++) {
ierr = PetscDrawLine(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PetscRealPart(xg[i]),PetscRealPart(array[j+step*i]),PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
if (rank) { /* receive value from left */
ierr = MPI_Recv(&tmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr);
ierr = MPI_Recv(&xgtmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xgtmp,tmp,PetscRealPart(xg[0]),PetscRealPart(array[j]),PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,xgtmp,tmp,PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
if (rank == size-1 && bx == DM_BOUNDARY_PERIODIC && size > 1) {
ierr = MPI_Recv(&tmp,1,MPIU_REAL,0,tag2,comm,&status);CHKERRQ(ierr);
/* If the mesh is not uniform we do not know the mesh spacing between the last point on the right and the first ghost point */
ierr = PetscDrawLine(draw,PetscRealPart(xg[n-1]),PetscRealPart(array[j+step*(n-1)]),PetscRealPart(xg[n-1]+(xg[n-1]-xg[n-2])),tmp,PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,PetscRealPart(xg[n-2]),PetscRealPart(array[j+step*(n-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
ierr = PetscDrawSynchronizedFlush(draw);CHKERRQ(ierr);
ierr = PetscDrawPause(draw);CHKERRQ(ierr);
}
ierr = PetscFree(displayfields);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xcoor,&xg);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xin,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCSetUp_MG(PC pc)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt i,n = mglevels[0]->levels;
PC cpc;
PetscBool dump = PETSC_FALSE,opsset,use_amat,missinginterpolate = PETSC_FALSE;
Mat dA,dB;
Vec tvec;
DM *dms;
PetscViewer viewer = 0;
PetscFunctionBegin;
/* FIX: Move this to PCSetFromOptions_MG? */
if (mg->usedmfornumberoflevels) {
PetscInt levels;
ierr = DMGetRefineLevel(pc->dm,&levels);CHKERRQ(ierr);
levels++;
if (levels > n) { /* the problem is now being solved on a finer grid */
ierr = PCMGSetLevels(pc,levels,NULL);CHKERRQ(ierr);
n = levels;
ierr = PCSetFromOptions(pc);CHKERRQ(ierr); /* it is bad to call this here, but otherwise will never be called for the new hierarchy */
mglevels = mg->levels;
}
}
ierr = KSPGetPC(mglevels[0]->smoothd,&cpc);CHKERRQ(ierr);
/* If user did not provide fine grid operators OR operator was not updated since last global KSPSetOperators() */
/* so use those from global PC */
/* Is this what we always want? What if user wants to keep old one? */
ierr = KSPGetOperatorsSet(mglevels[n-1]->smoothd,NULL,&opsset);CHKERRQ(ierr);
if (opsset) {
Mat mmat;
ierr = KSPGetOperators(mglevels[n-1]->smoothd,NULL,&mmat);CHKERRQ(ierr);
if (mmat == pc->pmat) opsset = PETSC_FALSE;
}
if (!opsset) {
ierr = PCGetUseAmat(pc,&use_amat);CHKERRQ(ierr);
if(use_amat){
ierr = PetscInfo(pc,"Using outer operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->mat,pc->pmat);CHKERRQ(ierr);
}
else {
ierr = PetscInfo(pc,"Using matrix (pmat) operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->pmat,pc->pmat);CHKERRQ(ierr);
}
}
for (i=n-1; i>0; i--) {
if (!(mglevels[i]->interpolate || mglevels[i]->restrct)) {
missinginterpolate = PETSC_TRUE;
continue;
}
}
/*
Skipping if user has provided all interpolation/restriction needed (since DM might not be able to produce them (when coming from SNES/TS)
Skipping for galerkin==2 (externally managed hierarchy such as ML and GAMG). Cleaner logic here would be great. Wrap ML/GAMG as DMs?
*/
if (missinginterpolate && pc->dm && mg->galerkin != 2 && !pc->setupcalled) {
/* construct the interpolation from the DMs */
Mat p;
Vec rscale;
ierr = PetscMalloc1(n,&dms);CHKERRQ(ierr);
dms[n-1] = pc->dm;
/* Separately create them so we do not get DMKSP interference between levels */
for (i=n-2; i>-1; i--) {ierr = DMCoarsen(dms[i+1],MPI_COMM_NULL,&dms[i]);CHKERRQ(ierr);}
for (i=n-2; i>-1; i--) {
DMKSP kdm;
PetscBool dmhasrestrict;
ierr = KSPSetDM(mglevels[i]->smoothd,dms[i]);CHKERRQ(ierr);
if (mg->galerkin) {ierr = KSPSetDMActive(mglevels[i]->smoothd,PETSC_FALSE);CHKERRQ(ierr);}
ierr = DMGetDMKSPWrite(dms[i],&kdm);CHKERRQ(ierr);
/* Ugly hack so that the next KSPSetUp() will use the RHS that we set. A better fix is to change dmActive to take
* a bitwise OR of computing the matrix, RHS, and initial iterate. */
kdm->ops->computerhs = NULL;
kdm->rhsctx = NULL;
if (!mglevels[i+1]->interpolate) {
ierr = DMCreateInterpolation(dms[i],dms[i+1],&p,&rscale);CHKERRQ(ierr);
ierr = PCMGSetInterpolation(pc,i+1,p);CHKERRQ(ierr);
if (rscale) {ierr = PCMGSetRScale(pc,i+1,rscale);CHKERRQ(ierr);}
ierr = VecDestroy(&rscale);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
ierr = DMHasCreateRestriction(dms[i],&dmhasrestrict);CHKERRQ(ierr);
if (dmhasrestrict && !mglevels[i+1]->restrct){
ierr = DMCreateRestriction(dms[i],dms[i+1],&p);CHKERRQ(ierr);
ierr = PCMGSetRestriction(pc,i+1,p);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
}
for (i=n-2; i>-1; i--) {ierr = DMDestroy(&dms[i]);CHKERRQ(ierr);}
ierr = PetscFree(dms);CHKERRQ(ierr);
}
if (pc->dm && !pc->setupcalled) {
/* finest smoother also gets DM but it is not active, independent of whether galerkin==2 */
ierr = KSPSetDM(mglevels[n-1]->smoothd,pc->dm);CHKERRQ(ierr);
ierr = KSPSetDMActive(mglevels[n-1]->smoothd,PETSC_FALSE);CHKERRQ(ierr);
}
if (mg->galerkin == 1) {
Mat B;
/* currently only handle case where mat and pmat are the same on coarser levels */
ierr = KSPGetOperators(mglevels[n-1]->smoothd,&dA,&dB);CHKERRQ(ierr);
if (!pc->setupcalled) {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
if (i != n-2) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
dB = B;
}
if (n > 1) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
} else {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&B);CHKERRQ(ierr);
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
dB = B;
}
}
} else if (!mg->galerkin && pc->dm && pc->dm->x) {
/* need to restrict Jacobian location to coarser meshes for evaluation */
for (i=n-2; i>-1; i--) {
Mat R;
Vec rscale;
if (!mglevels[i]->smoothd->dm->x) {
Vec *vecs;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vecs,0,NULL);CHKERRQ(ierr);
mglevels[i]->smoothd->dm->x = vecs[0];
ierr = PetscFree(vecs);CHKERRQ(ierr);
}
ierr = PCMGGetRestriction(pc,i+1,&R);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
ierr = MatRestrict(R,mglevels[i+1]->smoothd->dm->x,mglevels[i]->smoothd->dm->x);CHKERRQ(ierr);
ierr = VecPointwiseMult(mglevels[i]->smoothd->dm->x,mglevels[i]->smoothd->dm->x,rscale);CHKERRQ(ierr);
}
}
if (!mg->galerkin && pc->dm) {
for (i=n-2; i>=0; i--) {
DM dmfine,dmcoarse;
Mat Restrict,Inject;
Vec rscale;
ierr = KSPGetDM(mglevels[i+1]->smoothd,&dmfine);CHKERRQ(ierr);
ierr = KSPGetDM(mglevels[i]->smoothd,&dmcoarse);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i+1,&Restrict);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
Inject = NULL; /* Callback should create it if it needs Injection */
ierr = DMRestrict(dmfine,Restrict,rscale,Inject,dmcoarse);CHKERRQ(ierr);
}
}
if (!pc->setupcalled) {
for (i=0; i<n; i++) {
ierr = KSPSetFromOptions(mglevels[i]->smoothd);CHKERRQ(ierr);
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && (mglevels[i]->smoothu != mglevels[i]->smoothd)) {
ierr = KSPSetFromOptions(mglevels[i]->smoothu);CHKERRQ(ierr);
}
}
/* insure that if either interpolation or restriction is set the other other one is set */
for (i=1; i<n; i++) {
ierr = PCMGGetInterpolation(pc,i,NULL);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i,NULL);CHKERRQ(ierr);
}
for (i=0; i<n-1; i++) {
if (!mglevels[i]->b) {
Vec *vec;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetRhs(pc,i,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
if (!mglevels[i]->r && i) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetR(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
if (!mglevels[i]->x) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetX(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
}
if (n != 1 && !mglevels[n-1]->r) {
/* PCMGSetR() on the finest level if user did not supply it */
Vec *vec;
ierr = KSPCreateVecs(mglevels[n-1]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetR(pc,n-1,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
}
if (pc->dm) {
/* need to tell all the coarser levels to rebuild the matrix using the DM for that level */
for (i=0; i<n-1; i++) {
if (mglevels[i]->smoothd->setupstage != KSP_SETUP_NEW) mglevels[i]->smoothd->setupstage = KSP_SETUP_NEWMATRIX;
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu == mglevels[i]->smoothd || mg->am == PC_MG_FULL || mg->am == PC_MG_KASKADE || mg->cyclesperpcapply > 1){
/* if doing only down then initial guess is zero */
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothd,PETSC_TRUE);CHKERRQ(ierr);
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothd);CHKERRQ(ierr);
if (mglevels[i]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
if (!mglevels[i]->residual) {
Mat mat;
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&mat);CHKERRQ(ierr);
ierr = PCMGSetResidual(pc,i,PCMGResidualDefault,mat);CHKERRQ(ierr);
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && mglevels[i]->smoothu != mglevels[i]->smoothd) {
Mat downmat,downpmat;
/* check if operators have been set for up, if not use down operators to set them */
ierr = KSPGetOperatorsSet(mglevels[i]->smoothu,&opsset,NULL);CHKERRQ(ierr);
if (!opsset) {
ierr = KSPGetOperators(mglevels[i]->smoothd,&downmat,&downpmat);CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[i]->smoothu,downmat,downpmat);CHKERRQ(ierr);
}
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothu,PETSC_TRUE);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothu);CHKERRQ(ierr);
if (mglevels[i]->smoothu->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
}
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[0]->smoothd);CHKERRQ(ierr);
if (mglevels[0]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
/*
Dump the interpolation/restriction matrices plus the
Jacobian/stiffness on each level. This allows MATLAB users to
easily check if the Galerkin condition A_c = R A_f R^T is satisfied.
Only support one or the other at the same time.
*/
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_matlab",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_SOCKET_(PetscObjectComm((PetscObject)pc));
dump = PETSC_FALSE;
#endif
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_binary",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_BINARY_(PetscObjectComm((PetscObject)pc));
if (viewer) {
for (i=1; i<n; i++) {
ierr = MatView(mglevels[i]->restrct,viewer);CHKERRQ(ierr);
}
for (i=0; i<n; i++) {
ierr = KSPGetPC(mglevels[i]->smoothd,&pc);CHKERRQ(ierr);
ierr = MatView(pc->mat,viewer);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
PetscInt N0=50,N1=20,N=N0*N1,DIM;
PetscRandom rdm;
PetscScalar a;
PetscReal enorm;
Vec x,y,z;
PetscBool view=PETSC_FALSE,use_interface=PETSC_TRUE;
ierr = PetscInitialize(&argc,&args,(char*)0,help);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP, "This example requires complex numbers");
#endif
ierr = PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "FFTW Options", "ex143");CHKERRQ(ierr);
ierr = PetscOptionsBool("-vec_view draw", "View the vectors", "ex143", view, &view, NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-use_FFTW_interface", "Use PETSc-FFTW interface", "ex143",use_interface, &use_interface, NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-use_FFTW_interface",&use_interface,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD, &rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
if (!use_interface) {
/* Use mpi FFTW without PETSc-FFTW interface, 2D case only */
/*---------------------------------------------------------*/
fftw_plan fplan,bplan;
fftw_complex *data_in,*data_out,*data_out2;
ptrdiff_t alloc_local,local_n0,local_0_start;
DIM = 2;
if (!rank) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Use FFTW without PETSc-FFTW interface, DIM %D\n",DIM);CHKERRQ(ierr);
}
fftw_mpi_init();
N = N0*N1;
alloc_local = fftw_mpi_local_size_2d(N0,N1,PETSC_COMM_WORLD,&local_n0,&local_0_start);
data_in = (fftw_complex*)fftw_malloc(sizeof(fftw_complex)*alloc_local);
data_out = (fftw_complex*)fftw_malloc(sizeof(fftw_complex)*alloc_local);
data_out2 = (fftw_complex*)fftw_malloc(sizeof(fftw_complex)*alloc_local);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,1,(PetscInt)local_n0*N1,(PetscInt)N,(const PetscScalar*)data_in,&x);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, "Real Space vector");CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,1,(PetscInt)local_n0*N1,(PetscInt)N,(const PetscScalar*)data_out,&y);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) y, "Frequency space vector");CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,1,(PetscInt)local_n0*N1,(PetscInt)N,(const PetscScalar*)data_out2,&z);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) z, "Reconstructed vector");CHKERRQ(ierr);
fplan = fftw_mpi_plan_dft_2d(N0,N1,data_in,data_out,PETSC_COMM_WORLD,FFTW_FORWARD,FFTW_ESTIMATE);
bplan = fftw_mpi_plan_dft_2d(N0,N1,data_out,data_out2,PETSC_COMM_WORLD,FFTW_BACKWARD,FFTW_ESTIMATE);
ierr = VecSetRandom(x, rdm);CHKERRQ(ierr);
if (view) {ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
fftw_execute(fplan);
if (view) {ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
fftw_execute(bplan);
/* Compare x and z. FFTW computes an unnormalized DFT, thus z = N*x */
a = 1.0/(PetscReal)N;
ierr = VecScale(z,a);CHKERRQ(ierr);
if (view) {ierr = VecView(z, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
ierr = VecAXPY(z,-1.0,x);CHKERRQ(ierr);
ierr = VecNorm(z,NORM_1,&enorm);CHKERRQ(ierr);
if (enorm > 1.e-11 && !rank) {
ierr = PetscPrintf(PETSC_COMM_SELF," Error norm of |x - z| %g\n",(double)enorm);CHKERRQ(ierr);
}
/* Free spaces */
fftw_destroy_plan(fplan);
fftw_destroy_plan(bplan);
fftw_free(data_in); ierr = VecDestroy(&x);CHKERRQ(ierr);
fftw_free(data_out); ierr = VecDestroy(&y);CHKERRQ(ierr);
fftw_free(data_out2);ierr = VecDestroy(&z);CHKERRQ(ierr);
} else {
/* Use PETSc-FFTW interface */
/*-------------------------------------------*/
PetscInt i,*dim,k;
Mat A;
N=1;
for (i=1; i<5; i++) {
DIM = i;
ierr = PetscMalloc1(i,&dim);CHKERRQ(ierr);
for (k=0; k<i; k++) {
dim[k]=30;
}
N *= dim[i-1];
/* Create FFTW object */
if (!rank) printf("Use PETSc-FFTW interface...%d-DIM: %d\n",(int)DIM,(int)N);
ierr = MatCreateFFT(PETSC_COMM_WORLD,DIM,dim,MATFFTW,&A);CHKERRQ(ierr);
/* Create vectors that are compatible with parallel layout of A - must call MatCreateVecs()! */
ierr = MatCreateVecsFFTW(A,&x,&y,&z);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, "Real space vector");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) y, "Frequency space vector");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) z, "Reconstructed vector");CHKERRQ(ierr);
/* Set values of space vector x */
ierr = VecSetRandom(x,rdm);CHKERRQ(ierr);
if (view) {ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
/* Apply FFTW_FORWARD and FFTW_BACKWARD */
ierr = MatMult(A,x,y);CHKERRQ(ierr);
if (view) {ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
ierr = MatMultTranspose(A,y,z);CHKERRQ(ierr);
/* Compare x and z. FFTW computes an unnormalized DFT, thus z = N*x */
a = 1.0/(PetscReal)N;
ierr = VecScale(z,a);CHKERRQ(ierr);
if (view) {ierr = VecView(z,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
ierr = VecAXPY(z,-1.0,x);CHKERRQ(ierr);
ierr = VecNorm(z,NORM_1,&enorm);CHKERRQ(ierr);
if (enorm > 1.e-9 && !rank) {
ierr = PetscPrintf(PETSC_COMM_SELF," Error norm of |x - z| %e\n",enorm);CHKERRQ(ierr);
}
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = VecDestroy(&z);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFree(dim);CHKERRQ(ierr);
}
}
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
DM da; /* distributed array */
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscRandom rctx; /* random number generator context */
PetscReal norm; /* norm of solution error */
PetscInt i,j,its;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscLogStage stage;
DMDALocalInfo info;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
/*
Create distributed array to handle parallel distribution.
The problem size will default to 8 by 7, but this can be
changed using -da_grid_x M -da_grid_y N
*/
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,-8,-7,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create parallel matrix preallocated according to the DMDA, format AIJ by default.
To use symmetric storage, run with -dm_mat_type sbaij -mat_ignore_lower_triangular
*/
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&A);CHKERRQ(ierr);
/*
Set matrix elements for the 2-D, five-point stencil in parallel.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Rows and columns are specified by the stencil
- Entries are normalized for a domain [0,1]x[0,1]
*/
ierr = PetscLogStageRegister("Assembly", &stage);CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
for (j=info.ys; j<info.ys+info.ym; j++) {
for (i=info.xs; i<info.xs+info.xm; i++) {
PetscReal hx = 1./info.mx,hy = 1./info.my;
MatStencil row = {0},col[5] = {{0}};
PetscScalar v[5];
PetscInt ncols = 0;
row.j = j; row.i = i;
col[ncols].j = j; col[ncols].i = i; v[ncols++] = 2*(hx/hy + hy/hx);
/* boundaries */
if (i>0) {col[ncols].j = j; col[ncols].i = i-1; v[ncols++] = -hy/hx;}
if (i<info.mx-1) {col[ncols].j = j; col[ncols].i = i+1; v[ncols++] = -hy/hx;}
if (j>0) {col[ncols].j = j-1; col[ncols].i = i; v[ncols++] = -hx/hy;}
if (j<info.my-1) {col[ncols].j = j+1; col[ncols].i = i; v[ncols++] = -hx/hy;}
ierr = MatSetValuesStencil(A,1,&row,ncols,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
/*
Create parallel vectors compatible with the DMDA.
*/
ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(u,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
By default we use an exact solution of a vector with all
elements of 1.0; Alternatively, using the runtime option
-random_sol forms a solution vector with random components.
*/
ierr = PetscOptionsGetBool(NULL,"-random_exact_sol",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
} else {
ierr = VecSet(u,1.);CHKERRQ(ierr);
}
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/*
View the exact solution vector if desired
*/
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-view_exact_sol",&flg,NULL);CHKERRQ(ierr);
if (flg) {ierr = VecView(u,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
These options will override those specified above as long as
KSPSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,-1.,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
/*
Print convergence information. PetscPrintf() produces a single
print statement from all processes that share a communicator.
An alternative is PetscFPrintf(), which prints to a file.
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g iterations %D\n",(double)norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return 0;
}
/*
SNESSolve_NEWTONTR - Implements Newton's Method with a very simple trust
region approach for solving systems of nonlinear equations.
*/
static PetscErrorCode SNESSolve_NEWTONTR(SNES snes)
{
SNES_NEWTONTR *neP = (SNES_NEWTONTR*)snes->data;
Vec X,F,Y,G,Ytmp;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscReal rho,fnorm,gnorm,gpnorm,xnorm=0,delta,nrm,ynorm,norm1;
PetscScalar cnorm;
KSP ksp;
SNESConvergedReason reason = SNES_CONVERGED_ITERATING;
PetscBool conv = PETSC_FALSE,breakout = PETSC_FALSE;
PetscFunctionBegin;
if (snes->xl || snes->xu || snes->ops->computevariablebounds) SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE, "SNES solver %s does not support bounds", ((PetscObject)snes)->type_name);
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
G = snes->work[1];
Ytmp = snes->work[2];
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = 0;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
if (!snes->vec_func_init_set) {
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr); /* F(X) */
} else snes->vec_func_init_set = PETSC_FALSE;
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr); /* fnorm <- || F || */
SNESCheckFunctionNorm(snes,fnorm);
ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); /* fnorm <- || F || */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
delta = xnorm ? neP->delta0*xnorm : neP->delta0;
neP->delta = delta;
ierr = SNESLogConvergenceHistory(snes,fnorm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* test convergence */
ierr = (*snes->ops->converged)(snes,snes->iter,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
/* Set the stopping criteria to use the More' trick. */
ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_tr_ksp_regular_convergence_test",&conv,NULL);CHKERRQ(ierr);
if (!conv) {
SNES_TR_KSPConverged_Ctx *ctx;
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = PetscNew(&ctx);CHKERRQ(ierr);
ctx->snes = snes;
ierr = KSPConvergedDefaultCreate(&ctx->ctx);CHKERRQ(ierr);
ierr = KSPSetConvergenceTest(ksp,SNESTR_KSPConverged_Private,ctx,SNESTR_KSPConverged_Destroy);CHKERRQ(ierr);
ierr = PetscInfo(snes,"Using Krylov convergence test SNESTR_KSPConverged_Private\n");CHKERRQ(ierr);
}
for (i=0; i<maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
/* Solve J Y = F, where J is Jacobian matrix */
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
SNESCheckJacobianDomainerror(snes);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSolve(snes->ksp,F,Ytmp);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
ierr = VecNorm(Ytmp,NORM_2,&nrm);CHKERRQ(ierr);
norm1 = nrm;
while (1) {
ierr = VecCopy(Ytmp,Y);CHKERRQ(ierr);
nrm = norm1;
/* Scale Y if need be and predict new value of F norm */
if (nrm >= delta) {
nrm = delta/nrm;
gpnorm = (1.0 - nrm)*fnorm;
cnorm = nrm;
ierr = PetscInfo1(snes,"Scaling direction by %g\n",(double)nrm);CHKERRQ(ierr);
ierr = VecScale(Y,cnorm);CHKERRQ(ierr);
nrm = gpnorm;
ynorm = delta;
} else {
gpnorm = 0.0;
ierr = PetscInfo(snes,"Direction is in Trust Region\n");CHKERRQ(ierr);
ynorm = nrm;
}
ierr = VecAYPX(Y,-1.0,X);CHKERRQ(ierr); /* Y <- X - Y */
ierr = VecCopy(X,snes->vec_sol_update);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,Y,G);CHKERRQ(ierr); /* F(X) */
ierr = VecNorm(G,NORM_2,&gnorm);CHKERRQ(ierr); /* gnorm <- || g || */
if (fnorm == gpnorm) rho = 0.0;
else rho = (fnorm*fnorm - gnorm*gnorm)/(fnorm*fnorm - gpnorm*gpnorm);
/* Update size of trust region */
if (rho < neP->mu) delta *= neP->delta1;
else if (rho < neP->eta) delta *= neP->delta2;
else delta *= neP->delta3;
ierr = PetscInfo3(snes,"fnorm=%g, gnorm=%g, ynorm=%g\n",(double)fnorm,(double)gnorm,(double)ynorm);CHKERRQ(ierr);
ierr = PetscInfo3(snes,"gpred=%g, rho=%g, delta=%g\n",(double)gpnorm,(double)rho,(double)delta);CHKERRQ(ierr);
neP->delta = delta;
if (rho > neP->sigma) break;
ierr = PetscInfo(snes,"Trying again in smaller region\n");CHKERRQ(ierr);
/* check to see if progress is hopeless */
neP->itflag = PETSC_FALSE;
ierr = SNESTR_Converged_Private(snes,snes->iter,xnorm,ynorm,fnorm,&reason,snes->cnvP);CHKERRQ(ierr);
if (!reason) { ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&reason,snes->cnvP);CHKERRQ(ierr); }
if (reason) {
/* We're not progressing, so return with the current iterate */
ierr = SNESMonitor(snes,i+1,fnorm);CHKERRQ(ierr);
breakout = PETSC_TRUE;
break;
}
snes->numFailures++;
}
if (!breakout) {
/* Update function and solution vectors */
fnorm = gnorm;
ierr = VecCopy(G,F);CHKERRQ(ierr);
ierr = VecCopy(Y,X);CHKERRQ(ierr);
/* Monitor convergence */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
snes->xnorm = xnorm;
snes->ynorm = ynorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,snes->norm,lits);CHKERRQ(ierr);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence, xnorm = || X || */
neP->itflag = PETSC_TRUE;
if (snes->ops->converged != SNESConvergedSkip) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&reason,snes->cnvP);CHKERRQ(ierr);
if (reason) break;
} else break;
}
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!reason) reason = SNES_DIVERGED_MAX_IT;
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->reason = reason;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMSetUp_DA_1D(DM da)
{
DM_DA *dd = (DM_DA*)da->data;
const PetscInt M = dd->M;
const PetscInt dof = dd->w;
const PetscInt s = dd->s;
const PetscInt sDist = s; /* stencil distance in points */
const PetscInt *lx = dd->lx;
DMBoundaryType bx = dd->bx;
MPI_Comm comm;
Vec local, global;
VecScatter gtol;
IS to, from;
PetscBool flg1 = PETSC_FALSE, flg2 = PETSC_FALSE;
PetscMPIInt rank, size;
PetscInt i,*idx,nn,left,xs,xe,x,Xs,Xe,start,m,IXs,IXe;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject) da, &comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
dd->p = 1;
dd->n = 1;
dd->m = size;
m = dd->m;
if (s > 0) {
/* if not communicating data then should be ok to have nothing on some processes */
if (M < m) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"More processes than data points! %D %D",m,M);
if ((M-1) < s && size > 1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Array is too small for stencil! %D %D",M-1,s);
}
/*
Determine locally owned region
xs is the first local node number, x is the number of local nodes
*/
if (!lx) {
ierr = PetscMalloc1(m, &dd->lx);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-da_partition_blockcomm",&flg1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-da_partition_nodes_at_end",&flg2,NULL);CHKERRQ(ierr);
if (flg1) { /* Block Comm type Distribution */
xs = rank*M/m;
x = (rank + 1)*M/m - xs;
} else if (flg2) { /* The odd nodes are evenly distributed across last nodes */
x = (M + rank)/m;
if (M/m == x) xs = rank*x;
else xs = rank*(x-1) + (M+rank)%(x*m);
} else { /* The odd nodes are evenly distributed across the first k nodes */
/* Regular PETSc Distribution */
x = M/m + ((M % m) > rank);
if (rank >= (M % m)) xs = (rank * (PetscInt)(M/m) + M % m);
else xs = rank * (PetscInt)(M/m) + rank;
}
ierr = MPI_Allgather(&xs,1,MPIU_INT,dd->lx,1,MPIU_INT,comm);CHKERRQ(ierr);
for (i=0; i<m-1; i++) dd->lx[i] = dd->lx[i+1] - dd->lx[i];
dd->lx[m-1] = M - dd->lx[m-1];
} else {
x = lx[rank];
xs = 0;
for (i=0; i<rank; i++) xs += lx[i];
/* verify that data user provided is consistent */
left = xs;
for (i=rank; i<size; i++) left += lx[i];
if (left != M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M %D %D",left,M);
}
/*
check if the scatter requires more than one process neighbor or wraps around
the domain more than once
*/
if ((x < s) & ((M > 1) | (bx == DM_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local x-width of domain x %D is smaller than stencil width s %D",x,s);
xe = xs + x;
/* determine ghost region (Xs) and region scattered into (IXs) */
if (xs-sDist > 0) {
Xs = xs - sDist;
IXs = xs - sDist;
} else {
if (bx) Xs = xs - sDist;
else Xs = 0;
IXs = 0;
}
if (xe+sDist <= M) {
Xe = xe + sDist;
IXe = xe + sDist;
} else {
if (bx) Xe = xe + sDist;
else Xe = M;
IXe = M;
}
if (bx == DM_BOUNDARY_PERIODIC || bx == DM_BOUNDARY_MIRROR) {
Xs = xs - sDist;
Xe = xe + sDist;
IXs = xs - sDist;
IXe = xe + sDist;
}
/* allocate the base parallel and sequential vectors */
dd->Nlocal = dof*x;
ierr = VecCreateMPIWithArray(comm,dof,dd->Nlocal,PETSC_DECIDE,NULL,&global);CHKERRQ(ierr);
dd->nlocal = dof*(Xe-Xs);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,dof,dd->nlocal,NULL,&local);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(global,&start,NULL);CHKERRQ(ierr);
/* Create Global to Local Vector Scatter Context */
/* global to local must retrieve ghost points */
ierr = ISCreateStride(comm,dof*(IXe-IXs),dof*(IXs-Xs),1,&to);CHKERRQ(ierr);
ierr = PetscMalloc1(x+2*sDist,&idx);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)da,(x+2*(sDist))*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<IXs-Xs; i++) idx[i] = -1; /* prepend with -1s if needed for ghosted case*/
nn = IXs-Xs;
if (bx == DM_BOUNDARY_PERIODIC) { /* Handle all cases with periodic first */
for (i=0; i<sDist; i++) { /* Left ghost points */
if ((xs-sDist+i)>=0) idx[nn++] = xs-sDist+i;
else idx[nn++] = M+(xs-sDist+i);
}
for (i=0; i<x; i++) idx [nn++] = xs + i; /* Non-ghost points */
for (i=0; i<sDist; i++) { /* Right ghost points */
if ((xe+i)<M) idx [nn++] = xe+i;
else idx [nn++] = (xe+i) - M;
}
} else if (bx == DM_BOUNDARY_MIRROR) { /* Handle all cases with periodic first */
for (i=0; i<(sDist); i++) { /* Left ghost points */
if ((xs-sDist+i)>=0) idx[nn++] = xs-sDist+i;
else idx[nn++] = sDist - i;
}
for (i=0; i<x; i++) idx [nn++] = xs + i; /* Non-ghost points */
for (i=0; i<(sDist); i++) { /* Right ghost points */
if ((xe+i)<M) idx[nn++] = xe+i;
else idx[nn++] = M - (i + 1);
}
} else { /* Now do all cases with no periodicity */
if (0 <= xs-sDist) {
for (i=0; i<sDist; i++) idx[nn++] = xs - sDist + i;
} else {
for (i=0; i<xs; i++) idx[nn++] = i;
}
for (i=0; i<x; i++) idx [nn++] = xs + i;
if ((xe+sDist)<=M) {
for (i=0; i<sDist; i++) idx[nn++]=xe+i;
} else {
for (i=xe; i<M; i++) idx[nn++]=i;
}
}
ierr = ISCreateBlock(comm,dof,nn-IXs+Xs,&idx[IXs-Xs],PETSC_USE_POINTER,&from);CHKERRQ(ierr);
ierr = VecScatterCreate(global,from,local,to,>ol);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)gtol);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
dd->xs = dof*xs; dd->xe = dof*xe; dd->ys = 0; dd->ye = 1; dd->zs = 0; dd->ze = 1;
dd->Xs = dof*Xs; dd->Xe = dof*Xe; dd->Ys = 0; dd->Ye = 1; dd->Zs = 0; dd->Ze = 1;
dd->gtol = gtol;
dd->base = dof*xs;
da->ops->view = DMView_DA_1d;
/*
Set the local to global ordering in the global vector, this allows use
of VecSetValuesLocal().
*/
for (i=0; i<Xe-IXe; i++) idx[nn++] = -1; /* pad with -1s if needed for ghosted case*/
ierr = ISLocalToGlobalMappingCreate(comm,dof,nn,idx,PETSC_OWN_POINTER,&da->ltogmap);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)da->ltogmap);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank;
PetscInt M = -10,N = -8;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
DM da;
PetscViewer viewer;
Vec local,global;
PetscScalar value;
DMBoundaryType bx = DM_BOUNDARY_NONE,by = DM_BOUNDARY_NONE;
DMDAStencilType stype = DMDA_STENCIL_BOX;
#if defined(PETSC_HAVE_MATLAB_ENGINE)
PetscViewer mviewer;
PetscMPIInt size;
#endif
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,"",300,0,300,300,&viewer);CHKERRQ(ierr);
#if defined(PETSC_HAVE_MATLAB_ENGINE)
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size == 1) {
ierr = PetscViewerMatlabOpen(PETSC_COMM_WORLD,"tmp.mat",FILE_MODE_WRITE,&mviewer);CHKERRQ(ierr);
}
#endif
ierr = PetscOptionsGetBool(NULL,NULL,"-star_stencil",&flg,NULL);CHKERRQ(ierr);
if (flg) stype = DMDA_STENCIL_STAR;
/* Create distributed array and get vectors */
ierr = DMDACreate2d(PETSC_COMM_WORLD,bx,by,stype,M,N,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DMCreateLocalVector(da,&local);CHKERRQ(ierr);
value = -3.0;
ierr = VecSet(global,value);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
value = rank+1;
ierr = VecScale(local,value);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,local,ADD_VALUES,global);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,local,ADD_VALUES,global);CHKERRQ(ierr);
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL, "-view_global", &flg,NULL);CHKERRQ(ierr);
if (flg) { /* view global vector in natural ordering */
ierr = VecView(global,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = DMView(da,viewer);CHKERRQ(ierr);
ierr = VecView(global,viewer);CHKERRQ(ierr);
#if defined(PETSC_HAVE_MATLAB_ENGINE)
if (size == 1) {
ierr = DMView(da,mviewer);CHKERRQ(ierr);
ierr = VecView(global,mviewer);CHKERRQ(ierr);
}
#endif
/* Free memory */
#if defined(PETSC_HAVE_MATLAB_ENGINE)
if (size == 1) {
ierr = PetscViewerDestroy(&mviewer);CHKERRQ(ierr);
}
#endif
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
