PetscErrorCode PetscRandomSetType(PetscRandom rnd, PetscRandomType type)
{
PetscErrorCode (*r)(PetscRandom);
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(rnd, PETSC_RANDOM_CLASSID,1);
ierr = PetscObjectTypeCompare((PetscObject)rnd, type, &match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
ierr = PetscFunctionListFind(PetscRandomList,type,&r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown random type: %s", type);
if (rnd->ops->destroy) {
ierr = (*rnd->ops->destroy)(rnd);CHKERRQ(ierr);
rnd->ops->destroy = NULL;
}
ierr = (*r)(rnd);CHKERRQ(ierr);
ierr = PetscRandomSeed(rnd);CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)rnd, type);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
TSSetType - Sets the method for the timestepping solver.
Collective on TS
Input Parameters:
+ ts - The TS context
- type - A known method
Options Database Command:
. -ts_type <type> - Sets the method; use -help for a list of available methods (for instance, euler)
Notes:
See "petsc/include/petscts.h" for available methods (for instance)
+ TSEULER - Euler
. TSSUNDIALS - SUNDIALS interface
. TSBEULER - Backward Euler
- TSPSEUDO - Pseudo-timestepping
Normally, it is best to use the TSSetFromOptions() command and
then set the TS type from the options database rather than by using
this routine. Using the options database provides the user with
maximum flexibility in evaluating the many different solvers.
The TSSetType() routine is provided for those situations where it
is necessary to set the timestepping solver independently of the
command line or options database. This might be the case, for example,
when the choice of solver changes during the execution of the
program, and the user's application is taking responsibility for
choosing the appropriate method. In other words, this routine is
not for beginners.
Level: intermediate
.keywords: TS, set, type
@*/
PetscErrorCode TSSetType(TS ts,TSType type)
{
PetscErrorCode (*r)(TS);
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts, TS_CLASSID,1);
ierr = PetscObjectTypeCompare((PetscObject) ts, type, &match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
ierr = PetscFunctionListFind(((PetscObject)ts)->comm,TSList, type,PETSC_TRUE, (void (**)(void)) &r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown TS type: %s", type);
if (ts->ops->destroy) {
ierr = (*(ts)->ops->destroy)(ts);CHKERRQ(ierr);
ts->ops->destroy = PETSC_NULL;
}
ierr = PetscMemzero(ts->ops,sizeof(*ts->ops));CHKERRQ(ierr);
ts->setupcalled = PETSC_FALSE;
ierr = PetscObjectChangeTypeName((PetscObject)ts, type);CHKERRQ(ierr);
ierr = (*r)(ts);CHKERRQ(ierr);
#if defined(PETSC_HAVE_AMS)
if (PetscAMSPublishAll) {
ierr = PetscObjectAMSPublish((PetscObject)ts);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
/*@
SNESNASMSetDamping - Sets the update damping for NASM
Logically collective on SNES
Input Parameters:
+ SNES - the SNES context
- dmp - damping
Level: intermediate
.keywords: SNES, NASM, damping
.seealso: SNESNASM, SNESNASMGetDamping()
@*/
PetscErrorCode SNESNASMSetDamping(SNES snes,PetscReal dmp)
{
PetscErrorCode (*f)(SNES,PetscReal);
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectQueryFunction((PetscObject)snes,"SNESNASMSetDamping_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {ierr = (f)(snes,dmp);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
/*@
SNESNASMSetComputeFinalJacobian - Schedules the computation of the global and subdomain jacobians upon convergence
Collective on SNES
Input Parameters:
+ SNES - the SNES context
- flg - indication of whether to compute the jacobians or not
Level: developer
Notes: This is used almost exclusively in the implementation of ASPIN, where the converged subdomain and global jacobian
is needed at each linear iteration.
.keywords: SNES, NASM, ASPIN
.seealso: SNESNASM, SNESNASMGetSubdomains()
@*/
PetscErrorCode SNESNASMSetComputeFinalJacobian(SNES snes,PetscBool flg)
{
PetscErrorCode (*f)(SNES,PetscBool);
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectQueryFunction((PetscObject)snes,"SNESNASMSetComputeFinalJacobian_C",&f);CHKERRQ(ierr);
if (f) {ierr = (f)(snes,flg);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
PetscErrorCode TaoLineSearchSetType(TaoLineSearch ls, const TaoLineSearchType type)
{
PetscErrorCode ierr;
PetscErrorCode (*r)(TaoLineSearch);
PetscBool flg;
PetscFunctionBegin;
PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
PetscValidCharPointer(type,2);
ierr = PetscObjectTypeCompare((PetscObject)ls, type, &flg);CHKERRQ(ierr);
if (flg) PetscFunctionReturn(0);
ierr = PetscFunctionListFind(TaoLineSearchList,type, (void (**)(void)) &r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested TaoLineSearch type %s",type);
if (ls->ops->destroy) {
ierr = (*(ls)->ops->destroy)(ls);CHKERRQ(ierr);
}
ls->max_funcs=30;
ls->ftol = 0.0001;
ls->gtol = 0.9;
#if defined(PETSC_USE_REAL_SINGLE)
ls->rtol = 1.0e-5;
#else
ls->rtol = 1.0e-10;
#endif
ls->stepmin=1.0e-20;
ls->stepmax=1.0e+20;
ls->nfeval=0;
ls->ngeval=0;
ls->nfgeval=0;
ls->ops->setup=0;
ls->ops->apply=0;
ls->ops->view=0;
ls->ops->setfromoptions=0;
ls->ops->destroy=0;
ls->setupcalled = PETSC_FALSE;
ierr = (*r)(ls);CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)ls, type);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
AOSetType - Builds an application ordering for a particular implementation.
Collective on AO
Input Parameters:
+ ao - The AO object
- method - The name of the AO type
Options Database Key:
. -ao_type <type> - Sets the AO type; use -help for a list of available types
Notes:
See "petsc/include/petscao.h" for available AO types (for instance, AOBASIC and AOMEMORYSCALABLE).
Level: intermediate
.keywords: ao, set, type
.seealso: AOGetType(), AOCreate()
@*/
PetscErrorCode AOSetType(AO ao, AOType method)
{
PetscErrorCode (*r)(AO);
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ao, AO_CLASSID,1);
ierr = PetscObjectTypeCompare((PetscObject)ao, method, &match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
ierr = AORegisterAll();CHKERRQ(ierr);
ierr = PetscFunctionListFind(AOList,method,&r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown AO type: %s", method);
if (ao->ops->destroy) {
ierr = (*ao->ops->destroy)(ao);CHKERRQ(ierr);
ao->ops->destroy = NULL;
}
ierr = (*r)(ao);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
ISSetType - Builds a index set, for a particular implementation.
Collective on IS
Input Parameters:
+ is - The index set object
- method - The name of the index set type
Options Database Key:
. -is_type <type> - Sets the index set type; use -help for a list of available types
Notes:
See "petsc/include/petscis.h" for available istor types (for instance, ISGENERAL, ISSTRIDE, or ISBLOCK).
Use ISDuplicate() to make a duplicate
Level: intermediate
.seealso: ISGetType(), ISCreate()
@*/
PetscErrorCode ISSetType(IS is, ISType method)
{
PetscErrorCode (*r)(IS);
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(is, IS_CLASSID,1);
ierr = PetscObjectTypeCompare((PetscObject) is, method, &match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
if (!ISRegisterAllCalled) {ierr = ISRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
ierr = PetscFunctionListFind( ((PetscObject)is)->comm,ISList, method,PETSC_TRUE,(void (**)(void)) &r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown IS type: %s", method);
if (is->ops->destroy) {
ierr = (*is->ops->destroy)(is);CHKERRQ(ierr);
is->ops->destroy = PETSC_NULL;
}
ierr = (*r)(is);CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)is,method);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
TSTrajectorySetType - Sets the storage method to be used as in a trajectory
Collective on TS
Input Parameters:
+ tj - the TSTrajectory context
. ts - the TS context
- type - a known method
Options Database Command:
. -ts_trajectory_type <type> - Sets the method; use -help for a list of available methods (for instance, basic)
Level: intermediate
.keywords: TS, trajectory, timestep, set, type
.seealso: TS, TSTrajectoryCreate(), TSTrajectorySetFromOptions(), TSTrajectoryDestroy()
@*/
PetscErrorCode TSTrajectorySetType(TSTrajectory tj,TS ts,const TSTrajectoryType type)
{
PetscErrorCode (*r)(TSTrajectory,TS);
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(tj,TSTRAJECTORY_CLASSID,1);
ierr = PetscObjectTypeCompare((PetscObject)tj,type,&match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
ierr = PetscFunctionListFind(TSTrajectoryList,type,&r);CHKERRQ(ierr);
if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown TSTrajectory type: %s",type);
if (tj->ops->destroy) {
ierr = (*(tj)->ops->destroy)(tj);CHKERRQ(ierr);
tj->ops->destroy = NULL;
}
ierr = PetscMemzero(tj->ops,sizeof(*tj->ops));CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)tj,type);CHKERRQ(ierr);
ierr = (*r)(tj,ts);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,*xx,wscale;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscErrorCode (*eval_fct)(SNES,Vec,Vec)=0;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
eval_fct = SNESComputeFunction;
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
}
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = 1.0 + unorm;
else dx = xx[i-start];
ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscFunctionList plist = NULL;
char pname[256];
TS ts; /* nonlinear solver */
Vec x,r; /* solution, residual vectors */
Mat A; /* Jacobian matrix */
Problem problem;
PetscBool use_monitor;
PetscInt steps,maxsteps = 1000,nonlinits,linits,snesfails,rejects;
PetscReal ftime;
MonitorCtx mon;
PetscErrorCode ierr;
PetscMPIInt size;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
/* Register the available problems */
ierr = PetscFunctionListAdd(&plist,"rober",&RoberCreate);CHKERRQ(ierr);
ierr = PetscFunctionListAdd(&plist,"ce",&CECreate);CHKERRQ(ierr);
ierr = PetscFunctionListAdd(&plist,"orego",&OregoCreate);CHKERRQ(ierr);
ierr = PetscStrcpy(pname,"ce");CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Timestepping benchmark options","");CHKERRQ(ierr);
{
ierr = PetscOptionsFList("-problem_type","Name of problem to run","",plist,pname,pname,sizeof(pname),NULL);CHKERRQ(ierr);
use_monitor = PETSC_FALSE;
ierr = PetscOptionsBool("-monitor_error","Display errors relative to exact solutions","",use_monitor,&use_monitor,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* Create the new problem */
ierr = PetscNew(&problem);CHKERRQ(ierr);
problem->comm = MPI_COMM_WORLD;
{
PetscErrorCode (*pcreate)(Problem);
ierr = PetscFunctionListFind(plist,pname,&pcreate);CHKERRQ(ierr);
if (!pcreate) SETERRQ1(PETSC_COMM_SELF,1,"No problem '%s'",pname);
ierr = (*pcreate)(problem);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,problem->n,problem->n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
mon.comm = PETSC_COMM_WORLD;
mon.problem = problem;
ierr = VecDuplicate(x,&mon.x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr); /* Rosenbrock-W */
ierr = TSSetIFunction(ts,NULL,problem->function,problem->data);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,problem->jacobian,problem->data);CHKERRQ(ierr);
ierr = TSSetDuration(ts,maxsteps,problem->final_time);CHKERRQ(ierr);
ierr = TSSetMaxStepRejections(ts,10);CHKERRQ(ierr);
ierr = TSSetMaxSNESFailures(ts,-1);CHKERRQ(ierr); /* unlimited */
if (use_monitor) {
ierr = TSMonitorSet(ts,&MonitorError,&mon,NULL);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = (*problem->solution)(0,x,problem->data);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.001);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetSNESFailures(ts,&snesfails);CHKERRQ(ierr);
ierr = TSGetStepRejections(ts,&rejects);CHKERRQ(ierr);
ierr = TSGetSNESIterations(ts,&nonlinits);CHKERRQ(ierr);
ierr = TSGetKSPIterations(ts,&linits);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"steps %D (%D rejected, %D SNES fails), ftime %G, nonlinits %D, linits %D\n",steps,rejects,snesfails,ftime,nonlinits,linits);CHKERRQ(ierr);
if (problem->hasexact) {
ierr = MonitorError(ts,steps,ftime,x,&mon);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = VecDestroy(&mon.x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
if (problem->destroy) {
ierr = (*problem->destroy)(problem);CHKERRQ(ierr);
}
ierr = PetscFree(problem);CHKERRQ(ierr);
ierr = PetscFunctionListDestroy(&plist);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc, char ** argv ) {
int size, rank;
bool incCorner = 1;
unsigned int dim=3;
unsigned int maxDepth=29;
bool compressLut=true;
std::vector<ot::TreeNode> balOct;
double mgLoadFac = 2.0;
unsigned int regLev = 2;
PetscInitialize(&argc, &argv, "options", help);
ot::RegisterEvents();
ot::DAMG_Initialize(MPI_COMM_WORLD);
#ifdef PETSC_USE_LOG
PetscClassId classid;
PetscClassIdRegister("Dendro",&classid);
PetscLogEventRegister("matProp",classid, &matPropEvent);
PetscLogEventRegister("ODAmatDiag",classid, &Jac1DiagEvent);
PetscLogEventRegister("ODAmatMult",classid, &Jac1MultEvent);
PetscLogEventRegister("ODAmatDiagFinest",classid, &Jac1FinestDiagEvent);
PetscLogEventRegister("ODAmatMultFinest",classid, &Jac1FinestMultEvent);
PetscLogEventRegister("OMGmatDiag-2",classid, &Jac2DiagEvent);
PetscLogEventRegister("OMGmatMult-2",classid, &Jac2MultEvent);
PetscLogEventRegister("OMGmatDiagFinest-2",classid, &Jac2FinestDiagEvent);
PetscLogEventRegister("OMGmatMultFinest-2",classid, &Jac2FinestMultEvent);
PetscLogEventRegister("OMGmatDiag-3",classid, &Jac3DiagEvent);
PetscLogEventRegister("OMGmatMult-3",classid, &Jac3MultEvent);
PetscLogEventRegister("OMGmatDiagFinest-3",classid, &Jac3FinestDiagEvent);
PetscLogEventRegister("OMGmatMultFinest-3",classid, &Jac3FinestMultEvent);
int stages[1];
PetscLogStageRegister("Solve",&stages[0]);
#endif
MPI_Comm_size(MPI_COMM_WORLD,&size);
MPI_Comm_rank(MPI_COMM_WORLD,&rank);
if(argc > 1) {
regLev = atoi(argv[1]);
}
if(argc > 2) {
maxDepth = atoi(argv[2]);
}
if(argc > 3) {
dim = atoi(argv[3]);
}
if(argc > 4) { incCorner = (bool)(atoi(argv[4]));}
if(argc > 5) { compressLut = (bool)(atoi(argv[5]));}
if(argc > 6) { mgLoadFac = atof(argv[6]); }
#ifdef PETSC_USE_LOG
PetscLogStagePush(stages[0]);
#endif
MPI_Barrier(MPI_COMM_WORLD);
ot::DAMG *damg;
int nlevels = 1; //number of multigrid levels
unsigned int dof = 1; // degrees of freedom per node
createRegularOctree(balOct, regLev, dim, maxDepth, MPI_COMM_WORLD);
PetscInt nlevelsPetscInt = nlevels; //To keep the compilers happy when using 64-bit indices
PetscOptionsGetInt(0, "-nlevels", &nlevelsPetscInt, 0);
nlevels = nlevelsPetscInt;
// Note: The user context for all levels will be set separately later.
MPI_Barrier(MPI_COMM_WORLD);
if(!rank) {
std::cout<<" nlevels initial: "<<nlevels<<std::endl;
}
ot::DAMGCreateAndSetDA(PETSC_COMM_WORLD, nlevels, NULL, &damg,
balOct, dof, mgLoadFac, compressLut, incCorner);
if(!rank) {
std::cout<<" nlevels final: "<<nlevels<<std::endl;
}
MPI_Barrier(MPI_COMM_WORLD);
if(!rank) {
std::cout << "Created DA for all levels."<< std::endl;
}
MPI_Barrier(MPI_COMM_WORLD);
ot::PrintDAMG(damg);
MPI_Barrier(MPI_COMM_WORLD);
for(int i=0;i<nlevels;i++) {
bool isRegOct = isRegularGrid(damg[i]->da);
if(!rank) {
std::cout<<"Level "<<i<<" is regular? "<<isRegOct<<std::endl;
}
}//end for i
SetUserContexts(damg);
if(!rank) {
std::cout << "Set User Contexts all levels."<< std::endl;
}
MPI_Barrier(MPI_COMM_WORLD);
PetscInt jacType = 1;
PetscOptionsGetInt(0,"-jacType",&jacType,0);
PetscInt rhsType = 1;
PetscOptionsGetInt(0,"-rhsType",&rhsType,0);
createLmatType2(LaplacianType2Stencil);
createMmatType2(MassType2Stencil);
if(jacType == 3) {
createLmatType1(LaplacianType1Stencil);
createMmatType1(MassType1Stencil);
}
createShFnMat(ShapeFnStencil);
if(!rank) {
std::cout << "Created Stencils."<< std::endl;
}
//Function handles
PetscErrorCode (*ComputeRHSHandle)(ot::DAMG damg,Vec rhs) = NULL;
PetscErrorCode (*CreateJacobianHandle)(ot::DAMG damg,Mat *B) = NULL;
PetscErrorCode (*ComputeJacobianHandle)(ot::DAMG damg,Mat J, Mat B) = NULL;
if(rhsType == 0) {
ComputeRHSHandle = ComputeRHS0;
} else if (rhsType == 1) {
ComputeRHSHandle = ComputeRHS1;
} else if (rhsType == 2) {
ComputeRHSHandle = ComputeRHS2;
} else if (rhsType == 3) {
ComputeRHSHandle = ComputeRHS3;
} else if (rhsType == 4) {
ComputeRHSHandle = ComputeRHS4;
} else if (rhsType == 5) {
ComputeRHSHandle = ComputeRHS5;
} else if (rhsType == 6) {
ComputeRHSHandle = ComputeRHS6;
} else if (rhsType == 7) {
ComputeRHSHandle = ComputeRHS7;
} else if (rhsType == 8) {
ComputeRHSHandle = ComputeRHS8;
} else {
assert(false);
}
if(jacType == 1) {
CreateJacobianHandle = CreateJacobian1;
ComputeJacobianHandle = ComputeJacobian1;
} else if (jacType == 2) {
CreateJacobianHandle = CreateJacobian2;
ComputeJacobianHandle = ComputeJacobian2;
} else if (jacType == 3) {
CreateJacobianHandle = CreateJacobian3;
ComputeJacobianHandle = ComputeJacobian3;
//Skip the finest and the coarsest levels. For the other levels, J and B
//must be different
for(int i = 1; i < (nlevels-1); i++) {
ot::DAMGCreateJMatrix(damg[i], CreateJacobianHandle);
}
} else {
assert(false);
}
//Global Function Handles for using KSP_Shell (will be used @ the coarsest grid if not all
//processors are active on the coarsest grid)
if (jacType == 1) {
ot::getPrivateMatricesForKSP_Shell = getPrivateMatricesForKSP_Shell_Jac1;
} else if (jacType == 2) {
ot::getPrivateMatricesForKSP_Shell = getPrivateMatricesForKSP_Shell_Jac2;
} else if (jacType == 3) {
ot::getPrivateMatricesForKSP_Shell = getPrivateMatricesForKSP_Shell_Jac3;
} else {
assert(false);
}
ot::DAMGSetKSP(damg, CreateJacobianHandle, ComputeJacobianHandle, ComputeRHSHandle);
if(!rank) {
std::cout<<"Solving u-Lu=f"<<std::endl;
}
iC(ot::DAMGSolve(damg));
destroyLmatType2(LaplacianType2Stencil);
destroyMmatType2(MassType2Stencil);
if(jacType == 3) {
destroyLmatType1(LaplacianType1Stencil);
destroyMmatType1(MassType1Stencil);
}
destroyShFnMat(ShapeFnStencil);
MPI_Barrier(MPI_COMM_WORLD);
DestroyUserContexts(damg);
if (!rank) {
std::cout << GRN << "Destroyed User Contexts." << NRM << std::endl;
}
MPI_Barrier(MPI_COMM_WORLD);
iC(DAMGDestroy(damg));
if (!rank) {
std::cout << GRN << "Destroyed DAMG" << NRM << std::endl;
}
#ifdef PETSC_USE_LOG
PetscLogStagePop();
#endif
balOct.clear();
if (!rank) {
std::cout << GRN << "Finalizing ..." << NRM << std::endl;
}
ot::DAMG_Finalize();
PetscFinalize();
}//end function
