bool PotentialSolve::Solve(Vec delta, Vec pot, double bias) {
PetscInt its;
KSPConvergedReason reason;
bool retval;
// Delta to -Delta
VecScale(delta, -1.0/bias);
// Actually solve
KSPSolve(solver, delta, pot);
KSPGetConvergedReason(solver,&reason);
if (reason<0) {
PetscPrintf(PETSC_COMM_WORLD,"Diverged : %d.\n",reason);
retval=false;
} else {
KSPGetIterationNumber(solver,&its);
PetscPrintf(PETSC_COMM_WORLD,"\nConvergence in %d iterations.\n",(int)its);
retval=true;
}
// Remove any values that might have crept in here
_dg1.ZeroPad(pot);
// Clean up
VecScale(delta, -1.0*bias);
return retval;
}
MGSolver_Status _GetSolveStatus( MGSolver_PETScData* mgData ) {
PC pc;
const KSPType kspType;
const PCType pcType;
KSPConvergedReason reason;
PetscErrorCode ec;
ec = KSPGetType( mgData->ksp, &kspType );
CheckPETScError( ec );
ec = KSPGetPC( mgData->ksp, &pc );
CheckPETScError( ec );
ec = PCGetType( pc, &pcType );
CheckPETScError( ec );
if( !strcmp( kspType, KSPRICHARDSON ) && !strcmp( pcType, PCSOR ) ) {
double rnorm;
PetscInt curIt;
//rnorm = PETScMatrixSolver_GetResidualNorm( self );
//curIt = PETScMatrixSolver_GetIterations( self );
rnorm = _GetResidualNorm( mgData );
KSPGetIterationNumber( mgData->ksp, &curIt );
//PETScMatrixSolver_SetNormType( self, MultigridSolver_NormType_Preconditioned );
KSPSetNormType( mgData->ksp, MultigridSolver_NormType_Preconditioned );
ec = KSPDefaultConverged( mgData->ksp, curIt, (PetscScalar)rnorm, &reason, PETSC_NULL );
CheckPETScError( ec );
}
else {
ec = KSPGetConvergedReason( mgData->ksp, &reason );
CheckPETScError( ec );
}
return reason;
}
/// Solve again w/ the specified RHS, put result in specified vector (specialized)
void p_resolveImpl(const VectorType& b, VectorType& x) const
{
PetscErrorCode ierr(0);
int me(this->processor_rank());
try {
const Vec *bvec(PETScVector(b));
Vec *xvec(PETScVector(x));
ierr = KSPSolve(p_KSP, *bvec, *xvec); CHKERRXX(ierr);
int its;
KSPConvergedReason reason;
PetscReal rnorm;
ierr = KSPGetIterationNumber(p_KSP, &its); CHKERRXX(ierr);
ierr = KSPGetConvergedReason(p_KSP, &reason); CHKERRXX(ierr);
ierr = KSPGetResidualNorm(p_KSP, &rnorm); CHKERRXX(ierr);
std::string msg;
if (reason < 0) {
msg =
boost::str(boost::format("%d: PETSc KSP diverged after %d iterations, reason: %d") %
me % its % reason);
throw Exception(msg);
} else if (me == 0) {
msg =
boost::str(boost::format("%d: PETSc KSP converged after %d iterations, reason: %d") %
me % its % reason);
std::cerr << msg << std::endl;
}
} catch (const PETSC_EXCEPTION_TYPE& e) {
throw PETScException(ierr, e);
} catch (const Exception& e) {
throw e;
}
}
PetscErrorCode SolvePressure(UserContext *uc)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscLogEventBegin(EVENT_SolvePressure,0,0,0,0);
ierr = KSPCreate(PETSC_COMM_WORLD, &uc->ksp); CHKERRQ(ierr);
ierr = KSPSetType(uc->ksp,KSPCG); CHKERRQ(ierr);
ierr = KSPSetOperators(uc->ksp,uc->A,uc->A,SAME_NONZERO_PATTERN); CHKERRQ(ierr);
ierr = KSPSetFromOptions(uc->ksp); CHKERRQ(ierr);
ierr = KSPSetTolerances(uc->ksp, 0.000001, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT); CHKERRQ(ierr);
ierr = KSPSetType( uc->ksp, KSPPREONLY); CHKERRQ(ierr);
PC pc;
ierr = KSPGetPC(uc->ksp, &pc); CHKERRQ(ierr);
ierr = PCSetType(pc, PCLU); CHKERRQ(ierr);
ierr = KSPSolve(uc->ksp,uc->b,uc->p);CHKERRQ(ierr);
KSPConvergedReason reason;
KSPGetConvergedReason(uc->ksp,&reason);
PetscPrintf(PETSC_COMM_WORLD,"Pressure KSPConvergedReason: %D\n", reason);
// if( reason < 0 ) SETERRQ(PETSC_ERR_CONV_FAILED, "Exiting: Failed to converge\n");
PetscLogEventEnd(EVENT_SolvePressure,0,0,0,0);
PetscFunctionReturn(0);
}
/**
My handrolled SNES monitor. Gives some information about KSP convergence as well
as looking pretty.
@param snes Petsc nonlinear context
@param its number of iterations
@param norm norm of nonlinear residual
@param dctx application context
*/
PetscErrorCode MonitorFunction(SNES snes, PetscInt its, double norm, void *dctx)
{
PetscErrorCode ierr;
PetscInt lits;
PetscMPIInt rank;
KSP ksp;
KSPConvergedReason kspreason;
PetscReal kspnorm;
PetscFunctionBegin;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(ksp, &kspreason);CHKERRQ(ierr);
ierr = KSPGetResidualNorm(ksp, &kspnorm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp, &lits);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, " %d SNES norm %e, %d KSP its last norm %e",
its, norm, lits, kspnorm);CHKERRQ(ierr);
if (kspreason < 0) {
ierr = PetscPrintf(PETSC_COMM_WORLD, ", KSP failed: %s", KSPConvergedReasons[kspreason]);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD, ".\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSpecEstPropagateUp(KSP ksp,KSP subksp)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = KSPGetConvergedReason(subksp,&ksp->reason);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(subksp,&ksp->its);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
bool
PETScKrylovLinearSolver::solveSystem(SAMRAIVectorReal<NDIM, double>& x, SAMRAIVectorReal<NDIM, double>& b)
{
IBTK_TIMER_START(t_solve_system);
#if !defined(NDEBUG)
TBOX_ASSERT(d_A);
#endif
int ierr;
// Initialize the solver, when necessary.
const bool deallocate_after_solve = !d_is_initialized;
if (deallocate_after_solve) initializeSolverState(x, b);
#if !defined(NDEBUG)
TBOX_ASSERT(d_petsc_ksp);
#endif
resetKSPOptions();
// Allocate scratch data.
d_b->allocateVectorData();
// Solve the system using a PETSc KSP object.
d_b->copyVector(Pointer<SAMRAIVectorReal<NDIM, double> >(&b, false));
d_A->setHomogeneousBc(d_homogeneous_bc);
d_A->modifyRhsForBcs(*d_b);
d_A->setHomogeneousBc(true);
PETScSAMRAIVectorReal::replaceSAMRAIVector(d_petsc_x, Pointer<SAMRAIVectorReal<NDIM, double> >(&x, false));
PETScSAMRAIVectorReal::replaceSAMRAIVector(d_petsc_b, d_b);
ierr = KSPSolve(d_petsc_ksp, d_petsc_b, d_petsc_x);
IBTK_CHKERRQ(ierr);
d_A->setHomogeneousBc(d_homogeneous_bc);
d_A->imposeSolBcs(x);
// Get iterations count and residual norm.
ierr = KSPGetIterationNumber(d_petsc_ksp, &d_current_iterations);
IBTK_CHKERRQ(ierr);
ierr = KSPGetResidualNorm(d_petsc_ksp, &d_current_residual_norm);
IBTK_CHKERRQ(ierr);
d_A->setHomogeneousBc(d_homogeneous_bc);
// Determine the convergence reason.
KSPConvergedReason reason;
ierr = KSPGetConvergedReason(d_petsc_ksp, &reason);
IBTK_CHKERRQ(ierr);
const bool converged = (static_cast<int>(reason) > 0);
if (d_enable_logging) reportKSPConvergedReason(reason, plog);
// Dealocate scratch data.
d_b->deallocateVectorData();
// Deallocate the solver, when necessary.
if (deallocate_after_solve) deallocateSolverState();
IBTK_TIMER_STOP(t_solve_system);
return converged;
} // solveSystem
bool
IBImplicitModHelmholtzPETScLevelSolver::solveSystem(
SAMRAIVectorReal<NDIM,double>& x,
SAMRAIVectorReal<NDIM,double>& b)
{
IBAMR_TIMER_START(t_solve_system);
int ierr;
if (d_enable_logging) plog << d_object_name << "::solveSystem():" << std::endl;
// Initialize the solver, when necessary.
const bool deallocate_after_solve = !d_is_initialized;
if (deallocate_after_solve) initializeSolverState(x,b);
#if 0 // XXXX
// Configure solver.
ierr = KSPSetTolerances(d_petsc_ksp, d_rel_residual_tol, d_abs_residual_tol, PETSC_DEFAULT, d_max_iterations); IBTK_CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(d_petsc_ksp, d_initial_guess_nonzero ? PETSC_TRUE : PETSC_FALSE); IBTK_CHKERRQ(ierr);
#endif
// Solve the system.
Pointer<PatchLevel<NDIM> > patch_level = d_hierarchy->getPatchLevel(d_level_num);
const int x_idx = x.getComponentDescriptorIndex(0);
Pointer<SideVariable<NDIM,double> > x_var = x.getComponentVariable(0);
const int b_idx = b.getComponentDescriptorIndex(0);
Pointer<SideVariable<NDIM,double> > b_var = b.getComponentVariable(0);
if (d_initial_guess_nonzero) PETScVecUtilities::copyToPatchLevelVec(d_petsc_x, x_idx, x_var, patch_level);
PETScVecUtilities::copyToPatchLevelVec(d_petsc_b, b_idx, b_var, patch_level);
PETScVecUtilities::constrainPatchLevelVec(d_petsc_b, d_dof_index_idx, d_dof_index_var, patch_level, d_dof_index_fill);
ierr = KSPSolve(d_petsc_ksp, d_petsc_b, d_petsc_x); IBTK_CHKERRQ(ierr);
PETScVecUtilities::copyFromPatchLevelVec(d_petsc_x, x_idx, x_var, patch_level);
typedef SideDataSynchronization::SynchronizationTransactionComponent SynchronizationTransactionComponent; // XXXX
SynchronizationTransactionComponent x_synch_transaction = SynchronizationTransactionComponent(x_idx, "CONSERVATIVE_COARSEN");
Pointer<SideDataSynchronization> side_synch_op = new SideDataSynchronization();
side_synch_op->initializeOperatorState(x_synch_transaction, x.getPatchHierarchy());
side_synch_op->synchronizeData(0.0);
// Log solver info.
KSPConvergedReason reason;
ierr = KSPGetConvergedReason(d_petsc_ksp, &reason); IBTK_CHKERRQ(ierr);
const bool converged = reason > 0;
if (d_enable_logging)
{
plog << d_object_name << "::solveSystem(): solver " << (converged ? "converged" : "diverged") << "\n"
<< "iterations = " << d_current_its << "\n"
<< "residual norm = " << d_current_residual_norm << std::endl;
}
// Deallocate the solver, when necessary.
if (deallocate_after_solve) deallocateSolverState();
IBAMR_TIMER_STOP(t_solve_system);
return converged;
}// solveSystem
/*! Solve for x in Ax=b
*/
void HeatSolverBTCS::solve(std::vector<double>& x)
{
PetscInt i;
PetscScalar s;
KSPSolve(ksp, rhs, temp);
KSPGetConvergedReason(ksp, &reason);
for (i = 0; i < nx*ny; i++) {
VecGetValues(temp, 1, &i, &s);
x[i] = s;
}
}
PetscErrorCode BSSCR_PCBFBTSubKSPMonitor( KSP ksp, PetscInt index, PetscLogDouble time )
{
PetscInt max_it;
PetscReal rnorm;
KSPConvergedReason reason;
KSPGetIterationNumber( ksp, &max_it );
KSPGetResidualNorm( ksp, &rnorm );
KSPGetConvergedReason( ksp, &reason );
PetscPrintf(((PetscObject)ksp)->comm," PCBFBTSubKSP (%d): %D Residual norm; r0 %12.12e, r %12.12e: Reason %s: Time %5.5e \n",
index, max_it, ksp->rnorm0, rnorm, KSPConvergedReasons[reason], time );
PetscFunctionReturn(0);
}
PetscErrorCode BSSCR_Lp_monitor( KSP ksp, PetscInt index )
{
PetscInt max_it;
PetscReal rnorm;
KSPConvergedReason reason;
KSPGetIterationNumber( ksp, &max_it );
KSPGetResidualNorm( ksp, &rnorm );
KSPGetConvergedReason( ksp, &reason );
if (ksp->reason > 0) {
PetscPrintf(((PetscObject)ksp)->comm,"\t<Lp(%d)>: Linear solve converged. its.=%.4d ; |r|=%5.5e ; Reason=%s\n",
index, max_it, rnorm, KSPConvergedReasons[reason] );
} else {
PetscPrintf(((PetscObject)ksp)->comm,"\t<Lp(%d)>: Linear solve did not converge. its.=%.4d ; |r|=%5.5e ; Reason=%s\n",
index, max_it, rnorm, KSPConvergedReasons[reason]);
}
PetscFunctionReturn(0);
}
/* This function checks if the linear system did converge */
short int Solver_is_converged(KSP solver, char *lsys_name) {
KSPConvergedReason reason;
int ierr = KSPGetConvergedReason(solver, &reason); PETScErrAct(ierr);
if (reason < 0) {
PetscPrintf(PCW, "Solver.c/ Warning! %s-linear system did not converged! Reason:%d\n", lsys_name, reason);
return NO;
} /* if */
/* diverged */
/*
KSP_DIVERGED_NULL = -2,
KSP_DIVERGED_ITS = -3,
KSP_DIVERGED_DTOL = -4,
KSP_DIVERGED_BREAKDOWN = -5,
KSP_DIVERGED_BREAKDOWN_BICG = -6,
KSP_DIVERGED_NONSYMMETRIC = -7,
KSP_DIVERGED_INDEFINITE_PC = -8,
KSP_DIVERGED_NAN = -9,
KSP_DIVERGED_INDEFINITE_MAT = -10,
*/
return YES;
}
void solve_ASM(Mat & A_, const Vec & b_, Vec & x_)
{
PETSC_SAFE_CALL(KSPSetType(ksp,s_type));
// We set the size of x according to the Matrix A
PetscInt row;
PetscInt col;
PetscInt row_loc;
PetscInt col_loc;
PETSC_SAFE_CALL(MatGetSize(A_,&row,&col));
PETSC_SAFE_CALL(MatGetLocalSize(A_,&row_loc,&col_loc));
PC pc;
// We set the Matrix operators
PETSC_SAFE_CALL(KSPSetOperators(ksp,A_,A_));
// We set the pre-conditioner
PETSC_SAFE_CALL(KSPGetPC(ksp,&pc));
PETSC_SAFE_CALL(PCSetType(pc,PCASM));
////////////////
/////////////////////
// PCASMSetLocalSubdomains(pc);
PCASMSetOverlap(pc,5);
KSP *subksp; /* array of KSP contexts for local subblocks */
PetscInt nlocal,first; /* number of local subblocks, first local subblock */
PC subpc; /* PC context for subblock */
PetscBool isasm;
/*
Set runtime options
*/
// KSPSetFromOptions(ksp);
/*
Flag an error if PCTYPE is changed from the runtime options
*/
// PetscObjectTypeCompare((PetscObject)pc,PCASM,&isasm);
// if (!isasm) SETERRQ(PETSC_COMM_WORLD,1,"Cannot Change the PCTYPE when manually changing the subdomain solver settings");
/*
Call KSPSetUp() to set the block Jacobi data structures (including
creation of an internal KSP context for each block).
Note: KSPSetUp() MUST be called before PCASMGetSubKSP().
*/
KSPSetUp(ksp);
/*
Extract the array of KSP contexts for the local blocks
*/
PCASMGetSubKSP(pc,&nlocal,&first,&subksp);
/*
Loop over the local blocks, setting various KSP options
for each block.
*/
for (size_t i = 0 ; i < nlocal ; i++)
{
KSPGetPC(subksp[i],&subpc);
// PCFactorSetFill(subpc,30);
PCFactorSetLevels(subpc,5);
PCSetType(subpc,PCILU);
KSPSetType(subksp[i],KSPRICHARDSON);
KSPSetTolerances(subksp[i],1.e-3,0.1,PETSC_DEFAULT,PETSC_DEFAULT);
}
// if we are on on best solve set-up a monitor function
if (try_solve == true)
{
// for bench-mark we are interested in non-preconditioned norm
PETSC_SAFE_CALL(KSPMonitorSet(ksp,monitor,&vres,NULL));
// Disable convergence check
PETSC_SAFE_CALL(KSPSetConvergenceTest(ksp,KSPConvergedSkip,NULL,NULL));
}
// KSPGMRESSetRestart(ksp,100);
// Solve the system
PETSC_SAFE_CALL(KSPSolve(ksp,b_,x_));
KSPConvergedReason reason;
KSPGetConvergedReason(ksp,&reason);
std::cout << "Reason: " << reason << std::endl;
auto & v_cl = create_vcluster();
// if (try_solve == true)
// {
// calculate error statistic about the solution
solError err = statSolutionError(A_,b_,x_);
if (v_cl.getProcessUnitID() == 0)
{
std::cout << "Method: " << s_type << " " << " pre-conditoner: " << PCJACOBI << " iterations: " << err.its << std::endl;
std::cout << "Norm of error: " << err.err_norm << " Norm infinity: " << err.err_inf << std::endl;
}
// }
}
PetscErrorCode SNESSolve_NEWTONLS(SNES snes)
{
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscBool lssucceed;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscReal fnorm,gnorm,xnorm,ynorm;
Vec Y,X,F,G,W,FPC;
KSPConvergedReason kspreason;
PetscBool domainerror;
SNESLineSearch linesearch;
SNESConvergedReason reason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->vec_sol_update; /* newton step */
G = snes->work[0];
W = snes->work[1];
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
ierr = SNESGetSNESLineSearch(snes, &linesearch);CHKERRQ(ierr);
if (!snes->vec_func_init_set) {
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
} else {
snes->vec_func_init_set = PETSC_FALSE;
}
if (!snes->norm_init_set) {
ierr = VecNormBegin(F,NORM_2,&fnorm);CHKERRQ(ierr); /* fnorm <- ||F|| */
ierr = VecNormEnd(F,NORM_2,&fnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(fnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
} else {
fnorm = snes->norm_init;
snes->norm_init_set = PETSC_FALSE;
}
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,fnorm,0);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
/* apply the nonlinear preconditioner if it's right preconditioned */
if (snes->pc && snes->pcside == PC_RIGHT) {
ierr = SNESSetInitialFunction(snes->pc, F);CHKERRQ(ierr);
ierr = SNESSetInitialFunctionNorm(snes->pc, fnorm);CHKERRQ(ierr);
ierr = SNESSolve(snes->pc, snes->vec_rhs, X);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = SNESGetFunction(snes->pc, &FPC, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
ierr = VecCopy(FPC, F);CHKERRQ(ierr);
ierr = SNESGetFunctionNorm(snes->pc, &fnorm);CHKERRQ(ierr);
}
/* Solve J Y = F, where J is Jacobian matrix */
ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre,flg);CHKERRQ(ierr);
ierr = SNES_KSPSolve(snes,snes->ksp,F,Y);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
if (PetscLogPrintInfo){
ierr = SNESNEWTONLSCheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
/* Compute a (scaled) negative update in the line search routine:
X <- X - lambda*Y
and evaluate F = function(X) (depends on the line search).
*/
gnorm = fnorm;
ierr = SNESLineSearchApply(linesearch, X, F, &fnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetSuccess(linesearch, &lssucceed);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &fnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)gnorm,(double)fnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
if (!lssucceed) {
if (snes->stol*xnorm > ynorm) {
snes->reason = SNES_CONVERGED_SNORM_RELATIVE;
PetscFunctionReturn(0);
}
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESNEWTONLSCheckLocalMin_Private(snes,snes->jacobian,F,W,fnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Monitor convergence */
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,snes->norm,lits);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence */
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSolve_NTR(Tao tao)
{
TAO_NTR *tr = (TAO_NTR *)tao->data;
PC pc;
KSPConvergedReason ksp_reason;
TaoConvergedReason reason;
PetscReal fmin, ftrial, prered, actred, kappa, sigma, beta;
PetscReal tau, tau_1, tau_2, tau_max, tau_min, max_radius;
PetscReal f, gnorm;
PetscReal delta;
PetscReal norm_d;
PetscErrorCode ierr;
PetscInt iter = 0;
PetscInt bfgsUpdates = 0;
PetscInt needH;
PetscInt i_max = 5;
PetscInt j_max = 1;
PetscInt i, j, N, n, its;
PetscFunctionBegin;
if (tao->XL || tao->XU || tao->ops->computebounds) {
ierr = PetscPrintf(((PetscObject)tao)->comm,"WARNING: Variable bounds have been set but will be ignored by ntr algorithm\n");CHKERRQ(ierr);
}
tao->trust = tao->trust0;
/* Modify the radius if it is too large or small */
tao->trust = PetscMax(tao->trust, tr->min_radius);
tao->trust = PetscMin(tao->trust, tr->max_radius);
if (NTR_PC_BFGS == tr->pc_type && !tr->M) {
ierr = VecGetLocalSize(tao->solution,&n);CHKERRQ(ierr);
ierr = VecGetSize(tao->solution,&N);CHKERRQ(ierr);
ierr = MatCreateLMVM(((PetscObject)tao)->comm,n,N,&tr->M);CHKERRQ(ierr);
ierr = MatLMVMAllocateVectors(tr->M,tao->solution);CHKERRQ(ierr);
}
/* Check convergence criteria */
ierr = TaoComputeObjectiveAndGradient(tao, tao->solution, &f, tao->gradient);CHKERRQ(ierr);
ierr = VecNorm(tao->gradient,NORM_2,&gnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(f) || PetscIsInfOrNanReal(gnorm)) SETERRQ(PETSC_COMM_SELF,1, "User provided compute function generated Inf or NaN");
needH = 1;
ierr = TaoMonitor(tao, iter, f, gnorm, 0.0, 1.0, &reason);CHKERRQ(ierr);
if (reason != TAO_CONTINUE_ITERATING) PetscFunctionReturn(0);
/* Create vectors for the limited memory preconditioner */
if ((NTR_PC_BFGS == tr->pc_type) &&
(BFGS_SCALE_BFGS != tr->bfgs_scale_type)) {
if (!tr->Diag) {
ierr = VecDuplicate(tao->solution, &tr->Diag);CHKERRQ(ierr);
}
}
switch(tr->ksp_type) {
case NTR_KSP_NASH:
ierr = KSPSetType(tao->ksp, KSPNASH);CHKERRQ(ierr);
if (tao->ksp->ops->setfromoptions) {
(*tao->ksp->ops->setfromoptions)(tao->ksp);
}
break;
case NTR_KSP_STCG:
ierr = KSPSetType(tao->ksp, KSPSTCG);CHKERRQ(ierr);
if (tao->ksp->ops->setfromoptions) {
(*tao->ksp->ops->setfromoptions)(tao->ksp);
}
break;
default:
ierr = KSPSetType(tao->ksp, KSPGLTR);CHKERRQ(ierr);
if (tao->ksp->ops->setfromoptions) {
(*tao->ksp->ops->setfromoptions)(tao->ksp);
}
break;
}
/* Modify the preconditioner to use the bfgs approximation */
ierr = KSPGetPC(tao->ksp, &pc);CHKERRQ(ierr);
switch(tr->pc_type) {
case NTR_PC_NONE:
ierr = PCSetType(pc, PCNONE);CHKERRQ(ierr);
if (pc->ops->setfromoptions) {
(*pc->ops->setfromoptions)(pc);
}
break;
case NTR_PC_AHESS:
ierr = PCSetType(pc, PCJACOBI);CHKERRQ(ierr);
if (pc->ops->setfromoptions) {
(*pc->ops->setfromoptions)(pc);
}
ierr = PCJacobiSetUseAbs(pc);CHKERRQ(ierr);
break;
case NTR_PC_BFGS:
ierr = PCSetType(pc, PCSHELL);CHKERRQ(ierr);
if (pc->ops->setfromoptions) {
(*pc->ops->setfromoptions)(pc);
}
ierr = PCShellSetName(pc, "bfgs");CHKERRQ(ierr);
ierr = PCShellSetContext(pc, tr->M);CHKERRQ(ierr);
ierr = PCShellSetApply(pc, MatLMVMSolveShell);CHKERRQ(ierr);
break;
default:
/* Use the pc method set by pc_type */
break;
}
/* Initialize trust-region radius */
switch(tr->init_type) {
case NTR_INIT_CONSTANT:
/* Use the initial radius specified */
break;
case NTR_INIT_INTERPOLATION:
/* Use the initial radius specified */
max_radius = 0.0;
for (j = 0; j < j_max; ++j) {
fmin = f;
sigma = 0.0;
if (needH) {
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
needH = 0;
}
for (i = 0; i < i_max; ++i) {
ierr = VecCopy(tao->solution, tr->W);CHKERRQ(ierr);
ierr = VecAXPY(tr->W, -tao->trust/gnorm, tao->gradient);CHKERRQ(ierr);
ierr = TaoComputeObjective(tao, tr->W, &ftrial);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(ftrial)) {
tau = tr->gamma1_i;
}
else {
if (ftrial < fmin) {
fmin = ftrial;
sigma = -tao->trust / gnorm;
}
ierr = MatMult(tao->hessian, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = VecDot(tao->gradient, tao->stepdirection, &prered);CHKERRQ(ierr);
prered = tao->trust * (gnorm - 0.5 * tao->trust * prered / (gnorm * gnorm));
actred = f - ftrial;
if ((PetscAbsScalar(actred) <= tr->epsilon) &&
(PetscAbsScalar(prered) <= tr->epsilon)) {
kappa = 1.0;
}
else {
kappa = actred / prered;
}
tau_1 = tr->theta_i * gnorm * tao->trust / (tr->theta_i * gnorm * tao->trust + (1.0 - tr->theta_i) * prered - actred);
tau_2 = tr->theta_i * gnorm * tao->trust / (tr->theta_i * gnorm * tao->trust - (1.0 + tr->theta_i) * prered + actred);
tau_min = PetscMin(tau_1, tau_2);
tau_max = PetscMax(tau_1, tau_2);
if (PetscAbsScalar(kappa - 1.0) <= tr->mu1_i) {
/* Great agreement */
max_radius = PetscMax(max_radius, tao->trust);
if (tau_max < 1.0) {
tau = tr->gamma3_i;
}
else if (tau_max > tr->gamma4_i) {
tau = tr->gamma4_i;
}
else {
tau = tau_max;
}
}
else if (PetscAbsScalar(kappa - 1.0) <= tr->mu2_i) {
/* Good agreement */
max_radius = PetscMax(max_radius, tao->trust);
if (tau_max < tr->gamma2_i) {
tau = tr->gamma2_i;
}
else if (tau_max > tr->gamma3_i) {
tau = tr->gamma3_i;
}
else {
tau = tau_max;
}
}
else {
/* Not good agreement */
if (tau_min > 1.0) {
tau = tr->gamma2_i;
}
else if (tau_max < tr->gamma1_i) {
tau = tr->gamma1_i;
}
else if ((tau_min < tr->gamma1_i) && (tau_max >= 1.0)) {
tau = tr->gamma1_i;
}
else if ((tau_1 >= tr->gamma1_i) && (tau_1 < 1.0) &&
((tau_2 < tr->gamma1_i) || (tau_2 >= 1.0))) {
tau = tau_1;
}
else if ((tau_2 >= tr->gamma1_i) && (tau_2 < 1.0) &&
((tau_1 < tr->gamma1_i) || (tau_2 >= 1.0))) {
tau = tau_2;
}
else {
tau = tau_max;
}
}
}
tao->trust = tau * tao->trust;
}
if (fmin < f) {
f = fmin;
ierr = VecAXPY(tao->solution, sigma, tao->gradient);CHKERRQ(ierr);
ierr = TaoComputeGradient(tao,tao->solution, tao->gradient);CHKERRQ(ierr);
ierr = VecNorm(tao->gradient, NORM_2, &gnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(f) || PetscIsInfOrNanReal(gnorm)) SETERRQ(PETSC_COMM_SELF,1, "User provided compute function generated Inf or NaN");
needH = 1;
ierr = TaoMonitor(tao, iter, f, gnorm, 0.0, 1.0, &reason);CHKERRQ(ierr);
if (reason != TAO_CONTINUE_ITERATING) {
PetscFunctionReturn(0);
}
}
}
tao->trust = PetscMax(tao->trust, max_radius);
/* Modify the radius if it is too large or small */
tao->trust = PetscMax(tao->trust, tr->min_radius);
tao->trust = PetscMin(tao->trust, tr->max_radius);
break;
default:
/* Norm of the first direction will initialize radius */
tao->trust = 0.0;
break;
}
/* Set initial scaling for the BFGS preconditioner
This step is done after computing the initial trust-region radius
since the function value may have decreased */
if (NTR_PC_BFGS == tr->pc_type) {
if (f != 0.0) {
delta = 2.0 * PetscAbsScalar(f) / (gnorm*gnorm);
}
else {
delta = 2.0 / (gnorm*gnorm);
}
ierr = MatLMVMSetDelta(tr->M,delta);CHKERRQ(ierr);
}
/* Have not converged; continue with Newton method */
while (reason == TAO_CONTINUE_ITERATING) {
++iter;
tao->ksp_its=0;
/* Compute the Hessian */
if (needH) {
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
needH = 0;
}
if (NTR_PC_BFGS == tr->pc_type) {
if (BFGS_SCALE_AHESS == tr->bfgs_scale_type) {
/* Obtain diagonal for the bfgs preconditioner */
ierr = MatGetDiagonal(tao->hessian, tr->Diag);CHKERRQ(ierr);
ierr = VecAbs(tr->Diag);CHKERRQ(ierr);
ierr = VecReciprocal(tr->Diag);CHKERRQ(ierr);
ierr = MatLMVMSetScale(tr->M,tr->Diag);CHKERRQ(ierr);
}
/* Update the limited memory preconditioner */
ierr = MatLMVMUpdate(tr->M, tao->solution, tao->gradient);CHKERRQ(ierr);
++bfgsUpdates;
}
while (reason == TAO_CONTINUE_ITERATING) {
ierr = KSPSetOperators(tao->ksp, tao->hessian, tao->hessian_pre);CHKERRQ(ierr);
/* Solve the trust region subproblem */
if (NTR_KSP_NASH == tr->ksp_type) {
ierr = KSPNASHSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPNASHGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
} else if (NTR_KSP_STCG == tr->ksp_type) {
ierr = KSPSTCGSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPSTCGGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
} else { /* NTR_KSP_GLTR */
ierr = KSPGLTRSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPGLTRGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
}
if (0.0 == tao->trust) {
/* Radius was uninitialized; use the norm of the direction */
if (norm_d > 0.0) {
tao->trust = norm_d;
/* Modify the radius if it is too large or small */
tao->trust = PetscMax(tao->trust, tr->min_radius);
tao->trust = PetscMin(tao->trust, tr->max_radius);
}
else {
/* The direction was bad; set radius to default value and re-solve
the trust-region subproblem to get a direction */
tao->trust = tao->trust0;
/* Modify the radius if it is too large or small */
tao->trust = PetscMax(tao->trust, tr->min_radius);
tao->trust = PetscMin(tao->trust, tr->max_radius);
if (NTR_KSP_NASH == tr->ksp_type) {
ierr = KSPNASHSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPNASHGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
} else if (NTR_KSP_STCG == tr->ksp_type) {
ierr = KSPSTCGSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPSTCGGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
} else { /* NTR_KSP_GLTR */
ierr = KSPGLTRSetRadius(tao->ksp,tao->trust);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tao->gradient, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = KSPGLTRGetNormD(tao->ksp, &norm_d);CHKERRQ(ierr);
}
if (norm_d == 0.0) SETERRQ(PETSC_COMM_SELF,1, "Initial direction zero");
}
}
ierr = VecScale(tao->stepdirection, -1.0);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(tao->ksp, &ksp_reason);CHKERRQ(ierr);
if ((KSP_DIVERGED_INDEFINITE_PC == ksp_reason) &&
(NTR_PC_BFGS == tr->pc_type) && (bfgsUpdates > 1)) {
/* Preconditioner is numerically indefinite; reset the
approximate if using BFGS preconditioning. */
if (f != 0.0) {
delta = 2.0 * PetscAbsScalar(f) / (gnorm*gnorm);
}
else {
delta = 2.0 / (gnorm*gnorm);
}
ierr = MatLMVMSetDelta(tr->M, delta);CHKERRQ(ierr);
ierr = MatLMVMReset(tr->M);CHKERRQ(ierr);
ierr = MatLMVMUpdate(tr->M, tao->solution, tao->gradient);CHKERRQ(ierr);
bfgsUpdates = 1;
}
if (NTR_UPDATE_REDUCTION == tr->update_type) {
/* Get predicted reduction */
if (NTR_KSP_NASH == tr->ksp_type) {
ierr = KSPNASHGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
} else if (NTR_KSP_STCG == tr->ksp_type) {
ierr = KSPSTCGGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
} else { /* gltr */
ierr = KSPGLTRGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
}
if (prered >= 0.0) {
/* The predicted reduction has the wrong sign. This cannot
happen in infinite precision arithmetic. Step should
be rejected! */
tao->trust = tr->alpha1 * PetscMin(tao->trust, norm_d);
}
else {
/* Compute trial step and function value */
ierr = VecCopy(tao->solution,tr->W);CHKERRQ(ierr);
ierr = VecAXPY(tr->W, 1.0, tao->stepdirection);CHKERRQ(ierr);
ierr = TaoComputeObjective(tao, tr->W, &ftrial);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(ftrial)) {
tao->trust = tr->alpha1 * PetscMin(tao->trust, norm_d);
} else {
/* Compute and actual reduction */
actred = f - ftrial;
prered = -prered;
if ((PetscAbsScalar(actred) <= tr->epsilon) &&
(PetscAbsScalar(prered) <= tr->epsilon)) {
kappa = 1.0;
}
else {
kappa = actred / prered;
}
/* Accept or reject the step and update radius */
if (kappa < tr->eta1) {
/* Reject the step */
tao->trust = tr->alpha1 * PetscMin(tao->trust, norm_d);
}
else {
/* Accept the step */
if (kappa < tr->eta2) {
/* Marginal bad step */
tao->trust = tr->alpha2 * PetscMin(tao->trust, norm_d);
}
else if (kappa < tr->eta3) {
/* Reasonable step */
tao->trust = tr->alpha3 * tao->trust;
}
else if (kappa < tr->eta4) {
/* Good step */
tao->trust = PetscMax(tr->alpha4 * norm_d, tao->trust);
}
else {
/* Very good step */
tao->trust = PetscMax(tr->alpha5 * norm_d, tao->trust);
}
break;
}
}
}
}
else {
/* Get predicted reduction */
if (NTR_KSP_NASH == tr->ksp_type) {
ierr = KSPNASHGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
} else if (NTR_KSP_STCG == tr->ksp_type) {
ierr = KSPSTCGGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
} else { /* gltr */
ierr = KSPGLTRGetObjFcn(tao->ksp,&prered);CHKERRQ(ierr);
}
if (prered >= 0.0) {
/* The predicted reduction has the wrong sign. This cannot
happen in infinite precision arithmetic. Step should
be rejected! */
tao->trust = tr->gamma1 * PetscMin(tao->trust, norm_d);
}
else {
ierr = VecCopy(tao->solution, tr->W);CHKERRQ(ierr);
ierr = VecAXPY(tr->W, 1.0, tao->stepdirection);CHKERRQ(ierr);
ierr = TaoComputeObjective(tao, tr->W, &ftrial);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(ftrial)) {
tao->trust = tr->gamma1 * PetscMin(tao->trust, norm_d);
}
else {
ierr = VecDot(tao->gradient, tao->stepdirection, &beta);CHKERRQ(ierr);
actred = f - ftrial;
prered = -prered;
if ((PetscAbsScalar(actred) <= tr->epsilon) &&
(PetscAbsScalar(prered) <= tr->epsilon)) {
kappa = 1.0;
}
else {
kappa = actred / prered;
}
tau_1 = tr->theta * beta / (tr->theta * beta - (1.0 - tr->theta) * prered + actred);
tau_2 = tr->theta * beta / (tr->theta * beta + (1.0 + tr->theta) * prered - actred);
tau_min = PetscMin(tau_1, tau_2);
tau_max = PetscMax(tau_1, tau_2);
if (kappa >= 1.0 - tr->mu1) {
/* Great agreement; accept step and update radius */
if (tau_max < 1.0) {
tao->trust = PetscMax(tao->trust, tr->gamma3 * norm_d);
}
else if (tau_max > tr->gamma4) {
tao->trust = PetscMax(tao->trust, tr->gamma4 * norm_d);
}
else {
tao->trust = PetscMax(tao->trust, tau_max * norm_d);
}
break;
}
else if (kappa >= 1.0 - tr->mu2) {
/* Good agreement */
if (tau_max < tr->gamma2) {
tao->trust = tr->gamma2 * PetscMin(tao->trust, norm_d);
}
else if (tau_max > tr->gamma3) {
tao->trust = PetscMax(tao->trust, tr->gamma3 * norm_d);
}
else if (tau_max < 1.0) {
tao->trust = tau_max * PetscMin(tao->trust, norm_d);
}
else {
tao->trust = PetscMax(tao->trust, tau_max * norm_d);
}
break;
}
else {
/* Not good agreement */
if (tau_min > 1.0) {
tao->trust = tr->gamma2 * PetscMin(tao->trust, norm_d);
}
else if (tau_max < tr->gamma1) {
tao->trust = tr->gamma1 * PetscMin(tao->trust, norm_d);
}
else if ((tau_min < tr->gamma1) && (tau_max >= 1.0)) {
tao->trust = tr->gamma1 * PetscMin(tao->trust, norm_d);
}
else if ((tau_1 >= tr->gamma1) && (tau_1 < 1.0) &&
((tau_2 < tr->gamma1) || (tau_2 >= 1.0))) {
tao->trust = tau_1 * PetscMin(tao->trust, norm_d);
}
else if ((tau_2 >= tr->gamma1) && (tau_2 < 1.0) &&
((tau_1 < tr->gamma1) || (tau_2 >= 1.0))) {
tao->trust = tau_2 * PetscMin(tao->trust, norm_d);
}
else {
tao->trust = tau_max * PetscMin(tao->trust, norm_d);
}
}
}
}
}
/* The step computed was not good and the radius was decreased.
Monitor the radius to terminate. */
ierr = TaoMonitor(tao, iter, f, gnorm, 0.0, tao->trust, &reason);CHKERRQ(ierr);
}
/* The radius may have been increased; modify if it is too large */
tao->trust = PetscMin(tao->trust, tr->max_radius);
if (reason == TAO_CONTINUE_ITERATING) {
ierr = VecCopy(tr->W, tao->solution);CHKERRQ(ierr);
f = ftrial;
ierr = TaoComputeGradient(tao, tao->solution, tao->gradient);
ierr = VecNorm(tao->gradient, NORM_2, &gnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(f) || PetscIsInfOrNanReal(gnorm)) SETERRQ(PETSC_COMM_SELF,1, "User provided compute function generated Inf or NaN");
needH = 1;
ierr = TaoMonitor(tao, iter, f, gnorm, 0.0, tao->trust, &reason);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
int implicit_solver(HashTable* El_Table, HashTable* NodeTable, double delta_t, double LapCoef,
TimeProps* timeprops_ptr) {
Vec x, b, xlocal; /* approx solution, RHS */
Mat A; /* linear system matrix */
KSP ksp; /* KSP context */
PetscReal norm; //,val1,val2; /* norm of solution error */
PetscErrorCode ierr;
PetscInt xsize, *num_elem_proc, *to, *from, its;
PetscMPIInt rank, size;
KSPConvergedReason reason;
VecScatter vscat;
IS globalis, tois;
MPI_Comm_rank(PETSC_COMM_WORLD, &rank);
MPI_Comm_size(PETSC_COMM_WORLD, &size);
/* -------------------------------------------------------------------
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
------------------------------------------------------------------- */
ierr = PetscMalloc(size * sizeof(PetscInt), &num_elem_proc);
CHKERRQ(ierr);
num_elem_proc[rank] = num_nonzero_elem(El_Table);
if (rank > 0)
MPI_Send(&num_elem_proc[rank], 1, MPI_INT, 0, 22, PETSC_COMM_WORLD);
if (rank == 0)
for (int i = 1; i < size; i++)
MPI_Recv(&num_elem_proc[i], 1, MPI_INT, i, 22, PETSC_COMM_WORLD, MPI_STATUS_IGNORE);
MPI_Barrier(PETSC_COMM_WORLD);
MPI_Bcast(num_elem_proc, size, MPI_INT, 0, PETSC_COMM_WORLD);
//printf("Number of elements are (hi i am second)...........%d\n", num_nonzero_elem(Laplacian->El_Table));
int total_elem = 0, start_elem = 0;
//MPI_Allreduce(&num_elem, total_elem, 1, MPI_INT, MPI_SUM, PETSC_COMM_WORLD);
ierr = PetscMalloc(num_elem_proc[rank] * sizeof(PetscInt), &to);
CHKERRQ(ierr);
ierr = PetscMalloc(num_elem_proc[rank] * sizeof(PetscInt), &from);
CHKERRQ(ierr);
for (int i = 0; i < size; i++)
total_elem += num_elem_proc[i];
for (int i = 0; i < rank; i++)
start_elem += num_elem_proc[i];
for (int i = 0; i < num_elem_proc[rank]; i++) {
from[i] = i;
to[i] = i + start_elem;
}
ierr = ISCreateGeneral(PETSC_COMM_WORLD, num_elem_proc[rank], from, PETSC_COPY_VALUES, &tois);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_WORLD, num_elem_proc[rank], to, PETSC_COPY_VALUES, &globalis);
CHKERRQ(ierr);
/*
Create parallel vectors
*/
ierr = VecCreate(PETSC_COMM_WORLD, &b);
CHKERRQ(ierr);
ierr = VecSetType(b, VECSTANDARD);
CHKERRQ(ierr);
ierr = VecSetSizes(b, num_elem_proc[rank], total_elem);
CHKERRQ(ierr);
ierr = VecSetFromOptions(b);
CHKERRQ(ierr);
ierr = VecGetSize(b, &xsize);
//cout<<"size b is "<<xsize<<endl;
ierr = VecCreateSeq(PETSC_COMM_SELF, num_elem_proc[rank], &xlocal);
CHKERRQ(ierr);
ierr = VecScatterCreate(xlocal, tois, b, globalis, &vscat);
CHKERRQ(ierr);
// we have to create a map between local and global vector
myctx.El_Table = El_Table;
myctx.Node_Table = NodeTable;
myctx.Scatter = vscat;
myctx.Total_elem = total_elem;
myctx.Num_elem_proc = num_elem_proc;
myctx.rank = rank;
myctx.size = size;
myctx.Timeptr = timeprops_ptr;
myctx.LapCoef = LapCoef;
myctx.delta_t = delta_t;
/*
right-hand-side vector.
*/
ierr = MakeRHS(&myctx, b);
CHKERRQ(ierr);
//ierr = VecView(b,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = VecDuplicate(b, &x);
CHKERRQ(ierr);
ierr = VecCopy(b, x);
CHKERRQ(ierr);
//ierr = VecView(x,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = VecGetSize(x, &xsize);
//cout<<"size x is "<<xsize<<endl;
/*
Create and assemble parallel matrix
*/
ierr = MatCreateShell(PETSC_COMM_WORLD, num_elem_proc[rank], num_elem_proc[rank], total_elem,
total_elem, &myctx, &A);
CHKERRQ(ierr);
ierr = MatShellSetOperation(A, MATOP_MULT, (void (*)(void))MatLaplacian2D_Mult);CHKERRQ
(ierr);
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD, &ksp);
CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp, A, A/*,DIFFERENT_NONZERO_PATTERN*/);
CHKERRQ(ierr);
ierr = KSPSetType(ksp, KSPFGMRES);
CHKERRQ(ierr);
/*
Set default preconditioner for this program to be block Jacobi.
This choice can be overridden at runtime with the option
-pc_type <type>
*/
// ierr = KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,1.e9,3000);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, 50000);
CHKERRQ(ierr);
/* -------------------------------------------------------------------
Solve the linear system
------------------------------------------------------------------- */
ierr = KSPSetInitialGuessNonzero(ksp, PETSC_TRUE);
CHKERRQ(ierr);
/*
Solve the linear system
*/
ierr = KSPSolve(ksp, b, x);
CHKERRQ(ierr);
/* -------------------------------------------------------------------
Check solution and clean up
------------------------------------------------------------------- */
/*
Check the error
*/
//ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
if (rank == 0) {
ierr = KSPGetIterationNumber(ksp, &its);
CHKERRQ(ierr);
ierr = KSPGetResidualNorm(ksp, &norm);
CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf( MPI_COMM_SELF, "Norm of error %g iterations %D\n",
(double) norm, its);
CHKERRQ(ierr);
//PetscSynchronizedFlush(PETSC_COMM_WORLD);
ierr = KSPGetConvergedReason(ksp, &reason);
ierr = PetscSynchronizedPrintf( MPI_COMM_SELF, "kind of divergence is: ...........%D \n",
reason);
//PetscSynchronizedFlush(PETSC_COMM_WORLD);
}
/*
*/
//ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
update_phi(El_Table, x, &myctx);
//ierr = VecRestoreArray(x, &xx);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
MPI_Barrier(PETSC_COMM_WORLD);
ierr = KSPDestroy(&ksp);
CHKERRQ(ierr); //ierr = PetscFree(phin);CHKERRQ(ierr);
ierr = VecDestroy(&x);
CHKERRQ(ierr); //ierr = PCDestroy(&pc);CHKERRQ(ierr);
ierr = VecDestroy(&b);
CHKERRQ(ierr);
ierr = MatDestroy(&A);
CHKERRQ(ierr);
ierr = VecScatterDestroy(&vscat);
CHKERRQ(ierr);
ierr = ISDestroy(&globalis);
CHKERRQ(ierr);
ierr = ISDestroy(&tois);
CHKERRQ(ierr);
PetscFree(num_elem_proc);
CHKERRQ(ierr);
PetscFree(to);
CHKERRQ(ierr);
PetscFree(from);
CHKERRQ(ierr);
return 0;
}
void PETScLinearSolver::Solver()
{
//TEST
#ifdef TEST_MEM_PETSC
PetscLogDouble mem1, mem2;
PetscMemoryGetCurrentUsage(&mem1);
#endif
/*
//TEST
PetscViewer viewer;
PetscViewerASCIIOpen(PETSC_COMM_WORLD, "x.txt", &viewer);
PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);
PetscObjectSetName((PetscObject)x,"Solution");
VecView(x, viewer);
*/
int its;
PetscLogDouble v1,v2;
KSPConvergedReason reason;
// #define PETSC34
//kg44 quick fix to compile PETSC with version PETSCV3.4
#ifdef USEPETSC34
PetscTime(&v1);
#else
PetscGetTime(&v1);
#endif
#if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR > 4)
KSPSetOperators(lsolver, A, A);
#else
KSPSetOperators(lsolver, A, A, DIFFERENT_NONZERO_PATTERN);
#endif
KSPSolve(lsolver, b, x);
KSPGetConvergedReason(lsolver,&reason); //CHKERRQ(ierr);
if (reason==KSP_DIVERGED_INDEFINITE_PC)
{
PetscPrintf(PETSC_COMM_WORLD,"\nDivergence because of indefinite preconditioner;\n");
PetscPrintf(PETSC_COMM_WORLD,"Run the executable again but with -pc_factor_shift_positive_definite option.\n");
}
else if (reason<0)
{
PetscPrintf(PETSC_COMM_WORLD,"\nOther kind of divergence: this should not happen.\n");
}
else
{
const char *slv_type;
const char *prc_type;
KSPGetType(lsolver, &slv_type);
PCGetType(prec, &prc_type);
PetscPrintf(PETSC_COMM_WORLD,"\n================================================");
PetscPrintf(PETSC_COMM_WORLD, "\nLinear solver %s with %s preconditioner",
slv_type, prc_type);
KSPGetIterationNumber(lsolver,&its); //CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"\nConvergence in %d iterations.\n",(int)its);
PetscPrintf(PETSC_COMM_WORLD,"\n================================================");
}
PetscPrintf(PETSC_COMM_WORLD,"\n");
//VecAssemblyBegin(x);
//VecAssemblyEnd(x);
//kg44 quick fix to compile PETSC with version PETSCV3.4
#ifdef USEPETSC34
PetscTime(&v2);
#else
PetscGetTime(&v2);
#endif
time_elapsed += v2-v1;
#define aTEST_OUT
#ifdef TEST_OUT
//TEST
PetscViewer viewer;
PetscViewerASCIIOpen(PETSC_COMM_WORLD, "x2.txt", &viewer);
PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);
PetscObjectSetName((PetscObject)A,"Matrix");
MatView(A, viewer);
PetscObjectSetName((PetscObject)x,"Solution");
VecView(x, viewer);
PetscObjectSetName((PetscObject)b,"RHS");
VecView(b, viewer);
VecDestroy(&b);
VecDestroy(&x);
MatDestroy(&A);
if(lsolver) KSPDestroy(&lsolver);
// if(prec) PCDestroy(&prec);
if(global_x0)
delete [] global_x0;
if(global_x1)
delete [] global_x1;
PetscFinalize();
exit(0);
#endif
#ifdef TEST_MEM_PETSC
//TEST
PetscMemoryGetCurrentUsage(&mem2);
PetscPrintf(PETSC_COMM_WORLD, "###Memory usage by solver. Before :%f After:%f Increase:%d\n", mem1, mem2, (int)(mem2 - mem1));
#endif
}
PetscErrorCode SNESSolve_NEWTONLS(SNES snes)
{
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscBool lssucceed;
PetscReal fnorm,gnorm,xnorm,ynorm;
Vec Y,X,F;
KSPConvergedReason kspreason;
PetscBool domainerror;
SNESLineSearch linesearch;
SNESConvergedReason reason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->vec_sol_update; /* newton step */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESGetLineSearch(snes, &linesearch);CHKERRQ(ierr);
/* compute the preconditioned function first in the case of left preconditioning with preconditioned function */
if (snes->pc && snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_PRECONDITIONED) {
ierr = SNESApplyNPC(snes,X,NULL,F);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = VecNormBegin(F,NORM_2,&fnorm);CHKERRQ(ierr);
ierr = VecNormEnd(F,NORM_2,&fnorm);CHKERRQ(ierr);
} else {
if (!snes->vec_func_init_set) {
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
} else snes->vec_func_init_set = PETSC_FALSE;
}
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr); /* fnorm <- ||F|| */
if (PetscIsInfOrNanReal(fnorm)) {
snes->reason = SNES_DIVERGED_FNORM_NAN;
PetscFunctionReturn(0);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,fnorm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
/* apply the nonlinear preconditioner */
if (snes->pc) {
if (snes->pcside == PC_RIGHT) {
ierr = SNESSetInitialFunction(snes->pc, F);CHKERRQ(ierr);
ierr = PetscLogEventBegin(SNES_NPCSolve,snes->pc,X,snes->vec_rhs,0);CHKERRQ(ierr);
ierr = SNESSolve(snes->pc, snes->vec_rhs, X);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NPCSolve,snes->pc,X,snes->vec_rhs,0);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = SNESGetNPCFunction(snes,F,&fnorm);CHKERRQ(ierr);
} else if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_UNPRECONDITIONED) {
ierr = SNESApplyNPC(snes,X,F,F);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
}
}
/* Solve J Y = F, where J is Jacobian matrix */
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSolve(snes->ksp,F,Y);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
if (PetscLogPrintInfo) {
ierr = SNESNEWTONLSCheckResidual_Private(snes,snes->jacobian,F,Y);CHKERRQ(ierr);
}
/* Compute a (scaled) negative update in the line search routine:
X <- X - lambda*Y
and evaluate F = function(X) (depends on the line search).
*/
gnorm = fnorm;
ierr = SNESLineSearchApply(linesearch, X, F, &fnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetSuccess(linesearch, &lssucceed);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &fnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)gnorm,(double)fnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
if (!lssucceed) {
if (snes->stol*xnorm > ynorm) {
snes->reason = SNES_CONVERGED_SNORM_RELATIVE;
PetscFunctionReturn(0);
}
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESNEWTONLSCheckLocalMin_Private(snes,snes->jacobian,F,fnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Monitor convergence */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,snes->norm,lits);CHKERRQ(ierr);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence */
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
int
main(int argc, char** argv) {
int levels = 4;
int mg_levels = 3;
PetscInitialize(&argc, &argv, PETSC_NULL, PETSC_NULL);
construct_operator(&problem, levels);
KSP ksp;
PC pc;
KSPCreate(PETSC_COMM_WORLD, &ksp);
KSPSetOperators(ksp, problem.A, problem.A, SAME_PRECONDITIONER);
KSPSetType(ksp, KSPRICHARDSON);
if (1) {
KSPGetPC(ksp, &pc);
PCSetType(pc, PCMG);
PCMGSetLevels(pc, mg_levels, NULL);
PCMGSetGalerkin(pc);
PCMGSetType(pc, PC_MG_MULTIPLICATIVE);
PCMGSetCycleType(pc, PC_MG_CYCLE_V);
int ii;
for (ii=0; ii<mg_levels; ii++) {
if (ii == 0) {
KSP smooth_ksp;
PCMGGetSmoother(pc, ii, &smooth_ksp);
KSPSetType(smooth_ksp, KSPPREONLY);
PC smooth_pc;
KSPGetPC(smooth_ksp, &smooth_pc);
PCSetType(smooth_pc, PCLU);
} else {
// set up the smoother.
KSP smooth_ksp;
PC smooth_pc;
PCMGGetSmoother(pc, ii, &smooth_ksp);
KSPSetType(smooth_ksp, KSPRICHARDSON);
KSPRichardsonSetScale(smooth_ksp, 2./3.);
KSPGetPC(smooth_ksp, &smooth_pc);
PCSetType(smooth_pc, PCJACOBI);
KSPSetTolerances(smooth_ksp, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, 2);
//set up the interpolation operator
Mat prolongation;
construct_prolongation_operator(ii+1+levels-mg_levels, &prolongation);
PCMGSetInterpolation(pc, ii, prolongation);
MatScale(prolongation, 1./2.);
Mat restriction;
MatTranspose(prolongation, &restriction);
PCMGSetRestriction(pc, ii, prolongation);
MatDestroy(prolongation);
MatDestroy(restriction);
}
}
} else {
KSPGetPC(ksp, &pc);
PCSetType(pc, PCJACOBI);
}
//*/
/*
if (0) {
KSPSetType(ksp, KSPRICHARDSON);
KSPRichardsonSetScale(ksp, 2./3.);
KSPGetPC(ksp, &pc);
PCSetType(pc, PCJACOBI);
} else {
PetscOptionsInsertString("-ksp_type richardson");
PetscOptionsInsertString("-ksp_richardson_scale 0.666666666666666666");
PetscOptionsInsertString("-pc_type jacobi");
}
//*/
KSPSetInitialGuessNonzero(ksp, PETSC_TRUE);
KSPSetFromOptions(ksp);
KSPSetUp(ksp);
//VecView(problem.x, PETSC_VIEWER_STDOUT_WORLD);
{
//CHKERR(PCApply(pc, problem.b, problem.x));
CHKERR(KSPSolve(ksp, problem.b, problem.x));
KSPConvergedReason reason;
CHKERR(KSPGetConvergedReason(ksp, &reason));
printf("KSPConvergedReason: %d\n", reason);
PetscInt its;
CHKERR(KSPGetIterationNumber(ksp, &its));
printf("Num iterations: %d\n", its);
}
//compute_residual_norm(&problem);
VecView(problem.x, PETSC_VIEWER_STDOUT_WORLD);
PetscFinalize();
return 0;
}
PetscErrorCode SNESSolve_VINEWTONRSLS(SNES snes)
{
SNES_VINEWTONRSLS *vi = (SNES_VINEWTONRSLS*)snes->data;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscBool lssucceed;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscReal fnorm,gnorm,xnorm=0,ynorm;
Vec Y,X,F;
KSPConvergedReason kspreason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
ierr = SNESLineSearchSetVIFunctions(snes->linesearch, SNESVIProjectOntoBounds, SNESVIComputeInactiveSetFnorm);CHKERRQ(ierr);
ierr = SNESLineSearchSetVecs(snes->linesearch, X, PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
ierr = SNESLineSearchSetUp(snes->linesearch);CHKERRQ(ierr);
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
ierr = SNESVIComputeInactiveSetFnorm(snes,F,X,&fnorm);CHKERRQ(ierr);
ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr); /* xnorm <- ||x|| */
ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(fnorm)) SETERRQ(((PetscObject)X)->comm,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,fnorm,0);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
IS IS_act,IS_inact; /* _act -> active set _inact -> inactive set */
IS IS_redact; /* redundant active set */
VecScatter scat_act,scat_inact;
PetscInt nis_act,nis_inact;
Vec Y_act,Y_inact,F_inact;
Mat jac_inact_inact,prejac_inact_inact;
PetscBool isequal;
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
/* Create active and inactive index sets */
/*original
ierr = SNESVICreateIndexSets_RS(snes,X,F,&IS_act,&IS_inact);CHKERRQ(ierr);
*/
ierr = SNESVIGetActiveSetIS(snes,X,F,&IS_act);CHKERRQ(ierr);
if (vi->checkredundancy) {
(*vi->checkredundancy)(snes,IS_act,&IS_redact,vi->ctxP);CHKERRQ(ierr);
if (IS_redact){
ierr = ISSort(IS_redact);CHKERRQ(ierr);
ierr = ISComplement(IS_redact,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_redact);CHKERRQ(ierr);
}
else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
} else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
/* Create inactive set submatrix */
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
if (0) { /* Dead code (temporary developer hack) */
IS keptrows;
ierr = MatFindNonzeroRows(jac_inact_inact,&keptrows);CHKERRQ(ierr);
if (keptrows) {
PetscInt cnt,*nrows,k;
const PetscInt *krows,*inact;
PetscInt rstart=jac_inact_inact->rmap->rstart;
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(keptrows,&cnt);CHKERRQ(ierr);
ierr = ISGetIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = PetscMalloc(cnt*sizeof(PetscInt),&nrows);CHKERRQ(ierr);
for (k=0; k<cnt; k++) {
nrows[k] = inact[krows[k]-rstart];
}
ierr = ISRestoreIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISRestoreIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = ISDestroy(&keptrows);CHKERRQ(ierr);
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = ISCreateGeneral(((PetscObject)snes)->comm,cnt,nrows,PETSC_OWN_POINTER,&IS_inact);CHKERRQ(ierr);
ierr = ISComplement(IS_inact,F->map->rstart,F->map->rend,&IS_act);CHKERRQ(ierr);
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
}
}
ierr = DMSetVI(snes->dm,IS_inact);CHKERRQ(ierr);
/* remove later */
/*
ierr = VecView(vi->xu,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xu))->comm));CHKERRQ(ierr);
ierr = VecView(vi->xl,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xl))->comm));CHKERRQ(ierr);
ierr = VecView(X,PETSC_VIEWER_BINARY_(((PetscObject)X)->comm));CHKERRQ(ierr);
ierr = VecView(F,PETSC_VIEWER_BINARY_(((PetscObject)F)->comm));CHKERRQ(ierr);
ierr = ISView(IS_inact,PETSC_VIEWER_BINARY_(((PetscObject)IS_inact)->comm));CHKERRQ(ierr);
*/
/* Get sizes of active and inactive sets */
ierr = ISGetLocalSize(IS_act,&nis_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(IS_inact,&nis_inact);CHKERRQ(ierr);
/* Create active and inactive set vectors */
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&F_inact);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_act,&Y_act);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&Y_inact);CHKERRQ(ierr);
/* Create scatter contexts */
ierr = VecScatterCreate(Y,IS_act,Y_act,PETSC_NULL,&scat_act);CHKERRQ(ierr);
ierr = VecScatterCreate(Y,IS_inact,Y_inact,PETSC_NULL,&scat_inact);CHKERRQ(ierr);
/* Do a vec scatter to active and inactive set vectors */
ierr = VecScatterBegin(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Active set direction = 0 */
ierr = VecSet(Y_act,0);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatGetSubMatrix(snes->jacobian_pre,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&prejac_inact_inact);CHKERRQ(ierr);
} else prejac_inact_inact = jac_inact_inact;
ierr = ISEqual(vi->IS_inact_prev,IS_inact,&isequal);CHKERRQ(ierr);
if (!isequal) {
ierr = SNESVIResetPCandKSP(snes,jac_inact_inact,prejac_inact_inact);CHKERRQ(ierr);
flg = DIFFERENT_NONZERO_PATTERN;
}
/* ierr = ISView(IS_inact,0);CHKERRQ(ierr); */
/* ierr = ISView(IS_act,0);CHKERRQ(ierr);*/
/* ierr = MatView(snes->jacobian_pre,0); */
ierr = KSPSetOperators(snes->ksp,jac_inact_inact,prejac_inact_inact,flg);CHKERRQ(ierr);
ierr = KSPSetUp(snes->ksp);CHKERRQ(ierr);
{
PC pc;
PetscBool flg;
ierr = KSPGetPC(snes->ksp,&pc);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCFIELDSPLIT,&flg);CHKERRQ(ierr);
if (flg) {
KSP *subksps;
ierr = PCFieldSplitGetSubKSP(pc,PETSC_NULL,&subksps);CHKERRQ(ierr);
ierr = KSPGetPC(subksps[0],&pc);CHKERRQ(ierr);
ierr = PetscFree(subksps);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCBJACOBI,&flg);CHKERRQ(ierr);
if (flg) {
PetscInt n,N = 101*101,j,cnts[3] = {0,0,0};
const PetscInt *ii;
ierr = ISGetSize(IS_inact,&n);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&ii);CHKERRQ(ierr);
for (j=0; j<n; j++) {
if (ii[j] < N) cnts[0]++;
else if (ii[j] < 2*N) cnts[1]++;
else if (ii[j] < 3*N) cnts[2]++;
}
ierr = ISRestoreIndices(IS_inact,&ii);CHKERRQ(ierr);
ierr = PCBJacobiSetTotalBlocks(pc,3,cnts);CHKERRQ(ierr);
}
}
}
ierr = SNES_KSPSolve(snes,snes->ksp,F_inact,Y_inact);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = VecScatterBegin(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecDestroy(&F_inact);CHKERRQ(ierr);
ierr = VecDestroy(&Y_act);CHKERRQ(ierr);
ierr = VecDestroy(&Y_inact);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_act);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
if (!isequal) {
ierr = ISDestroy(&vi->IS_inact_prev);CHKERRQ(ierr);
ierr = ISDuplicate(IS_inact,&vi->IS_inact_prev);CHKERRQ(ierr);
}
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatDestroy(&prejac_inact_inact);CHKERRQ(ierr);
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
/*
if (snes->ops->precheck) {
PetscBool changed_y = PETSC_FALSE;
ierr = (*snes->ops->precheck)(snes,X,Y,snes->precheck,&changed_y);CHKERRQ(ierr);
}
if (PetscLogPrintInfo){
ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
*/
/* Compute a (scaled) negative update in the line search routine:
Y <- X - lambda*Y
and evaluate G = function(Y) (depends on the line search).
*/
ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
ynorm = 1; gnorm = fnorm;
ierr = SNESLineSearchApply(snes->linesearch, X, F, &gnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)fnorm,(double)gnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = SNESLineSearchGetSuccess(snes->linesearch, &lssucceed);CHKERRQ(ierr);
if (!lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,F,X,gnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Update function and solution vectors */
fnorm = gnorm;
/* Monitor convergence */
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,snes->norm,lits);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence, xnorm = || X || */
if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESQNApply_BadBroyden(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold,Vec D,Vec Dold)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *U = qn->U;
Vec *T = qn->V;
/* ksp thing for jacobian scaling */
KSPConvergedReason kspreason;
PetscInt h,k,j,i,lits;
PetscInt m = qn->m;
PetscScalar gdot,udot;
PetscInt l = m;
PetscFunctionBegin;
if (it < m) l = it;
ierr = VecCopy(D,Y);CHKERRQ(ierr);
if (l > 0) {
k = (it-1)%l;
ierr = SNESLineSearchGetLambda(snes->linesearch,&qn->lambda[k]);CHKERRQ(ierr);
ierr = VecCopy(Dold,U[k]);CHKERRQ(ierr);
ierr = VecAXPY(U[k],-1.0,D);CHKERRQ(ierr);
ierr = VecCopy(Xold,T[k]);CHKERRQ(ierr);
ierr = VecAXPY(T[k],-1.0,X);CHKERRQ(ierr);
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = KSPSolve(snes->ksp,Y,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W,Y);CHKERRQ(ierr);
} else {
ierr = VecScale(Y,qn->scaling);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
if (l > 0) {
for (i = 0; i < l-1; i++) {
j = (it+i-l)%l;
k = (it+i-l+1)%l;
h = (it-1)%l;
ierr = VecDotBegin(U[j],U[h],&gdot);CHKERRQ(ierr);
ierr = VecDotBegin(U[j],U[j],&udot);CHKERRQ(ierr);
ierr = VecDotEnd(U[j],U[h],&gdot);CHKERRQ(ierr);
ierr = VecDotEnd(U[j],U[j],&udot);CHKERRQ(ierr);
ierr = VecAXPY(Y,PetscRealPart(gdot)/PetscRealPart(udot),T[k]);CHKERRQ(ierr);
ierr = VecAXPY(Y,-(1.-qn->lambda[k])*PetscRealPart(gdot)/PetscRealPart(udot),T[j]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d gdot: %14.12e\n", it, k, PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
}
PetscFunctionReturn(0);
}
typename SolverLinearPetsc<T>::solve_return_type
SolverLinearPetsc<T>::solve ( MatrixSparse<T> const& matrix_in,
MatrixSparse<T> const& precond_in,
Vector<T> & solution_in,
Vector<T> const& rhs_in,
const double tol,
const unsigned int m_its,
bool transpose )
{
this->setWorldComm( matrix_in.comm() );
this->init ();
MatrixPetsc<T> * matrix = const_cast<MatrixPetsc<T> *>( dynamic_cast<MatrixPetsc<T> const*>( &matrix_in ) );
MatrixPetsc<T> * precond = const_cast<MatrixPetsc<T> *>( dynamic_cast<MatrixPetsc<T> const*>( &precond_in ) );
VectorPetsc<T> * solution = dynamic_cast<VectorPetsc<T>*>( &solution_in );
VectorPetsc<T> * rhs = const_cast<VectorPetsc<T> *>( dynamic_cast<VectorPetsc<T> const*>( &rhs_in ) );
// We cast to pointers so we can be sure that they succeeded
// by comparing the result against NULL.
FEELPP_ASSERT( matrix != NULL ).error( "non petsc matrix structure" );
FEELPP_ASSERT( precond != NULL ).error( "non petsc matrix structure" );
FEELPP_ASSERT( solution != NULL ).error( "non petsc vector structure" );
FEELPP_ASSERT( rhs != NULL ).error( "non petsc vector structure" );
int ierr=0;
int its=0;
PetscReal final_resid=0.;
// Close the matrices and vectors in case this wasn't already done.
matrix->close ();
precond->close ();
solution->close ();
rhs->close ();
if ( !this->M_preconditioner && this->preconditionerType() == FIELDSPLIT_PRECOND )
matrix->updatePCFieldSplit( M_pc );
// // If matrix != precond, then this means we have specified a
// // special preconditioner, so reset preconditioner type to PCMAT.
// if (matrix != precond)
// {
// this->_preconditioner_type = USER_PRECOND;
// this->set_petsc_preconditioner_type ();
// }
// 2.1.x & earlier style
#if (PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR <= 1)
// Set operators. The input matrix works as the preconditioning matrix
ierr = SLESSetOperators( M_sles, matrix->mat(), precond->mat(),
SAME_NONZERO_PATTERN );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Set the tolerances for the iterative solver. Use the user-supplied
// tolerance for the relative residual & leave the others at default values.
ierr = KSPSetTolerances ( M_ksp,
this->rTolerance(),
this->aTolerance(),
this->dTolerance(),
this->maxIterations() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// makes the default convergence test use || B*(b - A*(initial guess))||
// instead of || B*b ||. In the case of right preconditioner or if
// KSPSetNormType(ksp,KSP_NORM_UNPRECONDIITONED) is used there is no B in
// the above formula. UIRNorm is short for Use Initial Residual Norm.
#if PETSC_VERSION_GREATER_OR_EQUAL_THAN(3,4,4)
KSPConvergedDefaultSetUIRNorm( M_ksp );
#else
KSPDefaultConvergedSetUIRNorm( M_ksp );
#endif
// Solve the linear system
ierr = SLESSolve ( M_sles, rhs->vec(), solution->vec(), &its );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Get the norm of the final residual to return to the user.
ierr = KSPGetResidualNorm ( M_ksp, &final_resid );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// 2.2.0
#elif (PETSC_VERSION_MAJOR == 2) && (PETSC_VERSION_MINOR == 2) && (PETSC_VERSION_SUBMINOR == 0)
// Set operators. The input matrix works as the preconditioning matrix
ierr = KSPSetOperators( M_ksp, matrix->mat(), precond->mat(),
MatStructure::SAME_NONZERO_PATTERN );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Set the tolerances for the iterative solver. Use the user-supplied
// tolerance for the relative residual & leave the others at default values.
// Convergence is detected at iteration k if
// ||r_k||_2 < max(rtol*||b||_2 , abstol)
// where r_k is the residual vector and b is the right-hand side. Note that
// it is the *maximum* of the two values, the larger of which will almost
// always be rtol*||b||_2.
ierr = KSPSetTolerances ( M_ksp,
this->rTolerance(),
this->aTolerance(),
this->dTolerance(),
this->maxIterations() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Set the solution vector to use
ierr = KSPSetSolution ( M_ksp, solution->vec() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Set the RHS vector to use
ierr = KSPSetRhs ( M_ksp, rhs->vec() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// makes the default convergence test use || B*(b - A*(initial guess))||
// instead of || B*b ||. In the case of right preconditioner or if
// KSPSetNormType(ksp,KSP_NORM_UNPRECONDIITONED) is used there is no B in
// the above formula. UIRNorm is short for Use Initial Residual Norm.
#if PETSC_VERSION_GREATER_OR_EQUAL_THAN(3,4,4)
KSPConvergedDefaultSetUIRNorm( M_ksp );
#else
KSPDefaultConvergedSetUIRNorm( M_ksp );
#endif
// Solve the linear system
if ( transpose )
ierr = KSPSolveTranspose ( M_ksp );
else
ierr = KSPSolve ( M_ksp );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Get the number of iterations required for convergence
ierr = KSPGetIterationNumber ( M_ksp, &its );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Get the norm of the final residual to return to the user.
ierr = KSPGetResidualNorm ( M_ksp, &final_resid );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// 2.2.1 & newer style
#else
//std::cout << "sles: " << this->precMatrixStructure() << "\n";
// Set operators. The input matrix works as the preconditioning matrix
#if PETSC_VERSION_LESS_THAN(3,5,0)
ierr = KSPSetOperators( M_ksp, matrix->mat(), precond->mat(),
PetscGetMatStructureEnum(this->precMatrixStructure()) );
#else
ierr = KSPSetReusePreconditioner( M_ksp, (this->precMatrixStructure() == Feel::SAME_PRECONDITIONER)? PETSC_TRUE : PETSC_FALSE );
CHKERRABORT( this->worldComm().globalComm(),ierr );
ierr = KSPSetOperators( M_ksp, matrix->mat(), precond->mat() );
#endif
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Set the tolerances for the iterative solver. Use the user-supplied
// tolerance for the relative residual & leave the others at default values.
ierr = KSPSetTolerances ( M_ksp,
this->rTolerance(),
//1e-15,
this->aTolerance(),
this->dTolerance(),
this->maxIterations() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
//PreconditionerPetsc<T>::setPetscPreconditionerType( this->preconditionerType(),this->matSolverPackageType(),M_pc, this->worldComm() );
// makes the default convergence test use || B*(b - A*(initial guess))||
// instead of || B*b ||. In the case of right preconditioner or if
// KSPSetNormType(ksp,KSP_NORM_UNPRECONDIITONED) is used there is no B in
// the above formula. UIRNorm is short for Use Initial Residual Norm.
#if PETSC_VERSION_LESS_THAN(3,5,0)
KSPDefaultConvergedSetUIRNorm( M_ksp );
#else
KSPConvergedDefaultSetUIRNorm( M_ksp );
#endif
// Solve the linear system
if ( transpose )
ierr = KSPSolveTranspose ( M_ksp, rhs->vec(), solution->vec() );
else
ierr = KSPSolve ( M_ksp, rhs->vec(), solution->vec() );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Get the number of iterations required for convergence
ierr = KSPGetIterationNumber ( M_ksp, &its );
CHKERRABORT( this->worldComm().globalComm(),ierr );
// Get the norm of the final residual to return to the user.
ierr = KSPGetResidualNorm ( M_ksp, &final_resid );
//std::cout << "final residual = " << final_resid << "\n";
CHKERRABORT( this->worldComm().globalComm(),ierr );
KSPConvergedReason reason;
KSPGetConvergedReason( M_ksp,&reason );
if ( option( _prefix=this->prefix(), _name="ksp-view" ).template as<bool>() )
check( KSPView( M_ksp, PETSC_VIEWER_STDOUT_WORLD ) );
if ( reason==KSP_DIVERGED_INDEFINITE_PC )
{
LOG(INFO) << "[solverlinearpetsc] Divergence because of indefinite preconditioner;\n";
LOG(INFO) << "[solverlinearpetsc] Run the executable again but with '-pc_factor_shift_type POSITIVE_DEFINITE' option.\n";
}
else if ( reason<0 )
{
LOG(INFO) <<"[solverlinearpetsc] Other kind of divergence: this should not happen.\n";
}
bool hasConverged;
if ( reason> 0 )
{
hasConverged=true;
if (this->showKSPConvergedReason() && this->worldComm().globalRank() == this->worldComm().masterRank() )
std::cout<< "Linear solve converged due to " << PetscConvertKSPReasonToString(reason)
<< " iterations " << its << std::endl;
}
else
{
hasConverged=false;
if (this->showKSPConvergedReason() && this->worldComm().globalRank() == this->worldComm().masterRank() )
std::cout<< "Linear solve did not converge due to " << PetscConvertKSPReasonToString(reason)
<< " iterations " << its << std::endl;
}
#endif
// return the # of its. and the final residual norm.
//return std::make_pair(its, final_resid);
return solve_return_type( boost::make_tuple( hasConverged, its, final_resid ) );
}
/*
SNESSolve_VINEWTONSSLS - Solves the complementarity problem with a semismooth Newton
method using a line search.
Input Parameters:
. snes - the SNES context
Application Interface Routine: SNESSolve()
Notes:
This implements essentially a semismooth Newton method with a
line search. The default line search does not do any line search
but rather takes a full Newton step.
Developer Note: the code in this file should be slightly modified so that this routine need not exist and the SNESSolve_NEWTONLS() routine is called directly with the appropriate wrapped function and Jacobian evaluations
*/
PetscErrorCode SNESSolve_VINEWTONSSLS(SNES snes)
{
SNES_VINEWTONSSLS *vi = (SNES_VINEWTONSSLS*)snes->data;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
SNESLineSearchReason lssucceed;
PetscReal gnorm,xnorm=0,ynorm;
Vec Y,X,F;
KSPConvergedReason kspreason;
DM dm;
DMSNES sdm;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetDMSNES(dm,&sdm);CHKERRQ(ierr);
vi->computeuserfunction = sdm->ops->computefunction;
sdm->ops->computefunction = SNESVIComputeFunction;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,vi->phi);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
sdm->ops->computefunction = vi->computeuserfunction;
PetscFunctionReturn(0);
}
/* Compute Merit function */
ierr = SNESVIComputeMeritFunction(vi->phi,&vi->merit,&vi->phinorm);CHKERRQ(ierr);
ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr); /* xnorm <- ||x|| */
ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
SNESCheckFunctionNorm(snes,vi->merit);
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->norm = vi->phinorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,vi->phinorm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,vi->phinorm);CHKERRQ(ierr);
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,vi->phinorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) {
sdm->ops->computefunction = vi->computeuserfunction;
PetscFunctionReturn(0);
}
for (i=0; i<maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
/* Solve J Y = Phi, where J is the semismooth jacobian */
/* Get the jacobian -- note that the function must be the original function for snes_fd and snes_fd_color to work for this*/
sdm->ops->computefunction = vi->computeuserfunction;
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
SNESCheckJacobianDomainerror(snes);
sdm->ops->computefunction = SNESVIComputeFunction;
/* Get the diagonal shift and row scaling vectors */
ierr = SNESVIComputeBsubdifferentialVectors(snes,X,F,snes->jacobian,vi->Da,vi->Db);CHKERRQ(ierr);
/* Compute the semismooth jacobian */
ierr = SNESVIComputeJacobian(snes->jacobian,snes->jacobian_pre,vi->Da,vi->Db);CHKERRQ(ierr);
/* Compute the merit function gradient */
ierr = SNESVIComputeMeritFunctionGradient(snes->jacobian,vi->phi,vi->dpsi);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSolve(snes->ksp,vi->phi,Y);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
/*
if (snes->ops->precheck) {
PetscBool changed_y = PETSC_FALSE;
ierr = (*snes->ops->precheck)(snes,X,Y,snes->precheck,&changed_y);CHKERRQ(ierr);
}
if (PetscLogPrintInfo) {
ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
*/
/* Compute a (scaled) negative update in the line search routine:
Y <- X - lambda*Y
and evaluate G = function(Y) (depends on the line search).
*/
ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
ynorm = 1; gnorm = vi->phinorm;
ierr = SNESLineSearchApply(snes->linesearch, X, vi->phi, &gnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetReason(snes->linesearch, &lssucceed);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)vi->phinorm,(double)gnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
sdm->ops->computefunction = vi->computeuserfunction;
PetscFunctionReturn(0);
}
if (lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,vi->phi,X,gnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Update function and solution vectors */
vi->phinorm = gnorm;
vi->merit = 0.5*vi->phinorm*vi->phinorm;
/* Monitor convergence */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = vi->phinorm;
snes->xnorm = xnorm;
snes->ynorm = ynorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,snes->norm,lits);CHKERRQ(ierr);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence, xnorm = || X || */
if (snes->ops->converged != SNESConvergedSkip) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,vi->phinorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
sdm->ops->computefunction = vi->computeuserfunction;
PetscFunctionReturn(0);
}
NM_Status
PetscSolver :: petsc_solve(PetscSparseMtrx *Lhs, Vec b, Vec x)
{
int nite;
PetscErrorCode err;
KSPConvergedReason reason;
if ( Lhs->giveType() != SMT_PetscMtrx ) {
_error("petsc_solve: PetscSparseMtrx Expected");
}
#ifdef TIME_REPORT
oofem_timeval tstart;
getUtime(tstart);
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* Create the linear solver and set various options
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if ( !Lhs->kspInit ) {
MPI_Comm comm = engngModel->givePetscContext( Lhs->giveDomainIndex(), Lhs->giveEquationID() )->giveComm();
KSPCreate(comm, & Lhs->ksp);
Lhs->kspInit = true;
}
/*
* Set operators. Here the matrix that defines the linear system
* also serves as the preconditioning matrix.
*/
if ( Lhs->newValues ) { // Optimization for successive solves
///@todo I'm not 100% on the choice MatStructure. SAME_NONZERO_PATTERN should be safe.
if (this->engngModel->requiresUnknownsDictionaryUpdate()) {
KSPSetOperators(Lhs->ksp, * Lhs->giveMtrx(), * Lhs->giveMtrx(), DIFFERENT_NONZERO_PATTERN);
} else {
//KSPSetOperators(Lhs->ksp, * Lhs->giveMtrx(), * Lhs->giveMtrx(), SAME_PRECONDITIONER);
KSPSetOperators(Lhs->ksp, * Lhs->giveMtrx(), * Lhs->giveMtrx(), SAME_NONZERO_PATTERN);
}
Lhs->newValues = false;
/*
* Set linear solver defaults for this problem (optional).
* - The following two statements are optional; all of these
* parameters could alternatively be specified at runtime via
* KSPSetFromOptions(). All of these defaults can be
* overridden at runtime, as indicated below.
*/
KSPSetTolerances(Lhs->ksp, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT);
/*
* Set runtime options, e.g.,
* -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
* These options will override those specified above as long as
* KSPSetFromOptions() is called _after_ any other customization
* routines.
*/
KSPSetFromOptions(Lhs->ksp);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* Solve the linear system
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
//MatView(*Lhs->giveMtrx(),PETSC_VIEWER_STDOUT_SELF);
err = KSPSolve(Lhs->ksp, b, x);
if (err != 0) {
OOFEM_ERROR2("PetscSolver: Error when solving: %d\n", err);
}
KSPGetConvergedReason(Lhs->ksp, & reason);
KSPGetIterationNumber(Lhs->ksp, & nite);
if (reason >= 0) {
//OOFEM_LOG_INFO("PetscSolver: Converged. KSPConvergedReason: %d, number of iterations: %d\n", reason, nite);
} else {
OOFEM_WARNING3("PetscSolver: Diverged! KSPConvergedReason: %d, number of iterations: %d\n", reason, nite);
}
#ifdef TIME_REPORT
oofem_timeval ut;
getRelativeUtime(ut, tstart);
//OOFEM_LOG_INFO( "PetscSolver: User time consumed by solution: %.2fs\n", ( double ) ( ut.tv_sec + ut.tv_usec / ( double ) OOFEM_USEC_LIM ) );
#endif
if ( reason < 0 ) {
return NM_NoSuccess;
} else {
return NM_Success;
}
}
PetscErrorCode SNESQNApply_Broyden(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold,Vec D)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *U = qn->U;
KSPConvergedReason kspreason;
PetscInt m = qn->m;
PetscInt k,i,j,lits,l = m;
PetscReal unorm,a,b;
PetscReal *lambda=qn->lambda;
PetscScalar gdot;
PetscReal udot;
PetscFunctionBegin;
if (it < m) l = it;
if (it > 0) {
k = (it-1)%l;
ierr = SNESLineSearchGetLambda(snes->linesearch,&lambda[k]);CHKERRQ(ierr);
ierr = VecCopy(Xold,U[k]);CHKERRQ(ierr);
ierr = VecAXPY(U[k],-1.0,X);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "scaling vector %d of %d by lambda: %14.12e \n",k,l,lambda[k]);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = KSPSolve(snes->ksp,D,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W,Y);CHKERRQ(ierr);
} else {
ierr = VecCopy(D,Y);CHKERRQ(ierr);
ierr = VecScale(Y,qn->scaling);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
for (i = 0; i < l-1; i++) {
j = (it+i-l)%l;
k = (it+i-l+1)%l;
ierr = VecNorm(U[j],NORM_2,&unorm);CHKERRQ(ierr);
ierr = VecDot(U[j],Y,&gdot);CHKERRQ(ierr);
unorm *= unorm;
udot = PetscRealPart(gdot);
a = (lambda[j]/lambda[k]);
b = -(1.-lambda[j]);
a *= udot/unorm;
b *= udot/unorm;
ierr = VecAXPBYPCZ(Y,a,b,1.,U[k],U[j]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "using vector %d and %d, gdot: %14.12e\n",k,j,PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
if (l > 0) {
k = (it-1)%l;
ierr = VecDot(U[k],Y,&gdot);CHKERRQ(ierr);
ierr = VecNorm(U[k],NORM_2,&unorm);CHKERRQ(ierr);
unorm *= unorm;
udot = PetscRealPart(gdot);
a = unorm/(unorm-lambda[k]*udot);
b = -(1.-lambda[k])*udot/(unorm-lambda[k]*udot);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "using vector %d: a: %14.12e b: %14.12e \n",k,a,b);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
ierr = VecAXPBY(Y,b,a,U[k]);CHKERRQ(ierr);
}
l = m;
if (it+1<m)l=it+1;
k = it%l;
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "setting vector %d of %d\n",k,l);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESSolve_LS(SNES snes)
{
SNES_LS *neP = (SNES_LS*)snes->data;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscTruth lssucceed;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscReal fnorm,gnorm,xnorm=0,ynorm;
Vec Y,X,F,G,W;
KSPConvergedReason kspreason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
G = snes->work[1];
W = snes->work[2];
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
ierr = VecNormBegin(F,NORM_2,&fnorm);CHKERRQ(ierr); /* fnorm <- ||F|| */
ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr); /* xnorm <- ||x|| */
ierr = VecNormEnd(F,NORM_2,&fnorm);CHKERRQ(ierr);
ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
if PetscIsInfOrNanReal(fnorm) SETERRQ(PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,fnorm,0);
SNESMonitor(snes,0,fnorm);
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
/* Solve J Y = F, where J is Jacobian matrix */
ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre,flg);CHKERRQ(ierr);
ierr = SNES_KSPSolve(snes,snes->ksp,F,Y);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
if (neP->precheckstep) {
PetscTruth changed_y = PETSC_FALSE;
ierr = (*neP->precheckstep)(snes,X,Y,neP->precheck,&changed_y);CHKERRQ(ierr);
}
if (PetscLogPrintInfo){
ierr = SNESLSCheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
/* Compute a (scaled) negative update in the line search routine:
Y <- X - lambda*Y
and evaluate G = function(Y) (depends on the line search).
*/
ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
ynorm = 1; gnorm = fnorm;
ierr = (*neP->LineSearch)(snes,neP->lsP,X,F,G,Y,W,fnorm,xnorm,&ynorm,&gnorm,&lssucceed);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",fnorm,gnorm,ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
if (!lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
PetscTruth ismin;
snes->reason = SNES_DIVERGED_LS_FAILURE;
ierr = SNESLSCheckLocalMin_Private(snes,snes->jacobian,G,W,gnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Update function and solution vectors */
fnorm = gnorm;
ierr = VecCopy(G,F);CHKERRQ(ierr);
ierr = VecCopy(W,X);CHKERRQ(ierr);
/* Monitor convergence */
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,snes->norm,lits);
SNESMonitor(snes,snes->iter,snes->norm);
/* Test for convergence, xnorm = || X || */
if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if(!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
KSP ksp;
PC pc;
Mat A,M;
Vec X,B,D;
MPI_Comm comm;
PetscScalar v;
KSPConvergedReason reason;
PetscInt i,j,its;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscInitialize(&argc,&argv,0,help);CHKERRQ(ierr);
ierr = PetscOptionsSetValue("-options_left",PETSC_NULL);CHKERRQ(ierr);
comm = MPI_COMM_SELF;
/*
* Construct the Kershaw matrix
* and a suitable rhs / initial guess
*/
ierr = MatCreateSeqAIJ(comm,4,4,4,0,&A);CHKERRQ(ierr);
ierr = VecCreateSeq(comm,4,&B);CHKERRQ(ierr);
ierr = VecDuplicate(B,&X);CHKERRQ(ierr);
for (i=0; i<4; i++) {
v=3;
ierr = MatSetValues(A,1,&i,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
v=1;
ierr = VecSetValues(B,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
}
i=0; v=0;
ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
for (i=0; i<3; i++) {
v=-2; j=i+1;
ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
}
i=0; j=3; v=2;
ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecAssemblyBegin(B);CHKERRQ(ierr);
ierr = VecAssemblyEnd(B);CHKERRQ(ierr);
printf("\nThe Kershaw matrix:\n\n"); MatView(A,0);
/*
* A Conjugate Gradient method
* with ILU(0) preconditioning
*/
ierr = KSPCreate(comm,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPCG);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr);
/*
* ILU preconditioner;
* The iterative method will break down unless you comment in the SetShift
* line below, or use the -pc_factor_shift_positive_definite option.
* Run the code twice: once as given to see the negative pivot and the
* divergence behaviour, then comment in the Shift line, or add the
* command line option, and see that the pivots are all positive and
* the method converges.
*/
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCICC);CHKERRQ(ierr);
/* ierr = PCFactorSetShiftType(prec,MAT_SHIFT_POSITIVE_DEFINITE);CHKERRQ(ierr); */
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
/*
* Now that the factorisation is done, show the pivots;
* note that the last one is negative. This in itself is not an error,
* but it will make the iterative method diverge.
*/
ierr = PCFactorGetMatrix(pc,&M);CHKERRQ(ierr);
ierr = VecDuplicate(B,&D);CHKERRQ(ierr);
ierr = MatGetDiagonal(M,D);CHKERRQ(ierr);
printf("\nPivots:\n\n"); VecView(D,0);
/*
* Solve the system;
* without the shift this will diverge with
* an indefinite preconditioner
*/
ierr = KSPSolve(ksp,B,X);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(ksp,&reason);CHKERRQ(ierr);
if (reason==KSP_DIVERGED_INDEFINITE_PC) {
printf("\nDivergence because of indefinite preconditioner;\n");
printf("Run the executable again but with -pc_factor_shift_positive_definite option.\n");
} else if (reason<0) {
printf("\nOther kind of divergence: this should not happen.\n");
} else {
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
printf("\nConvergence in %d iterations.\n",(int)its);
}
printf("\n");
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&D);CHKERRQ(ierr);
PetscFinalize();
PetscFunctionReturn(0);
}
PetscErrorCode SNESQNApply_LBFGS(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold,Vec D,Vec Dold)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *dX = qn->U;
Vec *dF = qn->V;
PetscScalar *alpha = qn->alpha;
PetscScalar *beta = qn->beta;
PetscScalar *dXtdF = qn->dXtdF;
PetscScalar *dFtdX = qn->dFtdX;
PetscScalar *YtdX = qn->YtdX;
/* ksp thing for jacobian scaling */
KSPConvergedReason kspreason;
PetscInt k,i,j,g,lits;
PetscInt m = qn->m;
PetscScalar t;
PetscInt l = m;
PetscFunctionBegin;
if (it < m) l = it;
ierr = VecCopy(D,Y);CHKERRQ(ierr);
if (it > 0) {
k = (it - 1) % l;
ierr = VecCopy(D,dF[k]);CHKERRQ(ierr);
ierr = VecAXPY(dF[k], -1.0, Dold);CHKERRQ(ierr);
ierr = VecCopy(X, dX[k]);CHKERRQ(ierr);
ierr = VecAXPY(dX[k], -1.0, Xold);CHKERRQ(ierr);
if (qn->singlereduction) {
PetscScalar dFtdF;
ierr = VecMDotBegin(dF[k],l,dX,dXtdF);CHKERRQ(ierr);
ierr = VecMDotBegin(dX[k],l,dF,dFtdX);CHKERRQ(ierr);
ierr = VecMDotBegin(Y,l,dX,YtdX);CHKERRQ(ierr);
if (qn->scale_type == SNES_QN_SCALE_SHANNO) {ierr = VecDotBegin(dF[k],dF[k],&dFtdF);CHKERRQ(ierr);}
ierr = VecMDotEnd(dF[k],l,dX,dXtdF);CHKERRQ(ierr);
ierr = VecMDotEnd(dX[k],l,dF,dFtdX);CHKERRQ(ierr);
ierr = VecMDotEnd(Y,l,dX,YtdX);CHKERRQ(ierr);
if (qn->scale_type == SNES_QN_SCALE_SHANNO) {
ierr = VecDotEnd(dF[k],dF[k],&dFtdF);CHKERRQ(ierr);
qn->scaling = PetscRealPart(dXtdF[k]) / PetscRealPart(dFtdF);
}
for (j = 0; j < l; j++) {
H(k, j) = dFtdX[j];
H(j, k) = dXtdF[j];
}
/* copy back over to make the computation of alpha and beta easier */
for (j = 0; j < l; j++) dXtdF[j] = H(j, j);
} else {
ierr = VecDot(dX[k], dF[k], &dXtdF[k]);CHKERRQ(ierr);
if (qn->scale_type == SNES_QN_SCALE_SHANNO) {
PetscReal dFtdF;
ierr = VecDotRealPart(dF[k],dF[k],&dFtdF);CHKERRQ(ierr);
qn->scaling = PetscRealPart(dXtdF[k])/dFtdF;
}
}
if (qn->scale_type == SNES_QN_SCALE_LINESEARCH) {
ierr = SNESLineSearchGetLambda(snes->linesearch,&qn->scaling);CHKERRQ(ierr);
}
}
/* outward recursion starting at iteration k's update and working back */
for (i=0; i<l; i++) {
k = (it-i-1)%l;
if (qn->singlereduction) {
/* construct t = dX[k] dot Y as Y_0 dot dX[k] + sum(-alpha[j]dX[k]dF[j]) */
t = YtdX[k];
for (j=0; j<i; j++) {
g = (it-j-1)%l;
t -= alpha[g]*H(k, g);
}
alpha[k] = t/H(k,k);
} else {
ierr = VecDot(dX[k],Y,&t);CHKERRQ(ierr);
alpha[k] = t/dXtdF[k];
}
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d alpha: %14.12e\n", it, k, PetscRealPart(alpha[k]));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
ierr = VecAXPY(Y,-alpha[k],dF[k]);CHKERRQ(ierr);
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = KSPSolve(snes->ksp,Y,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W, Y);CHKERRQ(ierr);
} else {
ierr = VecScale(Y, qn->scaling);CHKERRQ(ierr);
}
if (qn->singlereduction) {
ierr = VecMDot(Y,l,dF,YtdX);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
for (i = 0; i < l; i++) {
k = (it + i - l) % l;
if (qn->singlereduction) {
t = YtdX[k];
for (j = 0; j < i; j++) {
g = (it + j - l) % l;
t += (alpha[g] - beta[g])*H(g, k);
}
beta[k] = t / H(k, k);
} else {
ierr = VecDot(dF[k], Y, &t);CHKERRQ(ierr);
beta[k] = t / dXtdF[k];
}
ierr = VecAXPY(Y, (alpha[k] - beta[k]), dX[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d alpha - beta: %14.12e\n", it, k, PetscRealPart(alpha[k] - beta[k]));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
long internal_solve()
{
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
PetscScalar* solution_vector;
VecGetArray(x,&solution_vector);
for (long i =0; i < n; ++i)
{
sol_vec.push_back(solution_vector[i]);
}
int reason=0;
KSPGetConvergedReason(ksp,(KSPConvergedReason*)&reason);
switch(reason)
{
case 2:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_RTOL .. " << std::endl;
break;
case 3:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_ATOL .. " << std::endl;
break;
case 4:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_ITS .. " << std::endl;
break;
case 5:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_QCG_NEG_CURVE .. " << std::endl;
break;
case 6:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_QCG_CONSTRAINED .. " << std::endl;
break;
case 7:
std::cout << "### CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_CONVERGED_STEP_LENGTH .. " << std::endl;
break;
case -3:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_ITS .. " << std::endl;
break;
case -4:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_DTOL .. " << std::endl;
break;
case -5:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_BREAKDOWN .. " << std::endl;
break;
case -6:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_BREAKDOWN_BICG .. " << std::endl;
break;
case -7:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_NONSYMMETRIC .. " << std::endl;
break;
case -8:
std::cout << "### !! N O T !! CONVERGED ### " << std::endl;
std::cout << "### KSP ..KSP_DIVERGED_INDEFINITE_PC .. " << std::endl;
break;
default:
std::cout << "### KSP .. no problem detected.. " << std::endl;
break;
}
/*
ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
Check the error
ierr = VecAXPY(x,neg_one,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A, Iterations %D\n",
norm,its);CHKERRQ(ierr);
*/
return 0;
}
PetscErrorCode SNESQNApply_Broyden(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold, Vec D, Vec Dold)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *U = qn->U;
Vec *V = qn->V;
KSPConvergedReason kspreason;
PetscInt k,i,lits;
PetscInt m = qn->m;
PetscScalar gdot;
PetscInt l = m;
PetscFunctionBegin;
if (it < m) l = it;
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = KSPSolve(snes->ksp,D,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W,Y);CHKERRQ(ierr);
} else {
ierr = VecCopy(D,Y);CHKERRQ(ierr);
ierr = VecScale(Y,qn->scaling);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
if (it > 1) {
for (i = 0; i < l-1; i++) {
k = (it+i-l)%l;
ierr = VecDot(U[k],Y,&gdot);CHKERRQ(ierr);
ierr = VecAXPY(Y,gdot,V[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d gdot: %14.12e\n", it, k, PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
}
if (it < m) l = it;
/* set W to be the last step, post-linesearch */
ierr = VecCopy(Xold,W);CHKERRQ(ierr);
ierr = VecAXPY(W,-1.0,X);CHKERRQ(ierr);
if (l > 0) {
k = (it-1)%l;
ierr = VecCopy(W,U[k]);CHKERRQ(ierr);
ierr = VecAXPY(W,-1.0,Y);CHKERRQ(ierr);
ierr = VecDot(U[k],W,&gdot);CHKERRQ(ierr);
ierr = VecCopy(Y,V[k]);CHKERRQ(ierr);
ierr = VecScale(V[k],1.0/gdot);CHKERRQ(ierr);
ierr = VecDot(U[k],Y,&gdot);CHKERRQ(ierr);
ierr = VecAXPY(Y,gdot,V[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "update: %d k: %d gdot: %14.12e\n", it, k, PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
