PETSC_EXTERN void PETSC_STDCALL pcapplyrichardson_(PC pc,Vec b,Vec y,Vec w,PetscReal *rtol,PetscReal *abstol,PetscReal *dtol,PetscInt *its,PetscBool *guesszero,PetscInt *outits,PCRichardsonConvergedReason *reason, int *__ierr ){
*__ierr = PCApplyRichardson(
(PC)PetscToPointer((pc) ),
(Vec)PetscToPointer((b) ),
(Vec)PetscToPointer((y) ),
(Vec)PetscToPointer((w) ),*rtol,*abstol,*dtol,*its,*guesszero,outits,
(PCRichardsonConvergedReason* )PetscToPointer((reason) ));
}
PetscErrorCode KSPSolve_Richardson(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,maxit;
PetscReal rnorm = 0.0,abr;
PetscScalar scale,rdot;
Vec x,b,r,z,w = NULL,y = NULL;
PetscInt xs, ws;
Mat Amat,Pmat;
KSP_Richardson *richardsonP = (KSP_Richardson*)ksp->data;
PetscBool exists,diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ksp->its = 0;
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
x = ksp->vec_sol;
b = ksp->vec_rhs;
ierr = VecGetSize(x,&xs);CHKERRQ(ierr);
ierr = VecGetSize(ksp->work[0],&ws);CHKERRQ(ierr);
if (xs != ws) {
if (richardsonP->selfscale) {
ierr = KSPSetWorkVecs(ksp,4);CHKERRQ(ierr);
} else {
ierr = KSPSetWorkVecs(ksp,2);CHKERRQ(ierr);
}
}
r = ksp->work[0];
z = ksp->work[1];
if (richardsonP->selfscale) {
w = ksp->work[2];
y = ksp->work[3];
}
maxit = ksp->max_it;
/* if user has provided fast Richardson code use that */
ierr = PCApplyRichardsonExists(ksp->pc,&exists);CHKERRQ(ierr);
if (exists && !ksp->numbermonitors && !ksp->transpose_solve & !ksp->nullsp) {
PCRichardsonConvergedReason reason;
ierr = PCApplyRichardson(ksp->pc,b,x,r,ksp->rtol,ksp->abstol,ksp->divtol,maxit,ksp->guess_zero,&ksp->its,&reason);CHKERRQ(ierr);
ksp->reason = (KSPConvergedReason)reason;
PetscFunctionReturn(0);
}
scale = richardsonP->scale;
if (!ksp->guess_zero) { /* r <- b - A x */
ierr = KSP_MatMult(ksp,Amat,x,r);CHKERRQ(ierr);
ierr = VecAYPX(r,-1.0,b);CHKERRQ(ierr);
} else {
ierr = VecCopy(b,r);CHKERRQ(ierr);
}
ksp->its = 0;
if (richardsonP->selfscale) {
ierr = KSP_PCApply(ksp,r,z);CHKERRQ(ierr); /* z <- B r */
for (i=0; i<maxit; i++) {
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(r,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- r'*r */
ierr = KSPMonitor(ksp,i,rnorm);CHKERRQ(ierr);
ksp->rnorm = rnorm;
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
} else if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNorm(z,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- z'*z */
ierr = KSPMonitor(ksp,i,rnorm);CHKERRQ(ierr);
ksp->rnorm = rnorm;
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
ierr = KSP_PCApplyBAorAB(ksp,z,y,w);CHKERRQ(ierr); /* y = BAz = BABr */
ierr = VecDotNorm2(z,y,&rdot,&abr);CHKERRQ(ierr); /* rdot = (Br)^T(BABR); abr = (BABr)^T (BABr) */
scale = rdot/abr;
ierr = PetscInfo1(ksp,"Self-scale factor %g\n",(double)PetscRealPart(scale));CHKERRQ(ierr);
ierr = VecAXPY(x,scale,z);CHKERRQ(ierr); /* x <- x + scale z */
ierr = VecAXPY(r,-scale,w);CHKERRQ(ierr); /* r <- r - scale*Az */
ierr = VecAXPY(z,-scale,y);CHKERRQ(ierr); /* z <- z - scale*y */
ksp->its++;
}
} else {
for (i=0; i<maxit; i++) {
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(r,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- r'*r */
ierr = KSPMonitor(ksp,i,rnorm);CHKERRQ(ierr);
ksp->rnorm = rnorm;
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
ierr = KSP_PCApply(ksp,r,z);CHKERRQ(ierr); /* z <- B r */
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNorm(z,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- z'*z */
ierr = KSPMonitor(ksp,i,rnorm);CHKERRQ(ierr);
ksp->rnorm = rnorm;
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
ierr = VecAXPY(x,scale,z);CHKERRQ(ierr); /* x <- x + scale z */
ksp->its++;
if (i+1 < maxit || ksp->normtype != KSP_NORM_NONE) {
ierr = KSP_MatMult(ksp,Amat,x,r);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(r,-1.0,b);CHKERRQ(ierr);
}
}
}
if (!ksp->reason) {
if (ksp->normtype != KSP_NORM_NONE) {
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(r,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- r'*r */
} else {
ierr = KSP_PCApply(ksp,r,z);CHKERRQ(ierr); /* z <- B r */
ierr = VecNorm(z,NORM_2,&rnorm);CHKERRQ(ierr); /* rnorm <- z'*z */
}
ksp->rnorm = rnorm;
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i,rnorm);CHKERRQ(ierr);
}
if (ksp->its >= ksp->max_it) {
if (ksp->normtype != KSP_NORM_NONE) {
ierr = (*ksp->converged)(ksp,i,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (!ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
} else {
ksp->reason = KSP_CONVERGED_ITS;
}
}
}
PetscFunctionReturn(0);
}
