Exemplo n.º 1
0
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
  PetscErrorCode ierr;
  DM             dm;
  DMSNES_Local   *dmlocalsnes = (DMSNES_Local*)ctx;
  Vec            Xloc;

  PetscFunctionBegin;
  ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
  if (dmlocalsnes->jacobianlocal) {
    ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
    ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
    if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
    ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
    ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
    CHKMEMQ;
    ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr);
    CHKMEMQ;
    ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
  } else {
    MatFDColoring fdcoloring;
    ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
    if (!fdcoloring) {
      ISColoring coloring;

      ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
      switch (dm->coloringtype) {
      case IS_COLORING_GLOBAL:
        ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr);
        break;
      default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
      }
      ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
      ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr);
      ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
      ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);

      /* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
       * VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
       * MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
       * drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
       * taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
       */
      ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
    }
    ierr  = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr);
  }
  /* This will be redundant if the user called both, but it's too common to forget. */
  if (A != B) {
    ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
    ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 2
0
PetscErrorCode  DMCoarsen_Composite(DM dmi,MPI_Comm comm,DM *fine)
{
  PetscErrorCode         ierr;
  struct DMCompositeLink *next;
  DM_Composite           *com = (DM_Composite*)dmi->data;
  DM                     dm;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(dmi,DM_CLASSID,1);
  ierr = DMSetUp(dmi);CHKERRQ(ierr);
  if (comm == MPI_COMM_NULL) {
    ierr = PetscObjectGetComm((PetscObject)dmi,&comm);CHKERRQ(ierr);
  }
  next = com->next;
  ierr = DMCompositeCreate(comm,fine);CHKERRQ(ierr);

  /* loop over packed objects, handling one at at time */
  while (next) {
    ierr = DMCoarsen(next->dm,comm,&dm);CHKERRQ(ierr);
    ierr = DMCompositeAddDM(*fine,dm);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
    next = next->next;
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 3
0
PetscErrorCode  SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
  MatFDColoring  color = (MatFDColoring)ctx;
  PetscErrorCode ierr;
  DM             dm;
  MatColoring    mc;
  ISColoring     iscoloring;
  PetscBool      hascolor;
  PetscBool      solvec,matcolor = PETSC_FALSE;

  PetscFunctionBegin;
  if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
  if (!color) {ierr  = PetscObjectQuery((PetscObject)B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}

  if (!color) {
    ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
    ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
    matcolor = PETSC_FALSE;
    ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_fd_color_use_mat",&matcolor,NULL);CHKERRQ(ierr);
    if (hascolor && !matcolor) {
      ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
      ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
      ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
    } else {
      ierr = MatColoringCreate(B,&mc);CHKERRQ(ierr);
      ierr = MatColoringSetDistance(mc,2);CHKERRQ(ierr);
      ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
      ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
      ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
      ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
      ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
      ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
    }
    ierr = PetscObjectCompose((PetscObject)B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
  }

  /* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
  ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
  if (!snes->vec_rhs && solvec) {
    Vec F;
    ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
    ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
  }
  ierr = MatFDColoringApply(B,color,x1,snes);CHKERRQ(ierr);
  if (J != B) {
    ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
    ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 4
0
/*@
    VecGhostRestoreLocalForm - Restores the local ghosted representation of
    a parallel vector obtained with VecGhostGetLocalForm().

    Not Collective

    Input Parameter:
+   g - the global vector
-   l - the local (ghosted) representation

    Notes:
    This routine does not actually update the ghost values, but rather it
    returns a sequential vector that includes the locations for the ghost values
    and their current values.

    Level: advanced

.seealso: VecCreateGhost(), VecGhostGetLocalForm(), VecCreateGhostWithArray()
@*/
PetscErrorCode  VecGhostRestoreLocalForm(Vec g,Vec *l)
{
  PetscErrorCode ierr;

  PetscFunctionBegin;
  if (*l) {
    ierr = VecGhostStateSync_Private(g,*l);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)*l);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 5
0
extern PetscErrorCode MatLMVMReset(Mat M)
{
  PetscErrorCode ierr;
  MatLMVMCtx     *ctx;
  PetscInt       i;

  PetscFunctionBegin;
  ierr = MatShellGetContext(M,(void**)&ctx);CHKERRQ(ierr);
  if (ctx->Gprev) {
    ierr = PetscObjectDereference((PetscObject)ctx->Gprev);CHKERRQ(ierr);
  }
  if (ctx->Xprev) {
    ierr = PetscObjectDereference((PetscObject)ctx->Xprev);CHKERRQ(ierr);
  }
  ctx->Gprev = ctx->Y[ctx->lm];
  ctx->Xprev = ctx->S[ctx->lm];
  ierr = PetscObjectReference((PetscObject)ctx->Gprev);CHKERRQ(ierr);
  ierr = PetscObjectReference((PetscObject)ctx->Xprev);CHKERRQ(ierr);
  for (i=0; i<ctx->lm; ++i) {
    ctx->rho[i] = 0.0;
  }
  ctx->rho[0] = 1.0;

  /*  Set the scaling and diagonal scaling matrix */
  switch(ctx->scaleType) {
  case MatLMVM_Scale_None:
    ctx->sigma = 1.0;
    break;
  case MatLMVM_Scale_Scalar:
    ctx->sigma = ctx->delta;
    break;
  case MatLMVM_Scale_Broyden:
    ierr = VecSet(ctx->D,ctx->delta);CHKERRQ(ierr);
    break;
  }

  ctx->iter=0;
  ctx->nupdates=0;
  ctx->lmnow=0;
  PetscFunctionReturn(0);
}
Exemplo n.º 6
0
/*@
  DMPlexCopyCoordinates - Copy coordinates from one mesh to another with the same vertices

  Collective on DM

  Input Parameter:
. dmA - The DMPlex object with initial coordinates

  Output Parameter:
. dmB - The DMPlex object with copied coordinates

  Level: intermediate

  Note: This is typically used when adding pieces other than vertices to a mesh

.keywords: mesh
.seealso: DMCopyLabels(), DMGetCoordinates(), DMGetCoordinatesLocal(), DMGetCoordinateDM(), DMGetCoordinateSection()
@*/
PetscErrorCode DMPlexCopyCoordinates(DM dmA, DM dmB)
{
  Vec            coordinatesA, coordinatesB;
  PetscSection   coordSectionA, coordSectionB;
  PetscScalar   *coordsA, *coordsB;
  PetscInt       spaceDim, vStartA, vStartB, vEndA, vEndB, coordSizeB, v, d;
  PetscErrorCode ierr;

  PetscFunctionBegin;
  if (dmA == dmB) PetscFunctionReturn(0);
  ierr = DMPlexGetDepthStratum(dmA, 0, &vStartA, &vEndA);CHKERRQ(ierr);
  ierr = DMPlexGetDepthStratum(dmB, 0, &vStartB, &vEndB);CHKERRQ(ierr);
  if ((vEndA-vStartA) != (vEndB-vStartB)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of vertices in first DM %d != %d in the second DM", vEndA-vStartA, vEndB-vStartB);
  ierr = DMGetCoordinateSection(dmA, &coordSectionA);CHKERRQ(ierr);
  ierr = DMGetCoordinateSection(dmB, &coordSectionB);CHKERRQ(ierr);
  if (!coordSectionB) {
    PetscInt dim;

    ierr = PetscSectionCreate(PetscObjectComm((PetscObject) coordSectionA), &coordSectionB);CHKERRQ(ierr);
    ierr = DMGetCoordinateDim(dmA, &dim);CHKERRQ(ierr);
    ierr = DMSetCoordinateSection(dmB, dim, coordSectionB);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject) coordSectionB);CHKERRQ(ierr);
  }
  ierr = PetscSectionSetNumFields(coordSectionB, 1);CHKERRQ(ierr);
  ierr = PetscSectionGetFieldComponents(coordSectionA, 0, &spaceDim);CHKERRQ(ierr);
  ierr = PetscSectionSetFieldComponents(coordSectionB, 0, spaceDim);CHKERRQ(ierr);
  ierr = PetscSectionSetChart(coordSectionB, vStartB, vEndB);CHKERRQ(ierr);
  for (v = vStartB; v < vEndB; ++v) {
    ierr = PetscSectionSetDof(coordSectionB, v, spaceDim);CHKERRQ(ierr);
    ierr = PetscSectionSetFieldDof(coordSectionB, v, 0, spaceDim);CHKERRQ(ierr);
  }
  ierr = PetscSectionSetUp(coordSectionB);CHKERRQ(ierr);
  ierr = PetscSectionGetStorageSize(coordSectionB, &coordSizeB);CHKERRQ(ierr);
  ierr = DMGetCoordinatesLocal(dmA, &coordinatesA);CHKERRQ(ierr);
  ierr = VecCreate(PetscObjectComm((PetscObject) dmB), &coordinatesB);CHKERRQ(ierr);
  ierr = PetscObjectSetName((PetscObject) coordinatesB, "coordinates");CHKERRQ(ierr);
  ierr = VecSetSizes(coordinatesB, coordSizeB, PETSC_DETERMINE);CHKERRQ(ierr);
  ierr = VecSetType(coordinatesB,VECSTANDARD);CHKERRQ(ierr);
  ierr = VecGetArray(coordinatesA, &coordsA);CHKERRQ(ierr);
  ierr = VecGetArray(coordinatesB, &coordsB);CHKERRQ(ierr);
  for (v = 0; v < vEndB-vStartB; ++v) {
    for (d = 0; d < spaceDim; ++d) {
      coordsB[v*spaceDim+d] = coordsA[v*spaceDim+d];
    }
  }
  ierr = VecRestoreArray(coordinatesA, &coordsA);CHKERRQ(ierr);
  ierr = VecRestoreArray(coordinatesB, &coordsB);CHKERRQ(ierr);
  ierr = DMSetCoordinatesLocal(dmB, coordinatesB);CHKERRQ(ierr);
  ierr = VecDestroy(&coordinatesB);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 7
0
extern PetscErrorCode MatDestroy_LMVM(Mat M)
{
  MatLMVMCtx     *ctx;
  PetscErrorCode ierr;

  PetscFunctionBegin;
  ierr = MatShellGetContext(M,(void**)&ctx);CHKERRQ(ierr);
  if (ctx->allocated) {
    if (ctx->Xprev) {
      ierr = PetscObjectDereference((PetscObject)ctx->Xprev);CHKERRQ(ierr);
    }
    if (ctx->Gprev) {
      ierr = PetscObjectDereference((PetscObject)ctx->Gprev);CHKERRQ(ierr);
    }

    ierr = VecDestroyVecs(ctx->lm+1,&ctx->S);CHKERRQ(ierr);
    ierr = VecDestroyVecs(ctx->lm+1,&ctx->Y);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->D);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->U);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->V);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->W);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->P);CHKERRQ(ierr);
    ierr = VecDestroy(&ctx->Q);CHKERRQ(ierr);
    if (ctx->scale) {
      ierr = VecDestroy(&ctx->scale);CHKERRQ(ierr);
    }
  }
  ierr = PetscFree(ctx->rho);CHKERRQ(ierr);
  ierr = PetscFree(ctx->beta);CHKERRQ(ierr);
  ierr = PetscFree(ctx->yy_history);CHKERRQ(ierr);
  ierr = PetscFree(ctx->ys_history);CHKERRQ(ierr);
  ierr = PetscFree(ctx->ss_history);CHKERRQ(ierr);
  ierr = PetscFree(ctx->yy_rhistory);CHKERRQ(ierr);
  ierr = PetscFree(ctx->ys_rhistory);CHKERRQ(ierr);
  ierr = PetscFree(ctx->ss_rhistory);CHKERRQ(ierr);
  ierr = PetscFree(ctx);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 8
0
Arquivo: itcl.c Projeto: petsc/petsc
static PetscErrorCode KSPSetupMonitor_Private(KSP ksp, PetscViewer viewer, PetscViewerFormat format, PetscErrorCode (*monitor)(KSP,PetscInt,PetscReal,void*), PetscBool useMonitor)
{
  PetscErrorCode ierr;

  PetscFunctionBegin;
  if (useMonitor) {
    PetscViewerAndFormat *vf;

    ierr = PetscViewerAndFormatCreate(viewer, format, &vf);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject) viewer);CHKERRQ(ierr);
    ierr = KSPMonitorSet(ksp, monitor, vf, (PetscErrorCode (*)(void**)) PetscViewerAndFormatDestroy);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 9
0
static PetscErrorCode TaoLineSearchDestroy_OWArmijo(TaoLineSearch ls)
{
  TaoLineSearch_OWARMIJO *armP = (TaoLineSearch_OWARMIJO *)ls->data;
  PetscErrorCode         ierr;

  PetscFunctionBegin;
  ierr = PetscFree(armP->memory);CHKERRQ(ierr);
  if (armP->x) {
    ierr = PetscObjectDereference((PetscObject)armP->x);CHKERRQ(ierr);
  }
  ierr = VecDestroy(&armP->work);CHKERRQ(ierr);
  ierr = PetscFree(ls->data);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 10
0
/*@
   ISRestoreNonlocalIS - Restore the IS obtained with ISGetNonlocalIS().

   Not collective.

   Input Parameter:
+  is         - the index set
-  complement - index set of is's nonlocal indices

   Level: intermediate


   Concepts: index sets^getting nonlocal indices
   Concepts: index sets^restoring nonlocal indices
.seealso: ISGetNonlocalIS(), ISGetNonlocalIndices(), ISRestoreNonlocalIndices()
@*/
PetscErrorCode  ISRestoreNonlocalIS(IS is, IS *complement)
{
  PetscErrorCode ierr;
  PetscInt       refcnt;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(is,IS_CLASSID,1);
  PetscValidPointer(complement,2);
  if (*complement != is->complement) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Complement IS being restored was not obtained with ISGetNonlocalIS()");
  ierr = PetscObjectGetReference((PetscObject)(is->complement), &refcnt);CHKERRQ(ierr);
  if (refcnt <= 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Duplicate call to ISRestoreNonlocalIS() detected");
  ierr = PetscObjectDereference((PetscObject)(is->complement));CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 11
0
PetscErrorCode  SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
{
  MatFDColoring  color = (MatFDColoring)ctx;
  PetscErrorCode ierr;
  DM             dm;
  PetscErrorCode (*func)(SNES,Vec,Vec,void*);
  Vec            F;
  void           *funcctx;
  ISColoring     iscoloring;
  PetscBool      hascolor;
  PetscBool      solvec;

  PetscFunctionBegin;
  if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
  else {ierr  = PetscObjectQuery((PetscObject)*B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
  *flag = SAME_NONZERO_PATTERN;
  ierr  = SNESGetFunction(snes,&F,&func,&funcctx);CHKERRQ(ierr);
  if (!color) {
    ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
    ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
    if (hascolor) {
      ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
      ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,funcctx);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
    } else {
      ierr = MatGetColoring(*B,MATCOLORINGSL,&iscoloring);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
      ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,(void*)funcctx);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
    }
    ierr = PetscObjectCompose((PetscObject)*B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
  }

  /* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
  ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
  if (!snes->vec_rhs && solvec) {
    ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
  }
  ierr = MatFDColoringApply(*B,color,x1,flag,snes);CHKERRQ(ierr);
  if (*J != *B) {
    ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
    ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 12
0
static PetscErrorCode TaoLineSearchDestroy_MT(TaoLineSearch ls)
{
  PetscErrorCode   ierr;
  TaoLineSearch_MT *mt;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
  mt = (TaoLineSearch_MT*)(ls->data);
  if (mt->x) {
    ierr = PetscObjectDereference((PetscObject)mt->x);CHKERRQ(ierr);
  }
  ierr = VecDestroy(&mt->work);CHKERRQ(ierr);
  ierr = PetscFree(ls->data);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 13
0
Arquivo: vecd.c Projeto: xyuan/dohp
dErr VecDohpRestoreClosure(Vec v,Vec *c)
{
  dErr   err;
  dBool  isdohp;

  dFunctionBegin;
  dValidHeader(v,VEC_CLASSID,1);
  dValidPointer(c,2);
  err = PetscTypeCompare((dObject)v,VECDOHP,&isdohp);dCHK(err);
  if (!isdohp) dERROR(PETSC_COMM_SELF,1,"Vector type %s does not have closure",((dObject)v)->type_name);
  if (*c != ((Vec_MPI*)v->data)->localrep) dERROR(PETSC_COMM_SELF,1,"attempting to restore incorrect closure");
  err = VecStateSync_Private(v,*c);dCHK(err);
  err = PetscObjectDereference((dObject)*c);dCHK(err);
  *c = NULL;
  dFunctionReturn(0);
}
Exemplo n.º 14
0
Arquivo: dupl.c Projeto: 00liujj/petsc
/*@
   PetscViewerRestoreSubcomm - Restores a new PetscViewer obtained with PetscViewerGetSubcomm().

    Collective on PetscViewer

   Input Parameters:
+  viewer - the PetscViewer to be duplicated
.  subcomm - MPI communicator
-  outviewer - new PetscViewer

   Level: advanced

   Notes: Call PetscViewerGetSubcomm() to get this PetscViewer, NOT PetscViewerCreate()

.seealso: PetscViewerSocketOpen(), PetscViewerASCIIOpen(), PetscViewerDrawOpen(), PetscViewerGetSubcomm()
@*/
PetscErrorCode  PetscViewerRestoreSubcomm(PetscViewer viewer,MPI_Comm subcomm,PetscViewer *outviewer)
{
  PetscErrorCode ierr;
  PetscMPIInt    size;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1);

  ierr = MPI_Comm_size(PetscObjectComm((PetscObject)viewer),&size);CHKERRQ(ierr);
  if (size == 1 || (outviewer && viewer == *outviewer)) {
    ierr = PetscObjectDereference((PetscObject)viewer);CHKERRQ(ierr);
    if (outviewer) *outviewer = 0;
  } else if (viewer->ops->restoresubcomm) {
    ierr = (*viewer->ops->restoresubcomm)(viewer,subcomm,outviewer);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 15
0
Arquivo: dupl.c Projeto: 00liujj/petsc
/*@
   PetscViewerRestoreSingleton - Restores a new PetscViewer obtained with PetscViewerGetSingleton().

    Collective on PetscViewer

   Input Parameters:
+  viewer - the PetscViewer to be duplicated
-  outviewer - new PetscViewer

   Level: advanced

   Notes: Call PetscViewerGetSingleton() to get this PetscViewer, NOT PetscViewerCreate()

.seealso: PetscViewerSocketOpen(), PetscViewerASCIIOpen(), PetscViewerDrawOpen(), PetscViewerGetSingleton()
@*/
PetscErrorCode  PetscViewerRestoreSingleton(PetscViewer viewer,PetscViewer *outviewer)
{
  PetscErrorCode ierr;
  PetscMPIInt    size;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1);

  ierr = MPI_Comm_size(PetscObjectComm((PetscObject)viewer),&size);CHKERRQ(ierr);
  if (size == 1) {
    ierr = PetscObjectDereference((PetscObject)viewer);CHKERRQ(ierr);
    if (outviewer) *outviewer = 0;
  } else if (viewer->ops->restoresingleton) {
    ierr = (*viewer->ops->restoresingleton)(viewer,outviewer);CHKERRQ(ierr);
  }
  ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 16
0
static PetscErrorCode TaoDestroy_BLMVM(Tao tao)
{
  TAO_BLMVM      *blmP = (TAO_BLMVM *)tao->data;
  PetscErrorCode ierr;

  PetscFunctionBegin;
  if (tao->setupcalled) {
    ierr = MatDestroy(&blmP->M);CHKERRQ(ierr);
    ierr = VecDestroy(&blmP->unprojected_gradient);CHKERRQ(ierr);
    ierr = VecDestroy(&blmP->Xold);CHKERRQ(ierr);
    ierr = VecDestroy(&blmP->Gold);CHKERRQ(ierr);
  }

  if (blmP->H0) {
    PetscObjectDereference((PetscObject)blmP->H0);
  }

  ierr = PetscFree(tao->data);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 17
0
static PetscErrorCode TaoLineSearchApply_GPCG(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
  TaoLineSearch_GPCG *neP = (TaoLineSearch_GPCG *)ls->data;
  PetscErrorCode     ierr;
  PetscInt           i;
  PetscBool          g_computed=PETSC_FALSE; /* to prevent extra gradient computation */
  PetscReal          d1,finit,actred,prered,rho, gdx;

  PetscFunctionBegin;
  /* ls->stepmin - lower bound for step */
  /* ls->stepmax - upper bound for step */
  /* ls->rtol     - relative tolerance for an acceptable step */
  /* ls->ftol     - tolerance for sufficient decrease condition */
  /* ls->gtol     - tolerance for curvature condition */
  /* ls->nfeval   - number of function evaluations */
  /* ls->nfeval   - number of function/gradient evaluations */
  /* ls->max_funcs  - maximum number of function evaluations */

  ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
  ls->step = ls->initstep;
  if (!neP->W2) {
    ierr = VecDuplicate(x,&neP->W2);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&neP->W1);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&neP->Gold);CHKERRQ(ierr);
    neP->x = x;
    ierr = PetscObjectReference((PetscObject)neP->x);CHKERRQ(ierr);
  } else if (x != neP->x) {
    ierr = VecDestroy(&neP->x);CHKERRQ(ierr);
    ierr = VecDestroy(&neP->W1);CHKERRQ(ierr);
    ierr = VecDestroy(&neP->W2);CHKERRQ(ierr);
    ierr = VecDestroy(&neP->Gold);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&neP->W1);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&neP->W2);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&neP->Gold);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)neP->x);CHKERRQ(ierr);
    neP->x = x;
    ierr = PetscObjectReference((PetscObject)neP->x);CHKERRQ(ierr);
  }

  ierr = VecDot(g,s,&gdx);CHKERRQ(ierr);
   if (gdx > 0) {
     ierr = PetscInfo1(ls,"Line search error: search direction is not descent direction. dot(g,s) = %g\n",(double)gdx);CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_FAILED_ASCENT;
    PetscFunctionReturn(0);
  }
  ierr = VecCopy(x,neP->W2);CHKERRQ(ierr);
  ierr = VecCopy(g,neP->Gold);CHKERRQ(ierr);
  if (ls->bounded) {
    /* Compute the smallest steplength that will make one nonbinding variable  equal the bound */
    ierr = VecStepBoundInfo(x,s,ls->lower,ls->upper,&rho,&actred,&d1);CHKERRQ(ierr);
    ls->step = PetscMin(ls->step,d1);
  }
  rho=0; actred=0;

  if (ls->step < 0) {
    ierr = PetscInfo1(ls,"Line search error: initial step parameter %g< 0\n",(double)ls->step);CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_HALTED_OTHER;
    PetscFunctionReturn(0);
  }

  /* Initialization */
  finit = *f;
  for (i=0; i< ls->max_funcs; i++) {
    /* Force the step to be within the bounds */
    ls->step = PetscMax(ls->step,ls->stepmin);
    ls->step = PetscMin(ls->step,ls->stepmax);

    ierr = VecCopy(x,neP->W2);CHKERRQ(ierr);
    ierr = VecAXPY(neP->W2,ls->step,s);CHKERRQ(ierr);
    if (ls->bounded) {
      /* Make sure new vector is numerically within bounds */
      ierr = VecMedian(neP->W2,ls->lower,ls->upper,neP->W2);CHKERRQ(ierr);
    }

    /* Gradient is not needed here.  Unless there is a separate
       gradient routine, compute it here anyway to prevent recomputing at
       the end of the line search */
    if (ls->hasobjective) {
      ierr = TaoLineSearchComputeObjective(ls,neP->W2,f);CHKERRQ(ierr);
      g_computed=PETSC_FALSE;
    } else if (ls->usegts){
      ierr = TaoLineSearchComputeObjectiveAndGTS(ls,neP->W2,f,&gdx);CHKERRQ(ierr);
      g_computed=PETSC_FALSE;
    } else {
      ierr = TaoLineSearchComputeObjectiveAndGradient(ls,neP->W2,f,g);CHKERRQ(ierr);
      g_computed=PETSC_TRUE;
    }

    if (0 == i) {
        ls->f_fullstep = *f;
    }

    actred = *f - finit;
    ierr = VecCopy(neP->W2,neP->W1);CHKERRQ(ierr);
    ierr = VecAXPY(neP->W1,-1.0,x);CHKERRQ(ierr);    /* W1 = W2 - X */
    ierr = VecDot(neP->W1,neP->Gold,&prered);CHKERRQ(ierr);

    if (fabs(prered)<1.0e-100) prered=1.0e-12;
    rho = actred/prered;

    /*
       If sufficient progress has been obtained, accept the
       point.  Otherwise, backtrack.
    */

    if (actred > 0) {
      ierr = PetscInfo(ls,"Step resulted in ascent, rejecting.\n");CHKERRQ(ierr);
      ls->step = (ls->step)/2;
    } else if (rho > ls->ftol){
      break;
    } else{
      ls->step = (ls->step)/2;
    }

    /* Convergence testing */

    if (ls->step <= ls->stepmin || ls->step >= ls->stepmax) {
      ls->reason = TAOLINESEARCH_HALTED_OTHER;
      ierr = PetscInfo(ls,"Rounding errors may prevent further progress.  May not be a step satisfying\n");CHKERRQ(ierr);
      ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n");CHKERRQ(ierr);
     break;
    }
    if (ls->step == ls->stepmax) {
      ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
      break;
    }
    if (ls->step == ls->stepmin) {
      ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
      break;
    }
    if ((ls->nfeval+ls->nfgeval) >= ls->max_funcs) {
      ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",ls->nfeval+ls->nfgeval,ls->max_funcs);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
      break;
    }
    if ((neP->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
      ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_RTOL;
      break;
    }
  }
  ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",ls->nfeval+ls->nfgeval,(double)ls->step);CHKERRQ(ierr);
  /* set new solution vector and compute gradient if necessary */
  ierr = VecCopy(neP->W2, x);CHKERRQ(ierr);
  if (ls->reason == TAOLINESEARCH_CONTINUE_ITERATING) {
    ls->reason = TAOLINESEARCH_SUCCESS;
  }
  if (!g_computed) {
    ierr = TaoLineSearchComputeGradient(ls,x,g);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 18
0
/* @ TaoApply_OWArmijo - This routine performs a linesearch. It
   backtracks until the (nonmonotone) OWArmijo conditions are satisfied.

   Input Parameters:
+  tao - TAO_SOLVER context
.  X - current iterate (on output X contains new iterate, X + step*S)
.  S - search direction
.  f - merit function evaluated at X
.  G - gradient of merit function evaluated at X
.  W - work vector
-  step - initial estimate of step length

   Output parameters:
+  f - merit function evaluated at new iterate, X + step*S
.  G - gradient of merit function evaluated at new iterate, X + step*S
.  X - new iterate
-  step - final step length

   Info is set to one of:
.   0 - the line search succeeds; the sufficient decrease
   condition and the directional derivative condition hold

   negative number if an input parameter is invalid
-   -1 -  step < 0

   positive number > 1 if the line search otherwise terminates
+    1 -  Step is at the lower bound, stepmin.
@ */
static PetscErrorCode TaoLineSearchApply_OWArmijo(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
  TaoLineSearch_OWARMIJO *armP = (TaoLineSearch_OWARMIJO *)ls->data;
  PetscErrorCode         ierr;
  PetscInt               i;
  PetscReal              fact, ref, gdx;
  PetscInt               idx;
  PetscBool              g_computed=PETSC_FALSE; /* to prevent extra gradient computation */
  Vec                    g_old;
  PetscReal              owlqn_minstep=0.005;
  PetscReal              partgdx;
  MPI_Comm               comm;

  PetscFunctionBegin;
  ierr = PetscObjectGetComm((PetscObject)ls,&comm);CHKERRQ(ierr);
  fact = 0.0;
  ls->nfeval=0;
  ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
  if (!armP->work) {
    ierr = VecDuplicate(x,&armP->work);CHKERRQ(ierr);
    armP->x = x;
    ierr = PetscObjectReference((PetscObject)armP->x);CHKERRQ(ierr);
  } else if (x != armP->x) {
    ierr = VecDestroy(&armP->work);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&armP->work);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)armP->x);CHKERRQ(ierr);
    armP->x = x;
    ierr = PetscObjectReference((PetscObject)armP->x);CHKERRQ(ierr);
  }

  /* Check linesearch parameters */
  if (armP->alpha < 1) {
    ierr = PetscInfo1(ls,"OWArmijo line search error: alpha (%g) < 1\n", (double)armP->alpha);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if ((armP->beta <= 0) || (armP->beta >= 1)) {
    ierr = PetscInfo1(ls,"OWArmijo line search error: beta (%g) invalid\n", (double)armP->beta);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if ((armP->beta_inf <= 0) || (armP->beta_inf >= 1)) {
    ierr = PetscInfo1(ls,"OWArmijo line search error: beta_inf (%g) invalid\n", (double)armP->beta_inf);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if ((armP->sigma <= 0) || (armP->sigma >= 0.5)) {
    ierr = PetscInfo1(ls,"OWArmijo line search error: sigma (%g) invalid\n", (double)armP->sigma);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if (armP->memorySize < 1) {
    ierr = PetscInfo1(ls,"OWArmijo line search error: memory_size (%D) < 1\n", armP->memorySize);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  }  else if ((armP->referencePolicy != REFERENCE_MAX) && (armP->referencePolicy != REFERENCE_AVE) && (armP->referencePolicy != REFERENCE_MEAN)) {
    ierr = PetscInfo(ls,"OWArmijo line search error: reference_policy invalid\n");CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if ((armP->replacementPolicy != REPLACE_FIFO) && (armP->replacementPolicy != REPLACE_MRU)) {
    ierr = PetscInfo(ls,"OWArmijo line search error: replacement_policy invalid\n");CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if (PetscIsInfOrNanReal(*f)) {
    ierr = PetscInfo(ls,"OWArmijo line search error: initial function inf or nan\n");CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_BADPARAMETER;
  }

  if (ls->reason != TAOLINESEARCH_CONTINUE_ITERATING) PetscFunctionReturn(0);

  /* Check to see of the memory has been allocated.  If not, allocate
     the historical array and populate it with the initial function
     values. */
  if (!armP->memory) {
    ierr = PetscMalloc1(armP->memorySize, &armP->memory );CHKERRQ(ierr);
  }

  if (!armP->memorySetup) {
    for (i = 0; i < armP->memorySize; i++) {
      armP->memory[i] = armP->alpha*(*f);
    }
    armP->current = 0;
    armP->lastReference = armP->memory[0];
    armP->memorySetup=PETSC_TRUE;
  }

  /* Calculate reference value (MAX) */
  ref = armP->memory[0];
  idx = 0;

  for (i = 1; i < armP->memorySize; i++) {
    if (armP->memory[i] > ref) {
      ref = armP->memory[i];
      idx = i;
    }
  }

  if (armP->referencePolicy == REFERENCE_AVE) {
    ref = 0;
    for (i = 0; i < armP->memorySize; i++) {
      ref += armP->memory[i];
    }
    ref = ref / armP->memorySize;
    ref = PetscMax(ref, armP->memory[armP->current]);
  } else if (armP->referencePolicy == REFERENCE_MEAN) {
    ref = PetscMin(ref, 0.5*(armP->lastReference + armP->memory[armP->current]));
  }

  if (armP->nondescending) {
    fact = armP->sigma;
  }

  ierr = VecDuplicate(g,&g_old);CHKERRQ(ierr);
  ierr = VecCopy(g,g_old);CHKERRQ(ierr);

  ls->step = ls->initstep;
  while (ls->step >= owlqn_minstep && ls->nfeval < ls->max_funcs) {
    /* Calculate iterate */
    ierr = VecCopy(x,armP->work);CHKERRQ(ierr);
    ierr = VecAXPY(armP->work,ls->step,s);CHKERRQ(ierr);

    partgdx=0.0;
    ierr = ProjWork_OWLQN(armP->work,x,g_old,&partgdx);
    ierr = MPI_Allreduce(&partgdx,&gdx,1,MPIU_REAL,MPIU_SUM,comm);CHKERRQ(ierr);

    /* Check the condition of gdx */
    if (PetscIsInfOrNanReal(gdx)) {
      ierr = PetscInfo1(ls,"Initial Line Search step * g is Inf or Nan (%g)\n",(double)gdx);CHKERRQ(ierr);
      ls->reason=TAOLINESEARCH_FAILED_INFORNAN;
      PetscFunctionReturn(0);
    }
    if (gdx >= 0.0) {
      ierr = PetscInfo1(ls,"Initial Line Search step is not descent direction (g's=%g)\n",(double)gdx);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_FAILED_ASCENT;
      PetscFunctionReturn(0);
    }

    /* Calculate function at new iterate */
    ierr = TaoLineSearchComputeObjectiveAndGradient(ls,armP->work,f,g);CHKERRQ(ierr);
    g_computed=PETSC_TRUE;

    if (ls->step == ls->initstep) {
      ls->f_fullstep = *f;
    }

    if (PetscIsInfOrNanReal(*f)) {
      ls->step *= armP->beta_inf;
    } else {
      /* Check descent condition */
      if (armP->nondescending && *f <= ref - ls->step*fact*ref) break;
      if (!armP->nondescending && *f <= ref + armP->sigma * gdx) break;
      ls->step *= armP->beta;
    }
  }
  ierr = VecDestroy(&g_old);CHKERRQ(ierr);

  /* Check termination */
  if (PetscIsInfOrNanReal(*f)) {
    ierr = PetscInfo(ls, "Function is inf or nan.\n");CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_FAILED_BADPARAMETER;
  } else if (ls->step < owlqn_minstep) {
    ierr = PetscInfo(ls, "Step length is below tolerance.\n");CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_HALTED_RTOL;
  } else if (ls->nfeval >= ls->max_funcs) {
    ierr = PetscInfo2(ls, "Number of line search function evals (%D) > maximum allowed (%D)\n",ls->nfeval, ls->max_funcs);CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
  }
  if (ls->reason) PetscFunctionReturn(0);

  /* Successful termination, update memory */
  armP->lastReference = ref;
  if (armP->replacementPolicy == REPLACE_FIFO) {
    armP->memory[armP->current++] = *f;
    if (armP->current >= armP->memorySize) {
      armP->current = 0;
    }
  } else {
    armP->current = idx;
    armP->memory[idx] = *f;
  }

  /* Update iterate and compute gradient */
  ierr = VecCopy(armP->work,x);CHKERRQ(ierr);
  if (!g_computed) {
    ierr = TaoLineSearchComputeGradient(ls, x, g);CHKERRQ(ierr);
  }
  ierr = PetscInfo2(ls, "%D function evals in line search, step = %10.4f\n",ls->nfeval, (double)ls->step);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
Exemplo n.º 19
0
static PetscErrorCode SNESComputeJacobian_DMDA(SNES snes,Vec X,Mat *A,Mat *B,MatStructure *mstr,void *ctx)
{
  PetscErrorCode ierr;
  DM             dm;
  DMSNES_DA      *dmdasnes = (DMSNES_DA*)ctx;
  DMDALocalInfo  info;
  Vec            Xloc;
  void           *x;

  PetscFunctionBegin;
  if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
  ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);

  if (dmdasnes->jacobianlocal) {
    ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
    ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
    ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
    ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
    ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
    CHKMEMQ;
    ierr = (*dmdasnes->jacobianlocal)(&info,x,*A,*B,mstr,dmdasnes->jacobianlocalctx);CHKERRQ(ierr);
    CHKMEMQ;
    ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
    ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
  } else {
    MatFDColoring fdcoloring;
    ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
    if (!fdcoloring) {
      ISColoring coloring;

      ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
      ierr = MatFDColoringCreate(*B,coloring,&fdcoloring);CHKERRQ(ierr);
      ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
      switch (dm->coloringtype) {
      case IS_COLORING_GLOBAL:
        ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMDA,dmdasnes);CHKERRQ(ierr);
        break;
      default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
      }
      ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
      ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
      ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
      ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);

      /* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
       * VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
       * MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
       * drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
       * taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
       */
      ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
    }
    *mstr = SAME_NONZERO_PATTERN;
    ierr  = MatFDColoringApply(*B,fdcoloring,X,mstr,snes);CHKERRQ(ierr);
  }
  /* This will be redundant if the user called both, but it's too common to forget. */
  if (*A != *B) {
    ierr = MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
    ierr = MatAssemblyEnd(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 20
0
static PetscErrorCode TaoLineSearchApply_MT(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
  PetscErrorCode   ierr;
  TaoLineSearch_MT *mt;

  PetscReal        xtrapf = 4.0;
  PetscReal        finit, width, width1, dginit, fm, fxm, fym, dgm, dgxm, dgym;
  PetscReal        dgx, dgy, dg, dg2, fx, fy, stx, sty, dgtest;
  PetscReal        ftest1=0.0, ftest2=0.0;
  PetscInt         i, stage1,n1,n2,nn1,nn2;
  PetscReal        bstepmin1, bstepmin2, bstepmax;
  PetscBool        g_computed=PETSC_FALSE; /* to prevent extra gradient computation */

  PetscFunctionBegin;
  PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
  PetscValidHeaderSpecific(x,VEC_CLASSID,2);
  PetscValidScalarPointer(f,3);
  PetscValidHeaderSpecific(g,VEC_CLASSID,4);
  PetscValidHeaderSpecific(s,VEC_CLASSID,5);

  /* comm,type,size checks are done in interface TaoLineSearchApply */
  mt = (TaoLineSearch_MT*)(ls->data);
  ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;

  /* Check work vector */
  if (!mt->work) {
    ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
    mt->x = x;
    ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
  } else if (x != mt->x) {
    ierr = VecDestroy(&mt->work);CHKERRQ(ierr);
    ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
    ierr = PetscObjectDereference((PetscObject)mt->x);CHKERRQ(ierr);
    mt->x = x;
    ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
  }

  if (ls->bounded) {
    /* Compute step length needed to make all variables equal a bound */
    /* Compute the smallest steplength that will make one nonbinding variable
     equal the bound */
    ierr = VecGetLocalSize(ls->upper,&n1);CHKERRQ(ierr);
    ierr = VecGetLocalSize(mt->x, &n2);CHKERRQ(ierr);
    ierr = VecGetSize(ls->upper,&nn1);CHKERRQ(ierr);
    ierr = VecGetSize(mt->x,&nn2);CHKERRQ(ierr);
    if (n1 != n2 || nn1 != nn2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Variable vector not compatible with bounds vector");
    ierr = VecScale(s,-1.0);CHKERRQ(ierr);
    ierr = VecBoundGradientProjection(s,x,ls->lower,ls->upper,s);CHKERRQ(ierr);
    ierr = VecScale(s,-1.0);CHKERRQ(ierr);
    ierr = VecStepBoundInfo(x,s,ls->lower,ls->upper,&bstepmin1,&bstepmin2,&bstepmax);CHKERRQ(ierr);
    ls->stepmax = PetscMin(bstepmax,1.0e15);
  }

  ierr = VecDot(g,s,&dginit);CHKERRQ(ierr);
  if (PetscIsInfOrNanReal(dginit)) {
    ierr = PetscInfo1(ls,"Initial Line Search step * g is Inf or Nan (%g)\n",(double)dginit);CHKERRQ(ierr);
    ls->reason=TAOLINESEARCH_FAILED_INFORNAN;
    PetscFunctionReturn(0);
  }
  if (dginit >= 0.0) {
    ierr = PetscInfo1(ls,"Initial Line Search step * g is not descent direction (%g)\n",(double)dginit);CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_FAILED_ASCENT;
    PetscFunctionReturn(0);
  }


  /* Initialization */
  mt->bracket = 0;
  stage1 = 1;
  finit = *f;
  dgtest = ls->ftol * dginit;
  width = ls->stepmax - ls->stepmin;
  width1 = width * 2.0;
  ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
  /* Variable dictionary:
   stx, fx, dgx - the step, function, and derivative at the best step
   sty, fy, dgy - the step, function, and derivative at the other endpoint
   of the interval of uncertainty
   step, f, dg - the step, function, and derivative at the current step */

  stx = 0.0;
  fx  = finit;
  dgx = dginit;
  sty = 0.0;
  fy  = finit;
  dgy = dginit;

  ls->step=ls->initstep;
  for (i=0; i< ls->max_funcs; i++) {
    /* Set min and max steps to correspond to the interval of uncertainty */
    if (mt->bracket) {
      ls->stepmin = PetscMin(stx,sty);
      ls->stepmax = PetscMax(stx,sty);
    } else {
      ls->stepmin = stx;
      ls->stepmax = ls->step + xtrapf * (ls->step - stx);
    }

    /* Force the step to be within the bounds */
    ls->step = PetscMax(ls->step,ls->stepmin);
    ls->step = PetscMin(ls->step,ls->stepmax);

    /* If an unusual termination is to occur, then let step be the lowest
     point obtained thus far */
    if ((stx!=0) && (((mt->bracket) && (ls->step <= ls->stepmin || ls->step >= ls->stepmax)) || ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol * ls->stepmax)) ||
                     ((ls->nfeval+ls->nfgeval) >= ls->max_funcs - 1) || (mt->infoc == 0))) {
      ls->step = stx;
    }

    ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
    ierr = VecAXPY(mt->work,ls->step,s);CHKERRQ(ierr);   /* W = X + step*S */

    if (ls->bounded) {
      ierr = VecMedian(ls->lower, mt->work, ls->upper, mt->work);CHKERRQ(ierr);
    }
    if (ls->usegts) {
      ierr = TaoLineSearchComputeObjectiveAndGTS(ls,mt->work,f,&dg);CHKERRQ(ierr);
      g_computed=PETSC_FALSE;
    } else {
      ierr = TaoLineSearchComputeObjectiveAndGradient(ls,mt->work,f,g);CHKERRQ(ierr);
      g_computed=PETSC_TRUE;
      if (ls->bounded) {
        ierr = VecDot(g,x,&dg);CHKERRQ(ierr);
        ierr = VecDot(g,mt->work,&dg2);CHKERRQ(ierr);
        dg = (dg2 - dg)/ls->step;
      } else {
        ierr = VecDot(g,s,&dg);CHKERRQ(ierr);
      }
    }

    if (0 == i) {
      ls->f_fullstep=*f;
    }

    if (PetscIsInfOrNanReal(*f) || PetscIsInfOrNanReal(dg)) {
      /* User provided compute function generated Not-a-Number, assume
       domain violation and set function value and directional
       derivative to infinity. */
      *f = PETSC_INFINITY;
      dg = PETSC_INFINITY;
    }

    ftest1 = finit + ls->step * dgtest;
    if (ls->bounded) {
      ftest2 = finit + ls->step * dgtest * ls->ftol;
    }
    /* Convergence testing */
    if (((*f - ftest1 <= 1.0e-10 * PetscAbsReal(finit)) &&  (PetscAbsReal(dg) + ls->gtol*dginit <= 0.0))) {
      ierr = PetscInfo(ls, "Line search success: Sufficient decrease and directional deriv conditions hold\n");CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_SUCCESS;
      break;
    }

    /* Check Armijo if beyond the first breakpoint */
    if (ls->bounded && (*f <= ftest2) && (ls->step >= bstepmin2)) {
      ierr = PetscInfo(ls,"Line search success: Sufficient decrease.\n");CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_SUCCESS;
      break;
    }

    /* Checks for bad cases */
    if (((mt->bracket) && (ls->step <= ls->stepmin||ls->step >= ls->stepmax)) || (!mt->infoc)) {
      ierr = PetscInfo(ls,"Rounding errors may prevent further progress.  May not be a step satisfying\n");CHKERRQ(ierr);
      ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n");CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_OTHER;
      break;
    }
    if ((ls->step == ls->stepmax) && (*f <= ftest1) && (dg <= dgtest)) {
      ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
      break;
    }
    if ((ls->step == ls->stepmin) && (*f >= ftest1) && (dg >= dgtest)) {
      ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
      break;
    }
    if ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
      ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol);CHKERRQ(ierr);
      ls->reason = TAOLINESEARCH_HALTED_RTOL;
      break;
    }

    /* In the first stage, we seek a step for which the modified function
     has a nonpositive value and nonnegative derivative */
    if ((stage1) && (*f <= ftest1) && (dg >= dginit * PetscMin(ls->ftol, ls->gtol))) {
      stage1 = 0;
    }

    /* A modified function is used to predict the step only if we
     have not obtained a step for which the modified function has a
     nonpositive function value and nonnegative derivative, and if a
     lower function value has been obtained but the decrease is not
     sufficient */

    if ((stage1) && (*f <= fx) && (*f > ftest1)) {
      fm   = *f - ls->step * dgtest;    /* Define modified function */
      fxm  = fx - stx * dgtest;         /* and derivatives */
      fym  = fy - sty * dgtest;
      dgm  = dg - dgtest;
      dgxm = dgx - dgtest;
      dgym = dgy - dgtest;

      /* if (dgxm * (ls->step - stx) >= 0.0) */
      /* Update the interval of uncertainty and compute the new step */
      ierr = Tao_mcstep(ls,&stx,&fxm,&dgxm,&sty,&fym,&dgym,&ls->step,&fm,&dgm);CHKERRQ(ierr);

      fx  = fxm + stx * dgtest; /* Reset the function and */
      fy  = fym + sty * dgtest; /* gradient values */
      dgx = dgxm + dgtest;
      dgy = dgym + dgtest;
    } else {
      /* Update the interval of uncertainty and compute the new step */
      ierr = Tao_mcstep(ls,&stx,&fx,&dgx,&sty,&fy,&dgy,&ls->step,f,&dg);CHKERRQ(ierr);
    }

    /* Force a sufficient decrease in the interval of uncertainty */
    if (mt->bracket) {
      if (PetscAbsReal(sty - stx) >= 0.66 * width1) ls->step = stx + 0.5*(sty - stx);
      width1 = width;
      width = PetscAbsReal(sty - stx);
    }
  }
  if ((ls->nfeval+ls->nfgeval) > ls->max_funcs) {
    ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",(ls->nfeval+ls->nfgeval),ls->max_funcs);CHKERRQ(ierr);
    ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
  }

  /* Finish computations */
  ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",(ls->nfeval+ls->nfgeval),(double)ls->step);CHKERRQ(ierr);

  /* Set new solution vector and compute gradient if needed */
  ierr = VecCopy(mt->work,x);CHKERRQ(ierr);
  if (!g_computed) {
    ierr = TaoLineSearchComputeGradient(ls,mt->work,g);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Exemplo n.º 21
0
PetscErrorCode SNESSetFromOptions_FAS(PetscOptionItems *PetscOptionsObject,SNES snes)
{
  SNES_FAS       *fas   = (SNES_FAS*) snes->data;
  PetscInt       levels = 1;
  PetscBool      flg    = PETSC_FALSE, upflg = PETSC_FALSE, downflg = PETSC_FALSE, monflg = PETSC_FALSE, galerkinflg = PETSC_FALSE,continuationflg = PETSC_FALSE;
  PetscErrorCode ierr;
  SNESFASType    fastype;
  const char     *optionsprefix;
  SNESLineSearch linesearch;
  PetscInt       m, n_up, n_down;
  SNES           next;
  PetscBool      isFine;

  PetscFunctionBegin;
  ierr = SNESFASCycleIsFine(snes, &isFine);CHKERRQ(ierr);
  ierr = PetscOptionsHead(PetscOptionsObject,"SNESFAS Options-----------------------------------");CHKERRQ(ierr);

  /* number of levels -- only process most options on the finest level */
  if (isFine) {
    ierr = PetscOptionsInt("-snes_fas_levels", "Number of Levels", "SNESFASSetLevels", levels, &levels, &flg);CHKERRQ(ierr);
    if (!flg && snes->dm) {
      ierr = DMGetRefineLevel(snes->dm,&levels);CHKERRQ(ierr);
      levels++;
      fas->usedmfornumberoflevels = PETSC_TRUE;
    }
    ierr    = SNESFASSetLevels(snes, levels, NULL);CHKERRQ(ierr);
    fastype = fas->fastype;
    ierr    = PetscOptionsEnum("-snes_fas_type","FAS correction type","SNESFASSetType",SNESFASTypes,(PetscEnum)fastype,(PetscEnum*)&fastype,&flg);CHKERRQ(ierr);
    if (flg) {
      ierr = SNESFASSetType(snes, fastype);CHKERRQ(ierr);
    }

    ierr = SNESGetOptionsPrefix(snes, &optionsprefix);CHKERRQ(ierr);
    ierr = PetscOptionsInt("-snes_fas_cycles","Number of cycles","SNESFASSetCycles",fas->n_cycles,&m,&flg);CHKERRQ(ierr);
    if (flg) {
      ierr = SNESFASSetCycles(snes, m);CHKERRQ(ierr);
    }
    ierr = PetscOptionsBool("-snes_fas_continuation","Corrected grid-sequence continuation","SNESFASSetContinuation",fas->continuation,&continuationflg,&flg);CHKERRQ(ierr);
    if (flg) {
      ierr = SNESFASSetContinuation(snes,continuationflg);CHKERRQ(ierr);
    }

    ierr = PetscOptionsBool("-snes_fas_galerkin", "Form coarse problems with Galerkin","SNESFASSetGalerkin",fas->galerkin,&galerkinflg,&flg);CHKERRQ(ierr);
    if (flg) {
      ierr = SNESFASSetGalerkin(snes, galerkinflg);CHKERRQ(ierr);
    }

    if (fas->fastype == SNES_FAS_FULL) {
      ierr   = PetscOptionsBool("-snes_fas_full_downsweep","Smooth on the initial upsweep for full FAS cycles","SNESFASFullSetDownSweep",fas->full_downsweep,&fas->full_downsweep,&flg);CHKERRQ(ierr);
      if (flg) {SNESFASFullSetDownSweep(snes,fas->full_downsweep);CHKERRQ(ierr);}
    }

    ierr = PetscOptionsInt("-snes_fas_smoothup","Number of post-smoothing steps","SNESFASSetNumberSmoothUp",fas->max_up_it,&n_up,&upflg);CHKERRQ(ierr);

    ierr = PetscOptionsInt("-snes_fas_smoothdown","Number of pre-smoothing steps","SNESFASSetNumberSmoothDown",fas->max_down_it,&n_down,&downflg);CHKERRQ(ierr);

    {
      PetscViewer viewer;
      PetscViewerFormat format;
      ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)snes),((PetscObject)snes)->prefix,
                                   "-snes_fas_monitor",&viewer,&format,&monflg);CHKERRQ(ierr);
      if (monflg) {
        PetscViewerAndFormat *vf;
        ierr = PetscViewerAndFormatCreate(viewer,format,&vf);CHKERRQ(ierr);
        ierr = PetscObjectDereference((PetscObject)viewer);CHKERRQ(ierr);
        ierr = SNESFASSetMonitor(snes,vf,PETSC_TRUE);CHKERRQ(ierr);
      }
    }
    flg    = PETSC_FALSE;
    monflg = PETSC_TRUE;
    ierr   = PetscOptionsBool("-snes_fas_log","Log times for each FAS level","SNESFASSetLog",monflg,&monflg,&flg);CHKERRQ(ierr);
    if (flg) {ierr = SNESFASSetLog(snes,monflg);CHKERRQ(ierr);}
  }

  ierr = PetscOptionsTail();CHKERRQ(ierr);
  /* setup from the determined types if there is no pointwise procedure or smoother defined */
  if (upflg) {
    ierr = SNESFASSetNumberSmoothUp(snes,n_up);CHKERRQ(ierr);
  }
  if (downflg) {
    ierr = SNESFASSetNumberSmoothDown(snes,n_down);CHKERRQ(ierr);
  }

  /* set up the default line search for coarse grid corrections */
  if (fas->fastype == SNES_FAS_ADDITIVE) {
    if (!snes->linesearch) {
      ierr = SNESGetLineSearch(snes, &linesearch);CHKERRQ(ierr);
      ierr = SNESLineSearchSetType(linesearch, SNESLINESEARCHL2);CHKERRQ(ierr);
    }
  }

  ierr = SNESFASCycleGetCorrection(snes, &next);CHKERRQ(ierr);
  /* recursive option setting for the smoothers */
  if (next) {ierr = SNESSetFromOptions(next);CHKERRQ(ierr);}
  PetscFunctionReturn(0);
}
Exemplo n.º 22
0
Arquivo: mg.c Projeto: ziolai/petsc
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);
}
Exemplo n.º 23
0
extern PetscErrorCode MatLMVMUpdate(Mat M, Vec x, Vec g)
{
  MatLMVMCtx     *ctx;
  PetscReal      rhotemp, rhotol;
  PetscReal      y0temp, s0temp;
  PetscReal      yDy, yDs, sDs;
  PetscReal      sigmanew, denom;
  PetscErrorCode ierr;
  PetscInt       i;
  PetscBool      same;
  PetscReal      yy_sum=0.0, ys_sum=0.0, ss_sum=0.0;

  PetscFunctionBegin;
  PetscValidHeaderSpecific(x,VEC_CLASSID,2);
  PetscValidHeaderSpecific(g,VEC_CLASSID,3);
  ierr = PetscObjectTypeCompare((PetscObject)M,MATSHELL,&same);CHKERRQ(ierr);
  if (!same) SETERRQ(PETSC_COMM_SELF,1,"Matrix M is not type MatLMVM");
  ierr = MatShellGetContext(M,(void**)&ctx);CHKERRQ(ierr);
  if (!ctx->allocated) {
    ierr = MatLMVMAllocateVectors(M, x); CHKERRQ(ierr);
  }

  if (0 == ctx->iter) {
    ierr = MatLMVMReset(M);CHKERRQ(ierr);
  }  else {
    ierr = VecAYPX(ctx->Gprev,-1.0,g);CHKERRQ(ierr);
    ierr = VecAYPX(ctx->Xprev,-1.0,x);CHKERRQ(ierr);

    ierr = VecDot(ctx->Gprev,ctx->Xprev,&rhotemp);CHKERRQ(ierr);
    ierr = VecDot(ctx->Gprev,ctx->Gprev,&y0temp);CHKERRQ(ierr);

    rhotol = ctx->eps * y0temp;
    if (rhotemp > rhotol) {
      ++ctx->nupdates;

      ctx->lmnow = PetscMin(ctx->lmnow+1, ctx->lm);
      ierr=PetscObjectDereference((PetscObject)ctx->S[ctx->lm]);CHKERRQ(ierr);
      ierr=PetscObjectDereference((PetscObject)ctx->Y[ctx->lm]);CHKERRQ(ierr);
      for (i = ctx->lm-1; i >= 0; --i) {
        ctx->S[i+1] = ctx->S[i];
        ctx->Y[i+1] = ctx->Y[i];
        ctx->rho[i+1] = ctx->rho[i];
      }
      ctx->S[0] = ctx->Xprev;
      ctx->Y[0] = ctx->Gprev;
      PetscObjectReference((PetscObject)ctx->S[0]);
      PetscObjectReference((PetscObject)ctx->Y[0]);
      ctx->rho[0] = 1.0 / rhotemp;

      /*  Compute the scaling */
      switch(ctx->scaleType) {
      case MatLMVM_Scale_None:
        break;

      case MatLMVM_Scale_Scalar:
        /*  Compute s^T s  */
          ierr = VecDot(ctx->Xprev,ctx->Xprev,&s0temp);CHKERRQ(ierr);

        /*  Scalar is positive; safeguards are not required. */

        /*  Save information for scalar scaling */
        ctx->yy_history[(ctx->nupdates - 1) % ctx->scalar_history] = y0temp;
        ctx->ys_history[(ctx->nupdates - 1) % ctx->scalar_history] = rhotemp;
        ctx->ss_history[(ctx->nupdates - 1) % ctx->scalar_history] = s0temp;

        /*  Compute summations for scalar scaling */
        yy_sum = 0;     /*  No safeguard required; y^T y > 0 */
        ys_sum = 0;     /*  No safeguard required; y^T s > 0 */
        ss_sum = 0;     /*  No safeguard required; s^T s > 0 */
        for (i = 0; i < PetscMin(ctx->nupdates, ctx->scalar_history); ++i) {
          yy_sum += ctx->yy_history[i];
          ys_sum += ctx->ys_history[i];
          ss_sum += ctx->ss_history[i];
        }

        if (0.0 == ctx->s_alpha) {
          /*  Safeguard ys_sum  */
          if (0.0 == ys_sum) {
            ys_sum = TAO_ZERO_SAFEGUARD;
          }

          sigmanew = ss_sum / ys_sum;
        } else if (1.0 == ctx->s_alpha) {
          /*  Safeguard yy_sum  */
          if (0.0 == yy_sum) {
            yy_sum = TAO_ZERO_SAFEGUARD;
          }

          sigmanew = ys_sum / yy_sum;
        } else {
          denom = 2*ctx->s_alpha*yy_sum;

          /*  Safeguard denom */
          if (0.0 == denom) {
            denom = TAO_ZERO_SAFEGUARD;
          }

          sigmanew = ((2*ctx->s_alpha-1)*ys_sum +  PetscSqrtScalar((2*ctx->s_alpha-1)*(2*ctx->s_alpha-1)*ys_sum*ys_sum - 4*(ctx->s_alpha)*(ctx->s_alpha-1)*yy_sum*ss_sum)) / denom;
        }

        switch(ctx->limitType) {
        case MatLMVM_Limit_Average:
          if (1.0 == ctx->mu) {
            ctx->sigma = sigmanew;
          } else if (ctx->mu) {
            ctx->sigma = ctx->mu * sigmanew + (1.0 - ctx->mu) * ctx->sigma;
          }
          break;

        case MatLMVM_Limit_Relative:
          if (ctx->mu) {
            ctx->sigma = TaoMid((1.0 - ctx->mu) * ctx->sigma, sigmanew, (1.0 + ctx->mu) * ctx->sigma);
          }
          break;

        case MatLMVM_Limit_Absolute:
          if (ctx->nu) {
            ctx->sigma = TaoMid(ctx->sigma - ctx->nu, sigmanew, ctx->sigma + ctx->nu);
          }
          break;

        default:
          ctx->sigma = sigmanew;
          break;
        }
        break;

      case MatLMVM_Scale_Broyden:
        /*  Original version */
        /*  Combine DFP and BFGS */

        /*  This code appears to be numerically unstable.  We use the */
        /*  original version because this was used to generate all of */
        /*  the data and because it may be the least unstable of the */
        /*  bunch. */

        /*  P = Q = inv(D); */
        ierr = VecCopy(ctx->D,ctx->P);CHKERRQ(ierr);
        ierr = VecReciprocal(ctx->P);CHKERRQ(ierr);
        ierr = VecCopy(ctx->P,ctx->Q);CHKERRQ(ierr);

        /*  V = y*y */
        ierr = VecPointwiseMult(ctx->V,ctx->Gprev,ctx->Gprev);CHKERRQ(ierr);

        /*  W = inv(D)*s */
        ierr = VecPointwiseMult(ctx->W,ctx->Xprev,ctx->P);CHKERRQ(ierr);
        ierr = VecDot(ctx->W,ctx->Xprev,&sDs);CHKERRQ(ierr);

        /*  Safeguard rhotemp and sDs */
        if (0.0 == rhotemp) {
          rhotemp = TAO_ZERO_SAFEGUARD;
        }

        if (0.0 == sDs) {
          sDs = TAO_ZERO_SAFEGUARD;
        }

        if (1.0 != ctx->phi) {
          /*  BFGS portion of the update */
          /*  U = (inv(D)*s)*(inv(D)*s) */
          ierr = VecPointwiseMult(ctx->U,ctx->W,ctx->W);CHKERRQ(ierr);

          /*  Assemble */
          ierr = VecAXPY(ctx->P,1.0/rhotemp,ctx->V);CHKERRQ(ierr);
          ierr = VecAXPY(ctx->P,-1.0/sDs,ctx->U);CHKERRQ(ierr);
        }

        if (0.0 != ctx->phi) {
          /*  DFP portion of the update */
          /*  U = inv(D)*s*y */
          ierr = VecPointwiseMult(ctx->U, ctx->W, ctx->Gprev);CHKERRQ(ierr);

          /*  Assemble */
          ierr = VecAXPY(ctx->Q,1.0/rhotemp + sDs/(rhotemp*rhotemp), ctx->V);CHKERRQ(ierr);
          ierr = VecAXPY(ctx->Q,-2.0/rhotemp,ctx->U);CHKERRQ(ierr);
        }

        if (0.0 == ctx->phi) {
            ierr = VecCopy(ctx->P,ctx->U);CHKERRQ(ierr);
        } else if (1.0 == ctx->phi) {
            ierr = VecCopy(ctx->Q,ctx->U);CHKERRQ(ierr);
        } else {
          /*  Broyden update U=(1-phi)*P + phi*Q */
            ierr = VecCopy(ctx->Q,ctx->U);CHKERRQ(ierr);
            ierr = VecAXPBY(ctx->U,1.0-ctx->phi, ctx->phi, ctx->P);CHKERRQ(ierr);
        }

        /*  Obtain inverse and ensure positive definite */
        ierr = VecReciprocal(ctx->U);CHKERRQ(ierr);
        ierr = VecAbs(ctx->U);CHKERRQ(ierr);

        switch(ctx->rScaleType) {
        case MatLMVM_Rescale_None:
            break;

        case MatLMVM_Rescale_Scalar:
        case MatLMVM_Rescale_GL:
          if (ctx->rScaleType == MatLMVM_Rescale_GL) {
            /*  Gilbert and Lemarachal use the old diagonal */
            ierr = VecCopy(ctx->D,ctx->P);CHKERRQ(ierr);
          } else {
            /*  The default version uses the current diagonal */
              ierr = VecCopy(ctx->U,ctx->P);CHKERRQ(ierr);
          }

          /*  Compute s^T s  */
          ierr = VecDot(ctx->Xprev,ctx->Xprev,&s0temp);CHKERRQ(ierr);

          /*  Save information for special cases of scalar rescaling */
          ctx->yy_rhistory[(ctx->nupdates - 1) % ctx->rescale_history] = y0temp;
          ctx->ys_rhistory[(ctx->nupdates - 1) % ctx->rescale_history] = rhotemp;
          ctx->ss_rhistory[(ctx->nupdates - 1) % ctx->rescale_history] = s0temp;

          if (0.5 == ctx->r_beta) {
            if (1 == PetscMin(ctx->nupdates, ctx->rescale_history)) {
              ierr = VecPointwiseMult(ctx->V,ctx->Y[0],ctx->P);CHKERRQ(ierr);
              ierr = VecDot(ctx->V,ctx->Y[0],&yy_sum);CHKERRQ(ierr);

              ierr = VecPointwiseDivide(ctx->W,ctx->S[0],ctx->P);CHKERRQ(ierr);
              ierr = VecDot(ctx->W,ctx->S[0],&ss_sum);CHKERRQ(ierr);

              ys_sum = ctx->ys_rhistory[0];
            } else {
              ierr = VecCopy(ctx->P,ctx->Q);CHKERRQ(ierr);
              ierr = VecReciprocal(ctx->Q);CHKERRQ(ierr);

              /*  Compute summations for scalar scaling */
              yy_sum = 0;       /*  No safeguard required */
              ys_sum = 0;       /*  No safeguard required */
              ss_sum = 0;       /*  No safeguard required */
              for (i = 0; i < PetscMin(ctx->nupdates, ctx->rescale_history); ++i) {
                ierr = VecPointwiseMult(ctx->V,ctx->Y[i],ctx->P);CHKERRQ(ierr);
                ierr = VecDot(ctx->V,ctx->Y[i],&yDy);CHKERRQ(ierr);
                yy_sum += yDy;

                ierr = VecPointwiseMult(ctx->W,ctx->S[i],ctx->Q);CHKERRQ(ierr);
                ierr = VecDot(ctx->W,ctx->S[i],&sDs);CHKERRQ(ierr);
                ss_sum += sDs;
                ys_sum += ctx->ys_rhistory[i];
              }
            }
          } else if (0.0 == ctx->r_beta) {
            if (1 == PetscMin(ctx->nupdates, ctx->rescale_history)) {
              /*  Compute summations for scalar scaling */
              ierr = VecPointwiseDivide(ctx->W,ctx->S[0],ctx->P);CHKERRQ(ierr);

              ierr = VecDot(ctx->W, ctx->Y[0], &ys_sum);CHKERRQ(ierr);
              ierr = VecDot(ctx->W, ctx->W, &ss_sum);CHKERRQ(ierr);
              yy_sum += ctx->yy_rhistory[0];
            } else {
              ierr = VecCopy(ctx->Q, ctx->P);CHKERRQ(ierr);
              ierr = VecReciprocal(ctx->Q);CHKERRQ(ierr);

              /*  Compute summations for scalar scaling */
              yy_sum = 0;       /*  No safeguard required */
              ys_sum = 0;       /*  No safeguard required */
              ss_sum = 0;       /*  No safeguard required */
              for (i = 0; i < PetscMin(ctx->nupdates, ctx->rescale_history); ++i) {
                ierr = VecPointwiseMult(ctx->W, ctx->S[i], ctx->Q);CHKERRQ(ierr);
                ierr = VecDot(ctx->W, ctx->Y[i], &yDs);CHKERRQ(ierr);
                ys_sum += yDs;

                ierr = VecDot(ctx->W, ctx->W, &sDs);CHKERRQ(ierr);
                ss_sum += sDs;

                yy_sum += ctx->yy_rhistory[i];
              }
            }
          } else if (1.0 == ctx->r_beta) {
            /*  Compute summations for scalar scaling */
            yy_sum = 0; /*  No safeguard required */
            ys_sum = 0; /*  No safeguard required */
            ss_sum = 0; /*  No safeguard required */
            for (i = 0; i < PetscMin(ctx->nupdates, ctx->rescale_history); ++i) {
              ierr = VecPointwiseMult(ctx->V, ctx->Y[i], ctx->P);CHKERRQ(ierr);
              ierr = VecDot(ctx->V, ctx->S[i], &yDs);CHKERRQ(ierr);
              ys_sum += yDs;

              ierr = VecDot(ctx->V, ctx->V, &yDy);CHKERRQ(ierr);
              yy_sum += yDy;

              ss_sum += ctx->ss_rhistory[i];
            }
          } else {
            ierr = VecCopy(ctx->Q, ctx->P);CHKERRQ(ierr);

            ierr = VecPow(ctx->P, ctx->r_beta);CHKERRQ(ierr);
            ierr = VecPointwiseDivide(ctx->Q, ctx->P, ctx->Q);CHKERRQ(ierr);

            /*  Compute summations for scalar scaling */
            yy_sum = 0; /*  No safeguard required */
            ys_sum = 0; /*  No safeguard required */
            ss_sum = 0; /*  No safeguard required */
            for (i = 0; i < PetscMin(ctx->nupdates, ctx->rescale_history); ++i) {
              ierr = VecPointwiseMult(ctx->V, ctx->P, ctx->Y[i]);CHKERRQ(ierr);
              ierr = VecPointwiseMult(ctx->W, ctx->Q, ctx->S[i]);CHKERRQ(ierr);

              ierr = VecDot(ctx->V, ctx->V, &yDy);CHKERRQ(ierr);
              ierr = VecDot(ctx->V, ctx->W, &yDs);CHKERRQ(ierr);
              ierr = VecDot(ctx->W, ctx->W, &sDs);CHKERRQ(ierr);

              yy_sum += yDy;
              ys_sum += yDs;
              ss_sum += sDs;
            }
          }

          if (0.0 == ctx->r_alpha) {
            /*  Safeguard ys_sum  */
            if (0.0 == ys_sum) {
              ys_sum = TAO_ZERO_SAFEGUARD;
            }

            sigmanew = ss_sum / ys_sum;
          } else if (1.0 == ctx->r_alpha) {
            /*  Safeguard yy_sum  */
            if (0.0 == yy_sum) {
              ys_sum = TAO_ZERO_SAFEGUARD;
            }

            sigmanew = ys_sum / yy_sum;
          } else {
            denom = 2*ctx->r_alpha*yy_sum;

            /*  Safeguard denom */
            if (0.0 == denom) {
              denom = TAO_ZERO_SAFEGUARD;
            }

            sigmanew = ((2*ctx->r_alpha-1)*ys_sum + PetscSqrtScalar((2*ctx->r_alpha-1)*(2*ctx->r_alpha-1)*ys_sum*ys_sum - 4*ctx->r_alpha*(ctx->r_alpha-1)*yy_sum*ss_sum)) / denom;
          }

          /*  If Q has small values, then Q^(r_beta - 1) */
          /*  can have very large values.  Hence, ys_sum */
          /*  and ss_sum can be infinity.  In this case, */
          /*  sigmanew can either be not-a-number or infinity. */

          if (PetscIsInfOrNanReal(sigmanew)) {
            /*  sigmanew is not-a-number; skip rescaling */
          } else if (!sigmanew) {
            /*  sigmanew is zero; this is a bad case; skip rescaling */
          } else {
            /*  sigmanew is positive */
            ierr = VecScale(ctx->U, sigmanew);CHKERRQ(ierr);
          }
          break;
        }

        /*  Modify for previous information */
        switch(ctx->limitType) {
        case MatLMVM_Limit_Average:
          if (1.0 == ctx->mu) {
            ierr = VecCopy(ctx->D, ctx->U);CHKERRQ(ierr);
          } else if (ctx->mu) {
            ierr = VecAXPBY(ctx->D,ctx->mu, 1.0-ctx->mu,ctx->U);CHKERRQ(ierr);
          }
          break;

        case MatLMVM_Limit_Relative:
          if (ctx->mu) {
            /*  P = (1-mu) * D */
            ierr = VecAXPBY(ctx->P, 1.0-ctx->mu, 0.0, ctx->D);CHKERRQ(ierr);
            /*  Q = (1+mu) * D */
            ierr = VecAXPBY(ctx->Q, 1.0+ctx->mu, 0.0, ctx->D);CHKERRQ(ierr);
            ierr = VecMedian(ctx->P, ctx->U, ctx->Q, ctx->D);CHKERRQ(ierr);
          }
          break;

        case MatLMVM_Limit_Absolute:
          if (ctx->nu) {
            ierr = VecCopy(ctx->P, ctx->D);CHKERRQ(ierr);
            ierr = VecShift(ctx->P, -ctx->nu);CHKERRQ(ierr);
            ierr = VecCopy(ctx->D, ctx->Q);CHKERRQ(ierr);
            ierr = VecShift(ctx->Q, ctx->nu);CHKERRQ(ierr);
            ierr = VecMedian(ctx->P, ctx->U, ctx->Q, ctx->P);CHKERRQ(ierr);
          }
          break;

        default:
            ierr = VecCopy(ctx->U, ctx->D);CHKERRQ(ierr);
          break;
        }
        break;
      }
      ierr = PetscObjectDereference((PetscObject)ctx->Xprev);CHKERRQ(ierr);
      ierr = PetscObjectDereference((PetscObject)ctx->Gprev);CHKERRQ(ierr);
      ctx->Xprev = ctx->S[ctx->lm];
      ctx->Gprev = ctx->Y[ctx->lm];
      ierr = PetscObjectReference((PetscObject)ctx->S[ctx->lm]);CHKERRQ(ierr);
      ierr = PetscObjectReference((PetscObject)ctx->Y[ctx->lm]);CHKERRQ(ierr);

    } else {
      ++ctx->nrejects;
    }
  }

  ++ctx->iter;
  ierr = VecCopy(x, ctx->Xprev);CHKERRQ(ierr);
  ierr = VecCopy(g, ctx->Gprev);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}