PETSC_EXTERN void PETSC_STDCALL pcapplytransposeexists_(PC pc,PetscBool *flg, int *__ierr ){
*__ierr = PCApplyTransposeExists(
(PC)PetscToPointer((pc) ),flg);
}
PetscErrorCode KSPSolve_CGNE(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,T;
KSP_CG *cg;
Mat Amat,Pmat;
PetscBool diagonalscale,transpose_pc;
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);
ierr = PCApplyTransposeExists(ksp->pc,&transpose_pc);CHKERRQ(ierr);
cg = (KSP_CG*)ksp->data;
eigs = ksp->calc_sings;
stored_max_it = ksp->max_it;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
P = ksp->work[2];
T = ksp->work[3];
#define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
ierr = MatMultTranspose(Amat,B,T);CHKERRQ(ierr);
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,P);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,P,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,T);CHKERRQ(ierr);
} else {
ierr = VecCopy(T,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,R,T);CHKERRQ(ierr);
if (transpose_pc) {
ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr);
} else {
ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr);
}
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr);
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else dp = 0.0;
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
i = 0;
do {
ksp->its = i+1;
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'z */
if (beta == 0.0) {
ksp->reason = KSP_CONVERGED_ATOL;
ierr = PetscInfo(ksp,"converged due to beta = 0\n");CHKERRQ(ierr);
break;
#if !defined(PETSC_USE_COMPLEX)
} else if (beta < 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo(ksp,"diverging due to indefinite preconditioner\n");CHKERRQ(ierr);
break;
#endif
}
if (!i) {
ierr = VecCopy(Z,P);CHKERRQ(ierr); /* p <- z */
b = 0.0;
} else {
b = beta/betaold;
if (eigs) {
if (ksp->max_it != stored_max_it) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Can not change maxit AND calculate eigenvalues");
e[i] = PetscSqrtReal(PetscAbsScalar(b))/a;
}
ierr = VecAYPX(P,b,Z);CHKERRQ(ierr); /* p <- z + b* p */
}
betaold = beta;
ierr = MatMult(Amat,P,T);CHKERRQ(ierr);
ierr = MatMultTranspose(Amat,T,Z);CHKERRQ(ierr);
ierr = VecXDot(P,Z,&dpi);CHKERRQ(ierr); /* dpi <- z'p */
a = beta/dpi; /* a = beta/p'z */
if (eigs) d[i] = PetscSqrtReal(PetscAbsScalar(b))*e[i] + 1.0/a;
ierr = VecAXPY(X,a,P);CHKERRQ(ierr); /* x <- x + ap */
ierr = VecAXPY(R,-a,Z);CHKERRQ(ierr); /* r <- r - az */
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = KSP_PCApply(ksp,R,T);CHKERRQ(ierr);
if (transpose_pc) {
ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr);
} else {
ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr);
}
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr);
} else if (ksp->normtype == KSP_NORM_NATURAL) {
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else {
dp = 0.0;
}
ksp->rnorm = dp;
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
if (ksp->normtype != KSP_NORM_PRECONDITIONED) {
if (transpose_pc) {
ierr = KSP_PCApplyTranspose(ksp,T,Z);CHKERRQ(ierr);
} else {
ierr = KSP_PCApply(ksp,T,Z);CHKERRQ(ierr);
}
}
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
