コード例 #1
0
ファイル: randreg.c プロジェクト: firedrakeproject/petsc
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);
}
コード例 #2
0
ファイル: tsreg.c プロジェクト: erdc-cm/petsc-dev
/*@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);
}
コード例 #3
0
ファイル: nasm.c プロジェクト: hsahasra/petsc-magma-dense-mat
/*@
   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);
}
コード例 #4
0
ファイル: nasm.c プロジェクト: hsahasra/petsc-magma-dense-mat
/*@
   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);
}
コード例 #5
0
ファイル: taolinesearch.c プロジェクト: 00liujj/petsc
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);
}
コード例 #6
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);
}
コード例 #7
0
ファイル: isreg.c プロジェクト: erdc-cm/petsc-dev
/*@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);
}
コード例 #8
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);
}
コード例 #9
0
ファイル: snesj.c プロジェクト: 00liujj/petsc
/*@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);
}
コード例 #10
0
ファイル: ex8.c プロジェクト: ZJLi2013/petsc
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);
}
コード例 #11
0
ファイル: tstRegularMg.C プロジェクト: Goon83/dendro
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