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);
}
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);
}
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);
}
/*@
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);
}
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);
}
/*@
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);
}
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);
}
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);
}
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);
}
/*@
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);
}
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);
}
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);
}
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);
}
/*@
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);
}
/*@
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);
}
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);
}
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);
}
/* @ 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);
}
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);
}
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);
}
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);
}
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);
}
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);
}