static PetscErrorCode KSPSolve_PIPEFCG_cycle(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,j,k,idx,kdx,mi;
KSP_PIPEFCG *pipefcg;
PetscScalar alpha=0.0,gamma,*betas,*dots;
PetscReal dp=0.0, delta,*eta,*etas;
Vec B,R,Z,X,Qcurr,W,ZETAcurr,M,N,Pcurr,Scurr,*redux;
Mat Amat,Pmat;
PetscFunctionBegin;
/* We have not checked these routines for use with complex numbers. The inner products
are likely not defined correctly for that case */
#if (defined(PETSC_USE_COMPLEX) && !defined(PETSC_SKIP_COMPLEX))
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"PIPEFGMRES has not been implemented for use with complex scalars");
#endif
#define VecXDot(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDot (x,y,a) : VecTDot (x,y,a))
#define VecXDotBegin(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotBegin (x,y,a) : VecTDotBegin (x,y,a))
#define VecXDotEnd(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotEnd (x,y,a) : VecTDotEnd (x,y,a))
#define VecMXDot(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDot (x,n,y,a) : VecMTDot (x,n,y,a))
#define VecMXDotBegin(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotBegin (x,n,y,a) : VecMTDotBegin (x,n,y,a))
#define VecMXDotEnd(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotEnd (x,n,y,a) : VecMTDotEnd (x,n,y,a))
pipefcg = (KSP_PIPEFCG*)ksp->data;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
W = ksp->work[2];
M = ksp->work[3];
N = ksp->work[4];
redux = pipefcg->redux;
dots = pipefcg->dots;
etas = pipefcg->etas;
betas = dots; /* dots takes the result of all dot products of which the betas are a subset */
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
/* Compute cycle initial residual */
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* r <- b - Ax */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
Pcurr = pipefcg->Pvecs[0];
Scurr = pipefcg->Svecs[0];
Qcurr = pipefcg->Qvecs[0];
ZETAcurr = pipefcg->ZETAvecs[0];
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,Pcurr,Scurr);CHKERRQ(ierr); /* S = Ap */
ierr = VecCopy(Scurr,W);CHKERRQ(ierr); /* w = s = Az */
/* Initial state of pipelining intermediates */
redux[0] = R;
redux[1] = W;
ierr = VecMXDotBegin(Z,2,redux,dots);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = KSP_PCApply(ksp,W,M);CHKERRQ(ierr); /* m = B(w) */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr); /* q = m */
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr); /* zeta = n */
ierr = VecMXDotEnd(Z,2,redux,dots);CHKERRQ(ierr);
gamma = dots[0];
delta = PetscRealPart(dots[1]);
etas[0] = delta;
alpha = gamma/delta;
i = 0;
do {
ksp->its++;
/* Update X, R, Z, W */
ierr = VecAXPY(X,+alpha,Pcurr);CHKERRQ(ierr); /* x <- x + alpha * pi */
ierr = VecAXPY(R,-alpha,Scurr);CHKERRQ(ierr); /* r <- r - alpha * si */
ierr = VecAXPY(Z,-alpha,Qcurr);CHKERRQ(ierr); /* z <- z - alpha * qi */
ierr = VecAXPY(W,-alpha,ZETAcurr);CHKERRQ(ierr); /* w <- w - alpha * zetai */
/* Compute norm for convergence check */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Check for convergence */
ksp->rnorm = dp;
KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
/* Computations of current iteration done */
++i;
/* If needbe, allocate a new chunk of vectors in P and C */
ierr = KSPAllocateVectors_PIPEFCG(ksp,i+1,pipefcg->vecb);CHKERRQ(ierr);
/* Note that we wrap around and start clobbering old vectors */
idx = i % (pipefcg->mmax+1);
Pcurr = pipefcg->Pvecs[idx];
Scurr = pipefcg->Svecs[idx];
Qcurr = pipefcg->Qvecs[idx];
ZETAcurr = pipefcg->ZETAvecs[idx];
eta = pipefcg->etas+idx;
/* number of old directions to orthogonalize against */
switch(pipefcg->truncstrat){
case KSP_FCD_TRUNC_TYPE_STANDARD:
mi = pipefcg->mmax;
break;
case KSP_FCD_TRUNC_TYPE_NOTAY:
mi = ((i-1) % pipefcg->mmax)+1;
break;
default:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unrecognized Truncation Strategy");
}
/* Pick old p,s,q,zeta in a way suitable for VecMDot */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
pipefcg->Pold[j] = pipefcg->Pvecs[kdx];
pipefcg->Sold[j] = pipefcg->Svecs[kdx];
pipefcg->Qold[j] = pipefcg->Qvecs[kdx];
pipefcg->ZETAold[j] = pipefcg->ZETAvecs[kdx];
redux[j] = pipefcg->Svecs[kdx];
}
redux[j] = R; /* If the above loop is not executed redux contains only R => all beta_k = 0, only gamma, delta != 0 */
redux[j+1] = W;
ierr = VecMXDotBegin(Z,j+2,redux,betas);CHKERRQ(ierr); /* Start split reductions for beta_k = (z,s_k), gamma = (z,r), delta = (z,w) */
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = VecWAXPY(N,-1.0,R,W);CHKERRQ(ierr); /* m = u + B(w-r): (a) ntmp = w-r */
ierr = KSP_PCApply(ksp,N,M);CHKERRQ(ierr); /* m = u + B(w-r): (b) mtmp = B(ntmp) = B(w-r) */
ierr = VecAXPY(M,1.0,Z);CHKERRQ(ierr); /* m = u + B(w-r): (c) m = z + mtmp */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecMXDotEnd(Z,j+2,redux,betas);CHKERRQ(ierr); /* Finish split reductions */
gamma = betas[j];
delta = PetscRealPart(betas[j+1]);
*eta = 0.;
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
betas[j] /= -etas[kdx]; /* betak /= etak */
*eta -= ((PetscReal)(PetscAbsScalar(betas[j])*PetscAbsScalar(betas[j]))) * etas[kdx];
/* etaitmp = -betaik^2 * etak */
}
*eta += delta; /* etai = delta -betaik^2 * etak */
if(*eta < 0.) {
pipefcg->norm_breakdown = PETSC_TRUE;
ierr = PetscInfo1(ksp,"Restart due to square root breakdown at it = \n",ksp->its);CHKERRQ(ierr);
break;
} else {
alpha= gamma/(*eta); /* alpha = gamma/etai */
}
/* project out stored search directions using classical G-S */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = VecCopy(W,Scurr);CHKERRQ(ierr);
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr);
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr);
ierr = VecMAXPY(Pcurr ,j,betas,pipefcg->Pold);CHKERRQ(ierr); /* pi <- ui - sum_k beta_k p_k */
ierr = VecMAXPY(Scurr ,j,betas,pipefcg->Sold);CHKERRQ(ierr); /* si <- wi - sum_k beta_k s_k */
ierr = VecMAXPY(Qcurr ,j,betas,pipefcg->Qold);CHKERRQ(ierr); /* qi <- m - sum_k beta_k q_k */
ierr = VecMAXPY(ZETAcurr,j,betas,pipefcg->ZETAold);CHKERRQ(ierr); /* zetai <- n - sum_k beta_k zeta_k */
} while (ksp->its < ksp->max_it);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_SYMMLQ(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar alpha,beta,ibeta,betaold,beta1,ceta = 0,ceta_oold = 0.0, ceta_old = 0.0,ceta_bar;
PetscScalar c = 1.0,cold=1.0,s=0.0,sold=0.0,coold,soold,rho0,rho1,rho2,rho3;
PetscScalar dp = 0.0;
PetscReal np,s_prod;
Vec X,B,R,Z,U,V,W,UOLD,VOLD,Wbar;
Mat Amat,Pmat;
KSP_SYMMLQ *symmlq = (KSP_SYMMLQ*)ksp->data;
PetscBool 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);
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
U = ksp->work[2];
V = ksp->work[3];
W = ksp->work[4];
UOLD = ksp->work[5];
VOLD = ksp->work[6];
Wbar = ksp->work[7];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
ierr = VecSet(UOLD,0.0);CHKERRQ(ierr); /* u_old <- zeros; */
ierr = VecCopy(UOLD,VOLD);CHKERRQ(ierr); /* v_old <- u_old; */
ierr = VecCopy(UOLD,W);CHKERRQ(ierr); /* w <- u_old; */
ierr = VecCopy(UOLD,Wbar);CHKERRQ(ierr); /* w_bar <- u_old; */
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - A*x */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- B*r */
ierr = VecDot(R,Z,&dp);CHKERRQ(ierr); /* dp = r'*z; */
if (PetscAbsScalar(dp) < symmlq->haptol) {
ierr = PetscInfo2(ksp,"Detected happy breakdown %g tolerance %g\n",(double)PetscAbsScalar(dp),(double)symmlq->haptol);CHKERRQ(ierr);
ksp->rnorm = 0.0; /* what should we really put here? */
ksp->reason = KSP_CONVERGED_HAPPY_BREAKDOWN; /* bugfix proposed by Lourens ([email protected]) */
PetscFunctionReturn(0);
}
#if !defined(PETSC_USE_COMPLEX)
if (dp < 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
PetscFunctionReturn(0);
}
#endif
dp = PetscSqrtScalar(dp);
beta = dp; /* beta <- sqrt(r'*z) */
beta1 = beta;
s_prod = PetscAbsScalar(beta1);
ierr = VecCopy(R,V);CHKERRQ(ierr); /* v <- r; */
ierr = VecCopy(Z,U);CHKERRQ(ierr); /* u <- z; */
ibeta = 1.0 / beta;
ierr = VecScale(V,ibeta);CHKERRQ(ierr); /* v <- ibeta*v; */
ierr = VecScale(U,ibeta);CHKERRQ(ierr); /* u <- ibeta*u; */
ierr = VecCopy(U,Wbar);CHKERRQ(ierr); /* w_bar <- u; */
ierr = VecNorm(Z,NORM_2,&np);CHKERRQ(ierr); /* np <- ||z|| */
ierr = KSPLogResidualHistory(ksp,np);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,np);CHKERRQ(ierr);
ksp->rnorm = np;
ierr = (*ksp->converged)(ksp,0,np,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
i = 0; ceta = 0.;
do {
ksp->its = i+1;
/* Update */
if (ksp->its > 1) {
ierr = VecCopy(V,VOLD);CHKERRQ(ierr); /* v_old <- v; */
ierr = VecCopy(U,UOLD);CHKERRQ(ierr); /* u_old <- u; */
ierr = VecCopy(R,V);CHKERRQ(ierr);
ierr = VecScale(V,1.0/beta);CHKERRQ(ierr); /* v <- ibeta*r; */
ierr = VecCopy(Z,U);CHKERRQ(ierr);
ierr = VecScale(U,1.0/beta);CHKERRQ(ierr); /* u <- ibeta*z; */
ierr = VecCopy(Wbar,W);CHKERRQ(ierr);
ierr = VecScale(W,c);CHKERRQ(ierr);
ierr = VecAXPY(W,s,U);CHKERRQ(ierr); /* w <- c*w_bar + s*u; (w_k) */
ierr = VecScale(Wbar,-s);CHKERRQ(ierr);
ierr = VecAXPY(Wbar,c,U);CHKERRQ(ierr); /* w_bar <- -s*w_bar + c*u; (w_bar_(k+1)) */
ierr = VecAXPY(X,ceta,W);CHKERRQ(ierr); /* x <- x + ceta * w; (xL_k) */
ceta_oold = ceta_old;
ceta_old = ceta;
}
/* Lanczos */
ierr = KSP_MatMult(ksp,Amat,U,R);CHKERRQ(ierr); /* r <- Amat*u; */
ierr = VecDot(U,R,&alpha);CHKERRQ(ierr); /* alpha <- u'*r; */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- B*r; */
ierr = VecAXPY(R,-alpha,V);CHKERRQ(ierr); /* r <- r - alpha* v; */
ierr = VecAXPY(Z,-alpha,U);CHKERRQ(ierr); /* z <- z - alpha* u; */
ierr = VecAXPY(R,-beta,VOLD);CHKERRQ(ierr); /* r <- r - beta * v_old; */
ierr = VecAXPY(Z,-beta,UOLD);CHKERRQ(ierr); /* z <- z - beta * u_old; */
betaold = beta; /* beta_k */
ierr = VecDot(R,Z,&dp);CHKERRQ(ierr); /* dp <- r'*z; */
if (PetscAbsScalar(dp) < symmlq->haptol) {
ierr = PetscInfo2(ksp,"Detected happy breakdown %g tolerance %g\n",(double)PetscAbsScalar(dp),(double)symmlq->haptol);CHKERRQ(ierr);
dp = 0.0;
}
#if !defined(PETSC_USE_COMPLEX)
if (dp < 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
break;
}
#endif
beta = PetscSqrtScalar(dp); /* beta = sqrt(dp); */
/* QR factorization */
coold = cold; cold = c; soold = sold; sold = s;
rho0 = cold * alpha - coold * sold * betaold; /* gamma_bar */
rho1 = PetscSqrtScalar(rho0*rho0 + beta*beta); /* gamma */
rho2 = sold * alpha + coold * cold * betaold; /* delta */
rho3 = soold * betaold; /* epsilon */
/* Givens rotation: [c -s; s c] (different from the Reference!) */
c = rho0 / rho1; s = beta / rho1;
if (ksp->its==1) ceta = beta1/rho1;
else ceta = -(rho2*ceta_old + rho3*ceta_oold)/rho1;
s_prod = s_prod*PetscAbsScalar(s);
if (c == 0.0) np = s_prod*1.e16;
else np = s_prod/PetscAbsScalar(c); /* residual norm for xc_k (CGNORM) */
ksp->rnorm = np;
ierr = KSPLogResidualHistory(ksp,np);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,np);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,np,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) break;
i++;
} while (i<ksp->max_it);
/* move to the CG point: xc_(k+1) */
if (c == 0.0) ceta_bar = ceta*1.e15;
else ceta_bar = ceta/c;
ierr = VecAXPY(X,ceta_bar,Wbar);CHKERRQ(ierr); /* x <- x + ceta_bar*w_bar */
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
PetscErrorCode PCGAMGProlongator_Classical(PC pc, const Mat A, const Mat G, PetscCoarsenData *agg_lists,Mat *P)
{
PetscErrorCode ierr;
MPI_Comm comm;
Mat lG,gG,lA,gA; /* on and off diagonal matrices */
PetscInt fn; /* fine local blocked sizes */
PetscInt cn; /* coarse local blocked sizes */
PetscInt gn; /* size of the off-diagonal fine vector */
PetscInt fs,fe; /* fine (row) ownership range*/
PetscInt cs,ce; /* coarse (column) ownership range */
PetscInt i,j,k; /* indices! */
PetscBool iscoarse; /* flag for determining if a node is coarse */
PetscInt *lcid,*gcid; /* on and off-processor coarse unknown IDs */
PetscInt *lsparse,*gsparse; /* on and off-processor sparsity patterns for prolongator */
PetscScalar pij;
const PetscScalar *rval;
const PetscInt *rcol;
PetscScalar g_pos,g_neg,a_pos,a_neg,diag,invdiag,alpha,beta;
Vec F; /* vec of coarse size */
Vec C; /* vec of fine size */
Vec gF; /* vec of off-diagonal fine size */
MatType mtype;
PetscInt c_indx;
const PetscScalar *vcols;
const PetscInt *icols;
PetscScalar c_scalar;
PetscInt ncols,col;
PetscInt row_f,row_c;
PetscInt cmax=0,ncolstotal,idx;
PetscScalar *pvals;
PetscInt *pcols;
PetscFunctionBegin;
comm = ((PetscObject)pc)->comm;
ierr = MatGetOwnershipRange(A,&fs,&fe); CHKERRQ(ierr);
fn = (fe - fs);
ierr = MatGetVecs(A,&F,NULL);CHKERRQ(ierr);
/* get the number of local unknowns and the indices of the local unknowns */
ierr = PetscMalloc(sizeof(PetscInt)*fn,&lsparse);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*fn,&gsparse);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*fn,&lcid);CHKERRQ(ierr);
/* count the number of coarse unknowns */
cn = 0;
for (i=0;i<fn;i++) {
/* filter out singletons */
ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr);
lcid[i] = -1;
if (!iscoarse) {
cn++;
}
}
/* create the coarse vector */
ierr = VecCreateMPI(comm,cn,PETSC_DECIDE,&C);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(C,&cs,&ce);CHKERRQ(ierr);
/* construct a global vector indicating the global indices of the coarse unknowns */
cn = 0;
for (i=0;i<fn;i++) {
ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr);
if (!iscoarse) {
lcid[i] = cs+cn;
cn++;
} else {
lcid[i] = -1;
}
c_scalar = (PetscScalar)lcid[i];
c_indx = fs+i;
ierr = VecSetValues(F,1,&c_indx,&c_scalar,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(F);CHKERRQ(ierr);
ierr = VecAssemblyEnd(F);CHKERRQ(ierr);
/* split the graph into two */
ierr = PCGAMGClassicalGraphSplitting_Private(G,&lG,&gG);CHKERRQ(ierr);
ierr = PCGAMGClassicalGraphSplitting_Private(A,&lA,&gA);CHKERRQ(ierr);
/* scatter to the ghost vector */
ierr = PCGAMGClassicalCreateGhostVector_Private(G,&gF,NULL);CHKERRQ(ierr);
ierr = PCGAMGClassicalGhost_Private(G,F,gF);CHKERRQ(ierr);
if (gG) {
ierr = VecGetSize(gF,&gn);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*gn,&gcid);CHKERRQ(ierr);
for (i=0;i<gn;i++) {
ierr = VecGetValues(gF,1,&i,&c_scalar);CHKERRQ(ierr);
gcid[i] = (PetscInt)PetscRealPart(c_scalar);
}
}
ierr = VecDestroy(&F);CHKERRQ(ierr);
ierr = VecDestroy(&gF);CHKERRQ(ierr);
ierr = VecDestroy(&C);CHKERRQ(ierr);
/* count the on and off processor sparsity patterns for the prolongator */
for (i=0;i<fn;i++) {
/* on */
ierr = MatGetRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
ncolstotal = ncols;
lsparse[i] = 0;
gsparse[i] = 0;
if (lcid[i] >= 0) {
lsparse[i] = 1;
gsparse[i] = 0;
} else {
for (j = 0;j < ncols;j++) {
col = icols[j];
if (lcid[col] >= 0 && vcols[j] != 0.) {
lsparse[i] += 1;
}
}
ierr = MatRestoreRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
ncolstotal += ncols;
/* off */
if (gG) {
ierr = MatGetRow(gG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
for (j = 0; j < ncols; j++) {
col = icols[j];
if (gcid[col] >= 0 && vcols[j] != 0.) {
gsparse[i] += 1;
}
}
ierr = MatRestoreRow(gG,i,&ncols,NULL,NULL);CHKERRQ(ierr);
}
if (ncolstotal > cmax) cmax = ncolstotal;
}
}
ierr = PetscMalloc(sizeof(PetscInt)*cmax,&pcols);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&pvals);CHKERRQ(ierr);
/* preallocate and create the prolongator */
ierr = MatCreate(comm,P); CHKERRQ(ierr);
ierr = MatGetType(G,&mtype);CHKERRQ(ierr);
ierr = MatSetType(*P,mtype);CHKERRQ(ierr);
ierr = MatSetSizes(*P,fn,cn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(*P,0,lsparse,0,gsparse);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(*P,0,lsparse);CHKERRQ(ierr);
/* loop over local fine nodes -- get the diagonal, the sum of positive and negative strong and weak weights, and set up the row */
for (i = 0;i < fn;i++) {
/* determine on or off */
row_f = i + fs;
row_c = lcid[i];
if (row_c >= 0) {
pij = 1.;
ierr = MatSetValues(*P,1,&row_f,1,&row_c,&pij,INSERT_VALUES);CHKERRQ(ierr);
} else {
PetscInt nstrong=0,ntotal=0;
g_pos = 0.;
g_neg = 0.;
a_pos = 0.;
a_neg = 0.;
diag = 0.;
/* local strong connections */
ierr = MatGetRow(lG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
for (k = 0; k < ncols; k++) {
if (lcid[rcol[k]] >= 0) {
if (PetscRealPart(rval[k]) > 0) {
g_pos += rval[k];
} else {
g_neg += rval[k];
}
nstrong++;
}
}
ierr = MatRestoreRow(lG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
/* ghosted strong connections */
if (gG) {
ierr = MatGetRow(gG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
for (k = 0; k < ncols; k++) {
if (gcid[rcol[k]] >= 0) {
if (PetscRealPart(rval[k]) > 0.) {
g_pos += rval[k];
} else {
g_neg += rval[k];
}
nstrong++;
}
}
ierr = MatRestoreRow(gG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
}
/* local all connections */
ierr = MatGetRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
for (k = 0; k < ncols; k++) {
if (rcol[k] != i) {
if (PetscRealPart(rval[k]) > 0) {
a_pos += rval[k];
} else {
a_neg += rval[k];
}
ntotal++;
} else diag = rval[k];
}
ierr = MatRestoreRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
/* ghosted all connections */
if (gA) {
ierr = MatGetRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
for (k = 0; k < ncols; k++) {
if (PetscRealPart(rval[k]) > 0.) {
a_pos += PetscRealPart(rval[k]);
} else {
a_neg += PetscRealPart(rval[k]);
}
ntotal++;
}
ierr = MatRestoreRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
}
if (g_neg == 0.) {
alpha = 0.;
} else {
alpha = -a_neg/g_neg;
}
if (g_pos == 0.) {
diag += a_pos;
beta = 0.;
} else {
beta = -a_pos/g_pos;
}
if (diag == 0.) {
invdiag = 0.;
} else invdiag = 1. / diag;
/* on */
ierr = MatGetRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
idx = 0;
for (j = 0;j < ncols;j++) {
col = icols[j];
if (lcid[col] >= 0 && vcols[j] != 0.) {
row_f = i + fs;
row_c = lcid[col];
/* set the values for on-processor ones */
if (PetscRealPart(vcols[j]) < 0.) {
pij = vcols[j]*alpha*invdiag;
} else {
pij = vcols[j]*beta*invdiag;
}
if (PetscAbsScalar(pij) != 0.) {
pvals[idx] = pij;
pcols[idx] = row_c;
idx++;
}
}
}
ierr = MatRestoreRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
/* off */
if (gG) {
ierr = MatGetRow(gG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
for (j = 0; j < ncols; j++) {
col = icols[j];
if (gcid[col] >= 0 && vcols[j] != 0.) {
row_f = i + fs;
row_c = gcid[col];
/* set the values for on-processor ones */
if (PetscRealPart(vcols[j]) < 0.) {
pij = vcols[j]*alpha*invdiag;
} else {
pij = vcols[j]*beta*invdiag;
}
if (PetscAbsScalar(pij) != 0.) {
pvals[idx] = pij;
pcols[idx] = row_c;
idx++;
}
}
}
ierr = MatRestoreRow(gG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
}
ierr = MatSetValues(*P,1,&row_f,idx,pcols,pvals,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree(lsparse);CHKERRQ(ierr);
ierr = PetscFree(gsparse);CHKERRQ(ierr);
ierr = PetscFree(pcols);CHKERRQ(ierr);
ierr = PetscFree(pvals);CHKERRQ(ierr);
ierr = PetscFree(lcid);CHKERRQ(ierr);
if (gG) {ierr = PetscFree(gcid);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
/*@
MatNullSpaceCreate - Creates a data structure used to project vectors
out of null spaces.
Collective on MPI_Comm
Input Parameters:
+ comm - the MPI communicator associated with the object
. has_cnst - PETSC_TRUE if the null space contains the constant vector; otherwise PETSC_FALSE
. n - number of vectors (excluding constant vector) in null space
- vecs - the vectors that span the null space (excluding the constant vector);
these vectors must be orthonormal. These vectors are NOT copied, so do not change them
after this call. You should free the array that you pass in and destroy the vectors (this will reduce the reference count
for them by one).
Output Parameter:
. SP - the null space context
Level: advanced
Notes: See MatNullSpaceSetFunction() as an alternative way of providing the null space information instead of setting vecs.
If has_cnst is PETSC_TRUE you do not need to pass a constant vector in as a fourth argument to this routine, nor do you
need to pass in a function that eliminates the constant function into MatNullSpaceSetFunction().
Users manual sections:
. sec_singular
.keywords: PC, null space, create
.seealso: MatNullSpaceDestroy(), MatNullSpaceRemove(), MatSetNullSpace(), MatNullSpace, MatNullSpaceSetFunction()
@*/
PetscErrorCode MatNullSpaceCreate(MPI_Comm comm,PetscBool has_cnst,PetscInt n,const Vec vecs[],MatNullSpace *SP)
{
MatNullSpace sp;
PetscErrorCode ierr;
PetscInt i;
PetscFunctionBegin;
if (n < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Number of vectors (given %D) cannot be negative",n);
if (n) PetscValidPointer(vecs,4);
for (i=0; i<n; i++) PetscValidHeaderSpecific(vecs[i],VEC_CLASSID,4);
PetscValidPointer(SP,5);
if (n) {
for (i=0; i<n; i++) {
/* prevent the user from changes values in the vector */
ierr = VecLockPush(vecs[i]);CHKERRQ(ierr);
}
}
#if defined(PETSC_USE_DEBUG)
if (n) {
PetscScalar *dots;
for (i=0; i<n; i++) {
PetscReal norm;
ierr = VecNorm(vecs[i],NORM_2,&norm);CHKERRQ(ierr);
if (PetscAbsReal(norm - 1.0) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must have 2-norm of 1.0, it is %g",i,(double)norm);
}
if (has_cnst) {
for (i=0; i<n; i++) {
PetscScalar sum;
ierr = VecSum(vecs[i],&sum);CHKERRQ(ierr);
if (PetscAbsScalar(sum) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must be orthogonal to constant vector, inner product is %g",i,(double)PetscAbsScalar(sum));
}
}
ierr = PetscMalloc1(n-1,&dots);CHKERRQ(ierr);
for (i=0; i<n-1; i++) {
PetscInt j;
ierr = VecMDot(vecs[i],n-i-1,vecs+i+1,dots);CHKERRQ(ierr);
for (j=0;j<n-i-1;j++) {
if (PetscAbsScalar(dots[j]) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ3(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must be orthogonal to vector %D, inner product is %g",i,i+j+1,(double)PetscAbsScalar(dots[j]));
}
}
PetscFree(dots);CHKERRQ(ierr);
}
#endif
*SP = NULL;
ierr = MatInitializePackage();CHKERRQ(ierr);
ierr = PetscHeaderCreate(sp,MAT_NULLSPACE_CLASSID,"MatNullSpace","Null space","Mat",comm,MatNullSpaceDestroy,MatNullSpaceView);CHKERRQ(ierr);
sp->has_cnst = has_cnst;
sp->n = n;
sp->vecs = 0;
sp->alpha = 0;
sp->remove = 0;
sp->rmctx = 0;
if (n) {
ierr = PetscMalloc1(n,&sp->vecs);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&sp->alpha);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)sp,n*(sizeof(Vec)+sizeof(PetscScalar)));CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = PetscObjectReference((PetscObject)vecs[i]);CHKERRQ(ierr);
sp->vecs[i] = vecs[i];
}
}
*SP = sp;
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,delta,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,S,W;
KSP_CG *cg;
Mat Amat,Pmat;
MatStructure pflag;
PetscBool 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);
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];
if (cg->singlereduction) {
S = ksp->work[3];
W = ksp->work[4];
} else {
S = 0; /* unused */
W = Z;
}
#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,&pflag);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
dp = PetscSqrtReal(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
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);
if (ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
if (ksp->normtype != KSP_NORM_NATURAL) {
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
}
i = 0;
do {
ksp->its = i+1;
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 ((i > 0) && (beta*betaold < 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 */
}
dpiold = dpi;
if (!cg->singlereduction || !i) {
ierr = KSP_MatMult(ksp,Amat,P,W);CHKERRQ(ierr); /* w <- Ap */
ierr = VecXDot(P,W,&dpi);CHKERRQ(ierr); /* dpi <- p'w */
} else {
ierr = VecAYPX(W,beta/betaold,S);CHKERRQ(ierr); /* w <- Ap */
dpi = delta - beta*beta*dpiold/(betaold*betaold); /* dpi <- p'w */
}
betaold = beta;
if (PetscIsInfOrNanScalar(dpi)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
if ((dpi == 0.0) || ((i > 0) && (PetscRealPart(dpi*dpiold) <= 0.0))) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite matrix\n");CHKERRQ(ierr);
break;
}
a = beta/dpi; /* a = beta/p'w */
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,W);CHKERRQ(ierr); /* r <- r - aw */
if (ksp->normtype == KSP_NORM_PRECONDITIONED && ksp->chknorm < i+2) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
}
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED && ksp->chknorm < i+2) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'*z */
}
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else {
dp = 0.0;
}
ksp->rnorm = dp;
CHKERRQ(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 && (ksp->normtype != KSP_NORM_NATURAL)) || (ksp->chknorm >= i+2)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
}
}
if ((ksp->normtype != KSP_NORM_NATURAL) || (ksp->chknorm >= i+2)) {
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
}
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
}
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPLGMRESUpdateHessenberg(KSP ksp,PetscInt it,PetscBool hapend,PetscReal *res)
{
PetscScalar *hh,*cc,*ss,tt;
PetscInt j;
KSP_LGMRES *lgmres = (KSP_LGMRES *)(ksp->data);
PetscFunctionBegin;
hh = HH(0,it); /* pointer to beginning of column to update - so
incrementing hh "steps down" the (it+1)th col of HH*/
cc = CC(0); /* beginning of cosine rotations */
ss = SS(0); /* beginning of sine rotations */
/* Apply all the previously computed plane rotations to the new column
of the Hessenberg matrix */
/* Note: this uses the rotation [conj(c) s ; -s c], c= cos(theta), s= sin(theta) */
for (j=1; j<=it; j++) {
tt = *hh;
*hh = PetscConj(*cc) * tt + *ss * *(hh+1);
hh++;
*hh = *cc++ * *hh - (*ss++ * tt);
/* hh, cc, and ss have all been incremented one by end of loop */
}
/*
compute the new plane rotation, and apply it to:
1) the right-hand-side of the Hessenberg system (GRS)
note: it affects GRS(it) and GRS(it+1)
2) the new column of the Hessenberg matrix
note: it affects HH(it,it) which is currently pointed to
by hh and HH(it+1, it) (*(hh+1))
thus obtaining the updated value of the residual...
*/
/* compute new plane rotation */
if (!hapend) {
tt = PetscSqrtScalar(PetscConj(*hh) * *hh + PetscConj(*(hh+1)) * *(hh+1));
if (tt == 0.0) {
ksp->reason = KSP_DIVERGED_NULL;
PetscFunctionReturn(0);
}
*cc = *hh / tt; /* new cosine value */
*ss = *(hh+1) / tt; /* new sine value */
/* apply to 1) and 2) */
*GRS(it+1) = - (*ss * *GRS(it));
*GRS(it) = PetscConj(*cc) * *GRS(it);
*hh = PetscConj(*cc) * *hh + *ss * *(hh+1);
/* residual is the last element (it+1) of right-hand side! */
*res = PetscAbsScalar(*GRS(it+1));
} else {
/* happy breakdown: HH(it+1, it) = 0, therfore we don't need to apply
another rotation matrix (so RH doesn't change). The new residual is
always the new sine term times the residual from last time (GRS(it)),
but now the new sine rotation would be zero...so the residual should
be zero...so we will multiply "zero" by the last residual. This might
not be exactly what we want to do here -could just return "zero". */
*res = 0.0;
}
PetscFunctionReturn(0);
}
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,Field **x,Field **f,void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt xints,xinte,yints,yinte,i,j;
PetscReal hx,hy,dhx,dhy,hxdhy,hydhx;
PetscReal grashof,prandtl,lid;
PetscScalar u,uxx,uyy,vx,vy,avx,avy,vxp,vxm,vyp,vym;
PetscFunctionBeginUser;
grashof = user->grashof;
prandtl = user->prandtl;
lid = user->lidvelocity;
/*
Define mesh intervals ratios for uniform grid.
Note: FD formulae below are normalized by multiplying through by
local volume element (i.e. hx*hy) to obtain coefficients O(1) in two dimensions.
*/
dhx = (PetscReal)(info->mx-1); dhy = (PetscReal)(info->my-1);
hx = 1.0/dhx; hy = 1.0/dhy;
hxdhy = hx*dhy; hydhx = hy*dhx;
xints = info->xs; xinte = info->xs+info->xm; yints = info->ys; yinte = info->ys+info->ym;
/* Test whether we are on the bottom edge of the global array */
if (yints == 0) {
j = 0;
yints = yints + 1;
/* bottom edge */
for (i=info->xs; i<info->xs+info->xm; i++) {
f[j][i].u = x[j][i].u;
f[j][i].v = x[j][i].v;
f[j][i].omega = x[j][i].omega + (x[j+1][i].u - x[j][i].u)*dhy;
f[j][i].temp = x[j][i].temp-x[j+1][i].temp;
}
}
/* Test whether we are on the top edge of the global array */
if (yinte == info->my) {
j = info->my - 1;
yinte = yinte - 1;
/* top edge */
for (i=info->xs; i<info->xs+info->xm; i++) {
f[j][i].u = x[j][i].u - lid;
f[j][i].v = x[j][i].v;
f[j][i].omega = x[j][i].omega + (x[j][i].u - x[j-1][i].u)*dhy;
f[j][i].temp = x[j][i].temp-x[j-1][i].temp;
}
}
/* Test whether we are on the left edge of the global array */
if (xints == 0) {
i = 0;
xints = xints + 1;
/* left edge */
for (j=info->ys; j<info->ys+info->ym; j++) {
f[j][i].u = x[j][i].u;
f[j][i].v = x[j][i].v;
f[j][i].omega = x[j][i].omega - (x[j][i+1].v - x[j][i].v)*dhx;
f[j][i].temp = x[j][i].temp;
}
}
/* Test whether we are on the right edge of the global array */
if (xinte == info->mx) {
i = info->mx - 1;
xinte = xinte - 1;
/* right edge */
for (j=info->ys; j<info->ys+info->ym; j++) {
f[j][i].u = x[j][i].u;
f[j][i].v = x[j][i].v;
f[j][i].omega = x[j][i].omega - (x[j][i].v - x[j][i-1].v)*dhx;
f[j][i].temp = x[j][i].temp - (PetscReal)(grashof>0);
}
}
/* Compute over the interior points */
for (j=yints; j<yinte; j++) {
for (i=xints; i<xinte; i++) {
/*
convective coefficients for upwinding
*/
vx = x[j][i].u; avx = PetscAbsScalar(vx);
vxp = .5*(vx+avx); vxm = .5*(vx-avx);
vy = x[j][i].v; avy = PetscAbsScalar(vy);
vyp = .5*(vy+avy); vym = .5*(vy-avy);
/* U velocity */
u = x[j][i].u;
uxx = (2.0*u - x[j][i-1].u - x[j][i+1].u)*hydhx;
uyy = (2.0*u - x[j-1][i].u - x[j+1][i].u)*hxdhy;
f[j][i].u = uxx + uyy - .5*(x[j+1][i].omega-x[j-1][i].omega)*hx;
/* V velocity */
u = x[j][i].v;
uxx = (2.0*u - x[j][i-1].v - x[j][i+1].v)*hydhx;
uyy = (2.0*u - x[j-1][i].v - x[j+1][i].v)*hxdhy;
f[j][i].v = uxx + uyy + .5*(x[j][i+1].omega-x[j][i-1].omega)*hy;
/* Omega */
u = x[j][i].omega;
uxx = (2.0*u - x[j][i-1].omega - x[j][i+1].omega)*hydhx;
uyy = (2.0*u - x[j-1][i].omega - x[j+1][i].omega)*hxdhy;
f[j][i].omega = uxx + uyy + (vxp*(u - x[j][i-1].omega) + vxm*(x[j][i+1].omega - u))*hy +
(vyp*(u - x[j-1][i].omega) + vym*(x[j+1][i].omega - u))*hx -
.5*grashof*(x[j][i+1].temp - x[j][i-1].temp)*hy;
/* Temperature */
u = x[j][i].temp;
uxx = (2.0*u - x[j][i-1].temp - x[j][i+1].temp)*hydhx;
uyy = (2.0*u - x[j-1][i].temp - x[j+1][i].temp)*hxdhy;
f[j][i].temp = uxx + uyy + prandtl*((vxp*(u - x[j][i-1].temp) + vxm*(x[j][i+1].temp - u))*hy +
(vyp*(u - x[j-1][i].temp) + vym*(x[j+1][i].temp - u))*hx);
}
}
/*
Flop count (multiply-adds are counted as 2 operations)
*/
ierr = PetscLogFlops(84.0*info->ym*info->xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,wscale;
const PetscScalar *xx;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscErrorCode (*eval_fct)(SNES,Vec,Vec)=0;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
eval_fct = SNESComputeFunction;
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
}
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)snes),((PetscObject)snes)->prefix,"Differencing options","SNES");CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArrayRead(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = PetscSqrtReal(1.0 + unorm);
else dx = xx[i-start];
ierr = VecRestoreArrayRead(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode CkEigenSolutions(PetscInt cklvl,Mat A,PetscInt il,PetscInt iu,PetscScalar *eval,Vec *evec,PetscReal *tols)
{
PetscInt ierr,i,j,nev;
Vec vt1,vt2; /* tmp vectors */
PetscReal norm,norm_max;
PetscScalar dot,tmp;
PetscReal dot_max;
PetscFunctionBegin;
nev = iu - il;
if (nev <= 0) PetscFunctionReturn(0);
ierr = VecDuplicate(evec[0],&vt1);CHKERRQ(ierr);
ierr = VecDuplicate(evec[0],&vt2);CHKERRQ(ierr);
switch (cklvl) {
case 2:
dot_max = 0.0;
for (i = il; i<iu; i++) {
ierr = VecCopy(evec[i], vt1);CHKERRQ(ierr);
for (j=il; j<iu; j++) {
ierr = VecDot(evec[j],vt1,&dot);CHKERRQ(ierr);
if (j == i) {
dot = PetscAbsScalar(dot - 1.0);
} else {
dot = PetscAbsScalar(dot);
}
if (PetscAbsScalar(dot) > dot_max) dot_max = PetscAbsScalar(dot);
#if defined(DEBUG_CkEigenSolutions)
if (dot > tols[1]) {
ierr = VecNorm(evec[i],NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"|delta(%d,%d)|: %g, norm: %d\n",i,j,(double)dot,(double)norm);CHKERRQ(ierr);
}
#endif
}
}
ierr = PetscPrintf(PETSC_COMM_SELF," max|(x_j^T*x_i) - delta_ji|: %g\n",(double)dot_max);CHKERRQ(ierr);
case 1:
norm_max = 0.0;
for (i = il; i< iu; i++) {
ierr = MatMult(A, evec[i], vt1);CHKERRQ(ierr);
ierr = VecCopy(evec[i], vt2);CHKERRQ(ierr);
tmp = -eval[i];
ierr = VecAXPY(vt1,tmp,vt2);CHKERRQ(ierr);
ierr = VecNorm(vt1, NORM_INFINITY, &norm);CHKERRQ(ierr);
norm = PetscAbsReal(norm);
if (norm > norm_max) norm_max = norm;
#if defined(DEBUG_CkEigenSolutions)
if (norm > tols[0]) {
ierr = PetscPrintf(PETSC_COMM_SELF," residual violation: %d, resi: %g\n",i, norm);CHKERRQ(ierr);
}
#endif
}
ierr = PetscPrintf(PETSC_COMM_SELF," max_resi: %g\n", (double)norm_max);CHKERRQ(ierr);
break;
default:
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: cklvl=%d is not supported \n",cklvl);CHKERRQ(ierr);
}
ierr = VecDestroy(&vt2);CHKERRQ(ierr);
ierr = VecDestroy(&vt1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_FCG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,k,idx,mi;
KSP_FCG *fcg = (KSP_FCG*)ksp->data;
PetscScalar alpha=0.0,beta = 0.0,dpi,s;
PetscReal dp=0.0;
Vec B,R,Z,X,Pcurr,Ccurr;
Mat Amat,Pmat;
PetscInt eigs = ksp->calc_sings; /* Variables for eigen estimation - START*/
PetscInt stored_max_it = ksp->max_it;
PetscScalar alphaold = 0,betaold = 1.0,*e = 0,*d = 0;/* Variables for eigen estimation - FINISH */
PetscFunctionBegin;
#define VecXDot(x,y,a) (((fcg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
#define VecXMDot(a,b,c,d) (((fcg->type) == (KSP_CG_HERMITIAN)) ? VecMDot(a,b,c,d) : VecMTDot(a,b,c,d))
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
if (eigs) {e = fcg->e; d = fcg->d; e[0] = 0.0; }
/* Compute initial residual needed for convergence check*/
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* r <- b - Ax */
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- dqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecXDot(R,Z,&s);CHKERRQ(ierr);
dp = PetscSqrtReal(PetscAbsScalar(s)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Initial Convergence Check */
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
if (ksp->normtype == KSP_NORM_NONE) {
ierr = KSPConvergedSkip(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
} else {
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
}
if (ksp->reason) PetscFunctionReturn(0);
/* Apply PC if not already done for convergence check */
if(ksp->normtype == KSP_NORM_UNPRECONDITIONED || ksp->normtype == KSP_NORM_NONE){
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
i = 0;
do {
ksp->its = i+1;
/* If needbe, allocate a new chunk of vectors in P and C */
ierr = KSPAllocateVectors_FCG(ksp,i+1,fcg->vecb);CHKERRQ(ierr);
/* Note that we wrap around and start clobbering old vectors */
idx = i % (fcg->mmax+1);
Pcurr = fcg->Pvecs[idx];
Ccurr = fcg->Cvecs[idx];
/* Compute a new column of P (Currently does not support modified G-S or iterative refinement)*/
switch(fcg->truncstrat){
case KSP_FCG_TRUNC_TYPE_NOTAY :
mi = PetscMax(1,i%(fcg->mmax+1));
break;
case KSP_FCG_TRUNC_TYPE_STANDARD :
mi = fcg->mmax;
break;
default:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unrecognized FCG Truncation Strategy");CHKERRQ(ierr);
}
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
{
PetscInt l,ndots;
l = PetscMax(0,i-mi);
ndots = i-l;
if (ndots){
PetscInt j;
Vec *Pold, *Cold;
PetscScalar *dots;
ierr = PetscMalloc3(ndots,&dots,ndots,&Cold,ndots,&Pold);CHKERRQ(ierr);
for(k=l,j=0;j<ndots;++k,++j){
idx = k % (fcg->mmax+1);
Cold[j] = fcg->Cvecs[idx];
Pold[j] = fcg->Pvecs[idx];
}
ierr = VecXMDot(Z,ndots,Cold,dots);CHKERRQ(ierr);
for(k=0;k<ndots;++k){
dots[k] = -dots[k];
}
ierr = VecMAXPY(Pcurr,ndots,dots,Pold);CHKERRQ(ierr);
ierr = PetscFree3(dots,Cold,Pold);CHKERRQ(ierr);
}
}
/* Update X and R */
betaold = beta;
ierr = VecXDot(Pcurr,R,&beta);CHKERRQ(ierr); /* beta <- pi'*r */
ierr = KSP_MatMult(ksp,Amat,Pcurr,Ccurr);CHKERRQ(ierr); /* w <- A*pi (stored in ci) */
ierr = VecXDot(Pcurr,Ccurr,&dpi);CHKERRQ(ierr); /* dpi <- pi'*w */
alphaold = alpha;
alpha = beta / dpi; /* alpha <- beta/dpi */
ierr = VecAXPY(X,alpha,Pcurr);CHKERRQ(ierr); /* x <- x + alpha * pi */
ierr = VecAXPY(R,-alpha,Ccurr);CHKERRQ(ierr); /* r <- r - alpha * wi */
/* Compute norm for convergence check */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecXDot(R,Z,&s);CHKERRQ(ierr);
dp = PetscSqrtReal(PetscAbsScalar(s)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Check for convergence */
ksp->rnorm = dp;
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;
/* Apply PC if not already done for convergence check */
if(ksp->normtype == KSP_NORM_UNPRECONDITIONED || ksp->normtype == KSP_NORM_NONE){
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
/* Compute current C (which is W/dpi) */
ierr = VecScale(Ccurr,1.0/dpi);CHKERRQ(ierr); /* w <- ci/dpi */
if (eigs) {
if (i > 0) {
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(beta/betaold))/alphaold;
d[i] = PetscSqrtReal(PetscAbsScalar(beta/betaold))*e[i] + 1.0/alpha;
} else {
d[i] = PetscSqrtReal(PetscAbsScalar(beta))*e[i] + 1.0/alpha;
}
}
++i;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
if (eigs) fcg->ned = ksp->its-1;
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_AWBM(Mat A, MatOrderingType type, IS *permR, IS *permC)
{
Vec *scalR, *scalC, scalRVec, scalCVec;
scalR = &scalRVec; scalC = &scalCVec;
/* EVERYTHING IS WRITTEN AS IF THE MATRIX WERE COLUMN-MAJOR */
Mat_SeqAIJ *aij = (Mat_SeqAIJ *) A->data;
PetscInt n = A->rmap->n; /* Number of local columns */
PetscInt m = A->cmap->n; /* Number of local rows */
PetscInt *match; /* The row matched to each column, and inverse column permutation */
PetscInt *matchR; /* The column matched to each row */
PetscInt *p; /* The column permutation */
const PetscInt *ia = aij->i;
const PetscInt *ja = aij->j;
const MatScalar *a = aij->a;
Vec colMax;
PetscScalar *a_j, *sr, *sc;
PetscReal *weights /* c_ij */, *u /* u_i */, *v /* v_j */, eps = PETSC_SQRT_MACHINE_EPSILON;
PetscInt debug = 0, r, c, r1, c1;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscOptionsGetInt(NULL, "-debug", &debug, NULL);CHKERRQ(ierr);
ierr = MatGetVecs(A, NULL, &colMax);CHKERRQ(ierr);
ierr = MatGetRowMaxAbs(A, colMax, NULL);CHKERRQ(ierr);
ierr = PetscMalloc2(n, &match, m, &matchR);CHKERRQ(ierr);
ierr = PetscMalloc1(n, &p);CHKERRQ(ierr);
ierr = PetscCalloc3(m, &u, n, &v, ia[n], &weights);CHKERRQ(ierr);
for (c = 0; c < n; ++c) match[c] = -1;
/* Compute weights */
ierr = VecGetArray(colMax, &a_j);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
for (r = ia[c]; r < ia[c+1]; ++r) {
PetscReal ar = PetscAbsScalar(a[r]);
if (ar == 0.0) weights[r] = PETSC_MAX_REAL;
else weights[r] = log(a_j[c]/ar);
}
}
/* Compute local row weights */
for (r = 0; r < m; ++r) u[r] = PETSC_MAX_REAL;
for (c = 0; c < n; ++c) {
for (r = ia[c]; r < ia[c+1]; ++r) {
u[ja[r]] = PetscMin(u[ja[r]], weights[r]);
}
}
/* Compute local column weights */
for (c = 0; c < n; ++c) {
v[c] = PETSC_MAX_REAL;
for (r = ia[c]; r < ia[c+1]; ++r) {
v[c] = PetscMin(v[c], weights[r] - u[ja[r]]);
}
}
for (r = 0; r < m; ++r) matchR[r] = -1;
/* Match columns */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
/* if (match[c] >= 0) continue; */
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "Row %d\n Weights:", c);CHKERRQ(ierr);}
for (r = ia[c]; r < ia[c+1]; ++r) {
PetscReal weight = weights[r] - u[ja[r]] - v[c];
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " %g", weight);CHKERRQ(ierr);}
if ((weight <= eps) && (matchR[ja[r]] < 0)) {
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "Matched %d -- %d\n", c, ja[r]);CHKERRQ(ierr);}
match[c] = ja[r];
matchR[ja[r]] = c;
break;
}
}
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);}
}
/* Deal with unmatched columns */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
if (match[c] >= 0) continue;
for (r = ia[c]; r < ia[c+1]; ++r) {
PetscReal weight = weights[r] - u[ja[r]] - v[c];
if (weight > eps) continue;
/* \bar c_ij = 0 and (r, j1) \in M */
c1 = matchR[ja[r]];
for (r1 = ia[c1]; r1 < ia[c1+1]; ++r1) {
PetscReal weight1 = weights[r1] - u[ja[r1]] - v[c1];
if ((matchR[ja[r1]] < 0) && (weight1 <= eps)) {
/* (r, c1) in M is replaced by (r, c) and (r1, c1) */
if (debug) {
ierr = PetscPrintf(PETSC_COMM_SELF, "Replaced match %d -- %d\n", c1, ja[r]);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, " Added match %d -- %d\n", c, ja[r]);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, " Added match %d -- %d\n", c1, ja[r1]);CHKERRQ(ierr);
}
match[c] = ja[r];
matchR[ja[r]] = c;
match[c1] = ja[r1];
matchR[ja[r1]] = c1;
break;
}
}
if (match[c] >= 0) break;
}
}
/* Allow matching with non-optimal rows */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
if (match[c] >= 0) continue;
for (r = ia[c]; r < ia[c+1]; ++r) {
if (matchR[ja[r]] < 0) {
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "Matched non-opt %d -- %d\n", c, ja[r]);CHKERRQ(ierr);}
match[c] = ja[r];
matchR[ja[r]] = c;
break;
}
}
}
/* Deal with non-optimal unmatched columns */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
if (match[c] >= 0) continue;
for (r = ia[c]; r < ia[c+1]; ++r) {
/* \bar c_ij = 0 and (r, j1) \in M */
c1 = matchR[ja[r]];
for (r1 = ia[c1]; r1 < ia[c1+1]; ++r1) {
if (matchR[ja[r1]] < 0) {
/* (r, c1) in M is replaced by (r, c) and (r1, c1) */
if (debug) {
ierr = PetscPrintf(PETSC_COMM_SELF, "Replaced match %d -- %d\n", c1, ja[r]);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, " Added match %d -- %d\n", c, ja[r]);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, " Added match %d -- %d\n", c1, ja[r1]);CHKERRQ(ierr);
}
match[c] = ja[r];
matchR[ja[r]] = c;
match[c1] = ja[r1];
matchR[ja[r1]] = c1;
break;
}
}
if (match[c] >= 0) break;
}
}
/* Complete matching */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0, r = 0; c < n; ++c) {
if (match[c] >= n) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Column %d matched to invalid row %d", c, match[c]);
if (match[c] < 0) {
for (; r < n; ++r) {
if (matchR[r] < 0) {
if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "Matched default %d -- %d\n", c, r);CHKERRQ(ierr);}
match[c] = r;
matchR[r] = c;
break;
}
}
}
}
/* Check matching */
ierr = CheckUnmatched(n, match, matchR);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
if (match[c] < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Column %d unmatched", c);
if (match[c] >= n) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Column %d matched to invalid row %d", c, match[c]);
}
/* Make permutation */
for (c = 0; c < n; ++c) {p[match[c]] = c;}
ierr = ISCreateGeneral(PETSC_COMM_SELF, n, p, PETSC_OWN_POINTER, permR);CHKERRQ(ierr);
ierr = ISSetPermutation(*permR);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF, n, 0, 1, permC);CHKERRQ(ierr);
ierr = ISSetPermutation(*permC);CHKERRQ(ierr);
ierr = PetscFree2(match, matchR);CHKERRQ(ierr);
/* Make scaling */
ierr = VecCreateSeq(PETSC_COMM_SELF, n, scalR);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF, n, scalC);CHKERRQ(ierr);
ierr = VecGetArray(*scalR, &sr);CHKERRQ(ierr);
ierr = VecGetArray(*scalC, &sc);CHKERRQ(ierr);
for (c = 0; c < n; ++c) {
sr[c] = PetscExpReal(v[c])/a_j[c];
sc[c] = PetscExpReal(u[c]);
}
ierr = VecRestoreArray(*scalR, &sr);CHKERRQ(ierr);
ierr = VecRestoreArray(*scalC, &sc);CHKERRQ(ierr);
ierr = VecRestoreArray(colMax, &a_j);CHKERRQ(ierr);
ierr = VecDestroy(&colMax);CHKERRQ(ierr);
ierr = PetscFree3(u,v,weights);CHKERRQ(ierr);
ierr = VecDestroy(scalR);CHKERRQ(ierr);
ierr = VecDestroy(scalC);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,delta,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,S,W;
KSP_CG *cg;
Mat Amat,Pmat;
MatStructure pflag;
PetscTruth diagonalscale;
PetscFunctionBegin;
ierr = PCDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
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];
if (cg->singlereduction) {
S = ksp->work[3];
W = ksp->work[4];
} else {
S = 0; /* unused */
W = Z;
}
#if !defined(PETSC_USE_COMPLEX)
#define VecXDot(x,y,a) VecDot(x,y,a)
#else
#define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
#endif
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if PetscIsInfOrNanScalar(beta) SETERRQ(PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = sqrt(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
} else dp = 0.0;
/*
. it - column of the Hessenberg that is complete, PGMRES is actually computing two columns ahead of this
*/
static PetscErrorCode KSPPGMRESUpdateHessenberg(KSP ksp,PetscInt it,PetscBool *hapend,PetscReal *res)
{
PetscScalar *hh,*cc,*ss,*rs;
PetscInt j;
PetscReal hapbnd;
KSP_PGMRES *pgmres = (KSP_PGMRES*)(ksp->data);
PetscErrorCode ierr;
PetscFunctionBegin;
hh = HH(0,it); /* pointer to beginning of column to update */
cc = CC(0); /* beginning of cosine rotations */
ss = SS(0); /* beginning of sine rotations */
rs = RS(0); /* right hand side of least squares system */
/* The Hessenberg matrix is now correct through column it, save that form for possible spectral analysis */
for (j=0; j<=it+1; j++) *HES(j,it) = hh[j];
/* check for the happy breakdown */
hapbnd = PetscMin(PetscAbsScalar(hh[it+1] / rs[it]),pgmres->haptol);
if (PetscAbsScalar(hh[it+1]) < hapbnd) {
ierr = PetscInfo4(ksp,"Detected happy breakdown, current hapbnd = %14.12e H(%D,%D) = %14.12e\n",(double)hapbnd,it+1,it,(double)PetscAbsScalar(*HH(it+1,it)));CHKERRQ(ierr);
*hapend = PETSC_TRUE;
}
/* Apply all the previously computed plane rotations to the new column
of the Hessenberg matrix */
/* Note: this uses the rotation [conj(c) s ; -s c], c= cos(theta), s= sin(theta),
and some refs have [c s ; -conj(s) c] (don't be confused!) */
for (j=0; j<it; j++) {
PetscScalar hhj = hh[j];
hh[j] = PetscConj(cc[j])*hhj + ss[j]*hh[j+1];
hh[j+1] = -ss[j] *hhj + cc[j]*hh[j+1];
}
/*
compute the new plane rotation, and apply it to:
1) the right-hand-side of the Hessenberg system (RS)
note: it affects RS(it) and RS(it+1)
2) the new column of the Hessenberg matrix
note: it affects HH(it,it) which is currently pointed to
by hh and HH(it+1, it) (*(hh+1))
thus obtaining the updated value of the residual...
*/
/* compute new plane rotation */
if (!*hapend) {
PetscReal delta = PetscSqrtReal(PetscSqr(PetscAbsScalar(hh[it])) + PetscSqr(PetscAbsScalar(hh[it+1])));
if (delta == 0.0) {
ksp->reason = KSP_DIVERGED_NULL;
PetscFunctionReturn(0);
}
cc[it] = hh[it] / delta; /* new cosine value */
ss[it] = hh[it+1] / delta; /* new sine value */
hh[it] = PetscConj(cc[it])*hh[it] + ss[it]*hh[it+1];
rs[it+1] = -ss[it]*rs[it];
rs[it] = PetscConj(cc[it])*rs[it];
*res = PetscAbsScalar(rs[it+1]);
} else { /* happy breakdown: HH(it+1, it) = 0, therefore we don't need to apply
another rotation matrix (so RH doesn't change). The new residual is
always the new sine term times the residual from last time (RS(it)),
but now the new sine rotation would be zero...so the residual should
be zero...so we will multiply "zero" by the last residual. This might
not be exactly what we want to do here -could just return "zero". */
*res = 0.0;
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_TCQMR(KSP ksp)
{
PetscReal rnorm0,rnorm,dp1,Gamma;
PetscScalar theta,ep,cl1,sl1,cl,sl,sprod,tau_n1,f;
PetscScalar deltmp,rho,beta,eptmp,ta,s,c,tau_n,delta;
PetscScalar dp11,dp2,rhom1,alpha,tmp;
PetscErrorCode ierr;
PetscFunctionBegin;
ksp->its = 0;
ierr = KSPInitialResidual(ksp,x,u,v,r,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&rnorm0);CHKERRQ(ierr); /* rnorm0 = ||r|| */
ierr = (*ksp->converged)(ksp,0,rnorm0,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
ierr = VecSet(um1,0.0);CHKERRQ(ierr);
ierr = VecCopy(r,u);CHKERRQ(ierr);
rnorm = rnorm0;
tmp = 1.0/rnorm; ierr = VecScale(u,tmp);CHKERRQ(ierr);
ierr = VecSet(vm1,0.0);CHKERRQ(ierr);
ierr = VecCopy(u,v);CHKERRQ(ierr);
ierr = VecCopy(u,v0);CHKERRQ(ierr);
ierr = VecSet(pvec1,0.0);CHKERRQ(ierr);
ierr = VecSet(pvec2,0.0);CHKERRQ(ierr);
ierr = VecSet(p,0.0);CHKERRQ(ierr);
theta = 0.0;
ep = 0.0;
cl1 = 0.0;
sl1 = 0.0;
cl = 0.0;
sl = 0.0;
sprod = 1.0;
tau_n1= rnorm0;
f = 1.0;
Gamma = 1.0;
rhom1 = 1.0;
/*
CALCULATE SQUARED LANCZOS vectors
*/
ierr = (*ksp->converged)(ksp,ksp->its,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
while (!ksp->reason) {
ierr = KSPMonitor(ksp,ksp->its,rnorm);CHKERRQ(ierr);
ksp->its++;
ierr = KSP_PCApplyBAorAB(ksp,u,y,vtmp);CHKERRQ(ierr); /* y = A*u */
ierr = VecDot(y,v0,&dp11);CHKERRQ(ierr);
ierr = VecDot(u,v0,&dp2);CHKERRQ(ierr);
alpha = dp11 / dp2; /* alpha = v0'*y/v0'*u */
deltmp = alpha;
ierr = VecCopy(y,z);CHKERRQ(ierr);
ierr = VecAXPY(z,-alpha,u);CHKERRQ(ierr); /* z = y - alpha u */
ierr = VecDot(u,v0,&rho);CHKERRQ(ierr);
beta = rho / (f*rhom1);
rhom1 = rho;
ierr = VecCopy(z,utmp);CHKERRQ(ierr); /* up1 = (A-alpha*I)*
(z-2*beta*p) + f*beta*
beta*um1 */
ierr = VecAXPY(utmp,-2.0*beta,p);CHKERRQ(ierr);
ierr = KSP_PCApplyBAorAB(ksp,utmp,up1,vtmp);CHKERRQ(ierr);
ierr = VecAXPY(up1,-alpha,utmp);CHKERRQ(ierr);
ierr = VecAXPY(up1,f*beta*beta,um1);CHKERRQ(ierr);
ierr = VecNorm(up1,NORM_2,&dp1);CHKERRQ(ierr);
f = 1.0 / dp1;
ierr = VecScale(up1,f);CHKERRQ(ierr);
ierr = VecAYPX(p,-beta,z);CHKERRQ(ierr); /* p = f*(z-beta*p) */
ierr = VecScale(p,f);CHKERRQ(ierr);
ierr = VecCopy(u,um1);CHKERRQ(ierr);
ierr = VecCopy(up1,u);CHKERRQ(ierr);
beta = beta/Gamma;
eptmp = beta;
ierr = KSP_PCApplyBAorAB(ksp,v,vp1,vtmp);CHKERRQ(ierr);
ierr = VecAXPY(vp1,-alpha,v);CHKERRQ(ierr);
ierr = VecAXPY(vp1,-beta,vm1);CHKERRQ(ierr);
ierr = VecNorm(vp1,NORM_2,&Gamma);CHKERRQ(ierr);
ierr = VecScale(vp1,1.0/Gamma);CHKERRQ(ierr);
ierr = VecCopy(v,vm1);CHKERRQ(ierr);
ierr = VecCopy(vp1,v);CHKERRQ(ierr);
/*
SOLVE Ax = b
*/
/* Apply last two Given's (Gl-1 and Gl) rotations to (beta,alpha,Gamma) */
if (ksp->its > 2) {
theta = sl1*beta;
eptmp = -cl1*beta;
}
if (ksp->its > 1) {
ep = -cl*eptmp + sl*alpha;
deltmp = -sl*eptmp - cl*alpha;
}
if (PetscAbsReal(Gamma) > PetscAbsScalar(deltmp)) {
ta = -deltmp / Gamma;
s = 1.0 / PetscSqrtScalar(1.0 + ta*ta);
c = s*ta;
} else {
ta = -Gamma/deltmp;
c = 1.0 / PetscSqrtScalar(1.0 + ta*ta);
s = c*ta;
}
delta = -c*deltmp + s*Gamma;
tau_n = -c*tau_n1; tau_n1 = -s*tau_n1;
ierr = VecCopy(vm1,pvec);CHKERRQ(ierr);
ierr = VecAXPY(pvec,-theta,pvec2);CHKERRQ(ierr);
ierr = VecAXPY(pvec,-ep,pvec1);CHKERRQ(ierr);
ierr = VecScale(pvec,1.0/delta);CHKERRQ(ierr);
ierr = VecAXPY(x,tau_n,pvec);CHKERRQ(ierr);
cl1 = cl; sl1 = sl; cl = c; sl = s;
ierr = VecCopy(pvec1,pvec2);CHKERRQ(ierr);
ierr = VecCopy(pvec,pvec1);CHKERRQ(ierr);
/* Compute the upper bound on the residual norm r (See QMR paper p. 13) */
sprod = sprod*PetscAbsScalar(s);
rnorm = rnorm0 * PetscSqrtReal((PetscReal)ksp->its+2.0) * PetscRealPart(sprod);
ierr = (*ksp->converged)(ksp,ksp->its,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->its >= ksp->max_it) {
if (!ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
break;
}
}
ierr = KSPMonitor(ksp,ksp->its,rnorm);CHKERRQ(ierr);
ierr = KSPUnwindPreconditioner(ksp,x,vtmp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPLGMRESCycle(PetscInt *itcount,KSP ksp)
{
KSP_LGMRES *lgmres = (KSP_LGMRES *)(ksp->data);
PetscReal res_norm, res;
PetscReal hapbnd, tt;
PetscScalar tmp;
PetscBool hapend = PETSC_FALSE; /* indicates happy breakdown ending */
PetscErrorCode ierr;
PetscInt loc_it; /* local count of # of dir. in Krylov space */
PetscInt max_k = lgmres->max_k; /* max approx space size */
PetscInt max_it = ksp->max_it; /* max # of overall iterations for the method */
/* LGMRES_MOD - new variables*/
PetscInt aug_dim = lgmres->aug_dim;
PetscInt spot = 0;
PetscInt order = 0;
PetscInt it_arnoldi; /* number of arnoldi steps to take */
PetscInt it_total; /* total number of its to take (=approx space size)*/
PetscInt ii, jj;
PetscReal tmp_norm;
PetscScalar inv_tmp_norm;
PetscScalar *avec;
PetscFunctionBegin;
/* Number of pseudo iterations since last restart is the number
of prestart directions */
loc_it = 0;
/* LGMRES_MOD: determine number of arnoldi steps to take */
/* if approx_constant then we keep the space the same size even if
we don't have the full number of aug vectors yet*/
if (lgmres->approx_constant) {
it_arnoldi = max_k - lgmres->aug_ct;
} else {
it_arnoldi = max_k - aug_dim;
}
it_total = it_arnoldi + lgmres->aug_ct;
/* initial residual is in VEC_VV(0) - compute its norm*/
ierr = VecNorm(VEC_VV(0),NORM_2,&res_norm);
CHKERRQ(ierr);
res = res_norm;
/* first entry in right-hand-side of hessenberg system is just
the initial residual norm */
*GRS(0) = res_norm;
/* check for the convergence */
if (!res) {
if (itcount) *itcount = 0;
ksp->reason = KSP_CONVERGED_ATOL;
ierr = PetscInfo(ksp,"Converged due to zero residual norm on entry\n");
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* scale VEC_VV (the initial residual) */
tmp = 1.0/res_norm;
ierr = VecScale(VEC_VV(0),tmp);
CHKERRQ(ierr);
ksp->rnorm = res;
/* note: (lgmres->it) is always set one less than (loc_it) It is used in
KSPBUILDSolution_LGMRES, where it is passed to KSPLGMRESBuildSoln.
Note that when KSPLGMRESBuildSoln is called from this function,
(loc_it -1) is passed, so the two are equivalent */
lgmres->it = (loc_it - 1);
/* MAIN ITERATION LOOP BEGINNING*/
/* keep iterating until we have converged OR generated the max number
of directions OR reached the max number of iterations for the method */
ierr = (*ksp->converged)(ksp,ksp->its,res,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
while (!ksp->reason && loc_it < it_total && ksp->its < max_it) { /* LGMRES_MOD: changed to it_total */
KSPLogResidualHistory(ksp,res);
lgmres->it = (loc_it - 1);
ierr = KSPMonitor(ksp,ksp->its,res);
CHKERRQ(ierr);
/* see if more space is needed for work vectors */
if (lgmres->vv_allocated <= loc_it + VEC_OFFSET + 1) {
ierr = KSPLGMRESGetNewVectors(ksp,loc_it+1);
CHKERRQ(ierr);
/* (loc_it+1) is passed in as number of the first vector that should
be allocated */
}
/*LGMRES_MOD: decide whether this is an arnoldi step or an aug step */
if (loc_it < it_arnoldi) { /* Arnoldi */
ierr = KSP_PCApplyBAorAB(ksp,VEC_VV(loc_it),VEC_VV(1+loc_it),VEC_TEMP_MATOP);
CHKERRQ(ierr);
} else { /*aug step */
order = loc_it - it_arnoldi + 1; /* which aug step */
for (ii=0; ii<aug_dim; ii++) {
if (lgmres->aug_order[ii] == order) {
spot = ii;
break; /* must have this because there will be duplicates before aug_ct = aug_dim */
}
}
ierr = VecCopy(A_AUGVEC(spot), VEC_VV(1+loc_it));
CHKERRQ(ierr);
/*note: an alternate implementation choice would be to only save the AUGVECS and
not A_AUGVEC and then apply the PC here to the augvec */
}
/* update hessenberg matrix and do Gram-Schmidt - new direction is in
VEC_VV(1+loc_it)*/
ierr = (*lgmres->orthog)(ksp,loc_it);
CHKERRQ(ierr);
/* new entry in hessenburg is the 2-norm of our new direction */
ierr = VecNorm(VEC_VV(loc_it+1),NORM_2,&tt);
CHKERRQ(ierr);
*HH(loc_it+1,loc_it) = tt;
*HES(loc_it+1,loc_it) = tt;
/* check for the happy breakdown */
hapbnd = PetscAbsScalar(tt / *GRS(loc_it));/* GRS(loc_it) contains the res_norm from the last iteration */
if (hapbnd > lgmres->haptol) hapbnd = lgmres->haptol;
if (tt > hapbnd) {
tmp = 1.0/tt;
ierr = VecScale(VEC_VV(loc_it+1),tmp);
CHKERRQ(ierr); /* scale new direction by its norm */
} else {
ierr = PetscInfo2(ksp,"Detected happy breakdown, current hapbnd = %G tt = %G\n",hapbnd,tt);
CHKERRQ(ierr);
hapend = PETSC_TRUE;
}
/* Now apply rotations to new col of hessenberg (and right side of system),
calculate new rotation, and get new residual norm at the same time*/
ierr = KSPLGMRESUpdateHessenberg(ksp,loc_it,hapend,&res);
CHKERRQ(ierr);
if (ksp->reason) break;
loc_it++;
lgmres->it = (loc_it-1); /* Add this here in case it has converged */
ierr = PetscObjectTakeAccess(ksp);
CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = res;
ierr = PetscObjectGrantAccess(ksp);
CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its,res,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
/* Catch error in happy breakdown and signal convergence and break from loop */
if (hapend) {
if (!ksp->reason) {
SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_PLIB,"You reached the happy break down,but convergence was not indicated. Residual norm = %G",res);
}
break;
}
}
/* END OF ITERATION LOOP */
KSPLogResidualHistory(ksp,res);
/* Monitor if we know that we will not return for a restart */
if (ksp->reason || ksp->its >= max_it) {
ierr = KSPMonitor(ksp, ksp->its, res);
CHKERRQ(ierr);
}
if (itcount) *itcount = loc_it;
/*
Down here we have to solve for the "best" coefficients of the Krylov
columns, add the solution values together, and possibly unwind the
preconditioning from the solution
*/
/* Form the solution (or the solution so far) */
/* Note: must pass in (loc_it-1) for iteration count so that KSPLGMRESBuildSoln
properly navigates */
ierr = KSPLGMRESBuildSoln(GRS(0),ksp->vec_sol,ksp->vec_sol,ksp,loc_it-1);
CHKERRQ(ierr);
/* LGMRES_MOD collect aug vector and A*augvector for future restarts -
only if we will be restarting (i.e. this cycle performed it_total
iterations) */
if (!ksp->reason && ksp->its < max_it && aug_dim > 0) {
/*AUG_TEMP contains the new augmentation vector (assigned in KSPLGMRESBuildSoln) */
if (!lgmres->aug_ct) {
spot = 0;
lgmres->aug_ct++;
} else if (lgmres->aug_ct < aug_dim) {
spot = lgmres->aug_ct;
lgmres->aug_ct++;
} else { /* truncate */
for (ii=0; ii<aug_dim; ii++) {
if (lgmres->aug_order[ii] == aug_dim) {
spot = ii;
}
}
}
ierr = VecCopy(AUG_TEMP, AUGVEC(spot));
CHKERRQ(ierr);
/*need to normalize */
ierr = VecNorm(AUGVEC(spot), NORM_2, &tmp_norm);
CHKERRQ(ierr);
inv_tmp_norm = 1.0/tmp_norm;
ierr = VecScale(AUGVEC(spot),inv_tmp_norm);
CHKERRQ(ierr);
/*set new aug vector to order 1 - move all others back one */
for (ii=0; ii < aug_dim; ii++) {
AUG_ORDER(ii)++;
}
AUG_ORDER(spot) = 1;
/*now add the A*aug vector to A_AUGVEC(spot) - this is independ. of preconditioning type*/
/* want V*H*y - y is in GRS, V is in VEC_VV and H is in HES */
/* first do H+*y */
avec = lgmres->hwork;
ierr = PetscMemzero(avec,(it_total+1)*sizeof(*avec));
CHKERRQ(ierr);
for (ii=0; ii < it_total + 1; ii++) {
for (jj=0; jj <= ii+1 && jj < it_total+1; jj++) {
avec[jj] += *HES(jj ,ii) * *GRS(ii);
}
}
/*now multiply result by V+ */
ierr = VecSet(VEC_TEMP,0.0);
CHKERRQ(ierr);
ierr = VecMAXPY(VEC_TEMP, it_total+1, avec, &VEC_VV(0));
CHKERRQ(ierr); /*answer is in VEC_TEMP*/
/*copy answer to aug location and scale*/
ierr = VecCopy(VEC_TEMP, A_AUGVEC(spot));
CHKERRQ(ierr);
ierr = VecScale(A_AUGVEC(spot),inv_tmp_norm);
CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PCISApplyInvSchur(PC pc, Vec b, Vec x, Vec vec1_N, Vec vec2_N)
{
PetscErrorCode ierr;
PC_IS *pcis = (PC_IS*)(pc->data);
PetscFunctionBegin;
/*
Neumann solvers.
Applying the inverse of the local Schur complement, i.e, solving a Neumann
Problem with zero at the interior nodes of the RHS and extracting the interface
part of the solution. inverse Schur complement is applied to b and the result
is stored in x.
*/
/* Setting the RHS vec1_N */
ierr = VecSet(vec1_N,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,b,vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,b,vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
/* Checking for consistency of the RHS */
{
PetscBool flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-pc_is_check_consistency",&flg,NULL);CHKERRQ(ierr);
if (flg) {
PetscScalar average;
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)pc),&viewer);CHKERRQ(ierr);
ierr = VecSum(vec1_N,&average);CHKERRQ(ierr);
average = average / ((PetscReal)pcis->n);
ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr);
if (pcis->pure_neumann) {
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d is floating. Average = % 1.14e\n",PetscGlobalRank,PetscAbsScalar(average));CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d is fixed. Average = % 1.14e\n",PetscGlobalRank,PetscAbsScalar(average));CHKERRQ(ierr);
}
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr);
}
}
/* Solving the system for vec2_N */
ierr = KSPSolve(pcis->ksp_N,vec1_N,vec2_N);CHKERRQ(ierr);
/* Extracting the local interface vector out of the solution */
ierr = VecScatterBegin(pcis->N_to_B,vec2_N,x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,vec2_N,x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPLGMRESBuildSoln(PetscScalar* nrs,Vec vguess,Vec vdest,KSP ksp,PetscInt it)
{
PetscScalar tt;
PetscErrorCode ierr;
PetscInt ii,k,j;
KSP_LGMRES *lgmres = (KSP_LGMRES *)(ksp->data);
/*LGMRES_MOD */
PetscInt it_arnoldi, it_aug;
PetscInt jj, spot = 0;
PetscFunctionBegin;
/* Solve for solution vector that minimizes the residual */
/* If it is < 0, no lgmres steps have been performed */
if (it < 0) {
ierr = VecCopy(vguess,vdest);
CHKERRQ(ierr); /* VecCopy() is smart, exists immediately if vguess == vdest */
PetscFunctionReturn(0);
}
/* so (it+1) lgmres steps HAVE been performed */
/* LGMRES_MOD - determine if we need to use augvecs for the soln - do not assume that
this is called after the total its allowed for an approx space */
if (lgmres->approx_constant) {
it_arnoldi = lgmres->max_k - lgmres->aug_ct;
} else {
it_arnoldi = lgmres->max_k - lgmres->aug_dim;
}
if (it_arnoldi >= it +1) {
it_aug = 0;
it_arnoldi = it+1;
} else {
it_aug = (it + 1) - it_arnoldi;
}
/* now it_arnoldi indicates the number of matvecs that took place */
lgmres->matvecs += it_arnoldi;
/* solve the upper triangular system - GRS is the right side and HH is
the upper triangular matrix - put soln in nrs */
if (*HH(it,it) == 0.0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_CONV_FAILED,"HH(it,it) is identically zero; it = %D GRS(it) = %G",it,PetscAbsScalar(*GRS(it)));
if (*HH(it,it) != 0.0) {
nrs[it] = *GRS(it) / *HH(it,it);
} else {
nrs[it] = 0.0;
}
for (ii=1; ii<=it; ii++) {
k = it - ii;
tt = *GRS(k);
for (j=k+1; j<=it; j++) tt = tt - *HH(k,j) * nrs[j];
nrs[k] = tt / *HH(k,k);
}
/* Accumulate the correction to the soln of the preconditioned prob. in VEC_TEMP */
ierr = VecSet(VEC_TEMP,0.0);
CHKERRQ(ierr); /* set VEC_TEMP components to 0 */
/*LGMRES_MOD - if augmenting has happened we need to form the solution
using the augvecs */
if (!it_aug) { /* all its are from arnoldi */
ierr = VecMAXPY(VEC_TEMP,it+1,nrs,&VEC_VV(0));
CHKERRQ(ierr);
} else { /*use aug vecs */
/*first do regular krylov directions */
ierr = VecMAXPY(VEC_TEMP,it_arnoldi,nrs,&VEC_VV(0));
CHKERRQ(ierr);
/*now add augmented portions - add contribution of aug vectors one at a time*/
for (ii=0; ii<it_aug; ii++) {
for (jj=0; jj<lgmres->aug_dim; jj++) {
if (lgmres->aug_order[jj] == (ii+1)) {
spot = jj;
break; /* must have this because there will be duplicates before aug_ct = aug_dim */
}
}
ierr = VecAXPY(VEC_TEMP,nrs[it_arnoldi+ii],AUGVEC(spot));
CHKERRQ(ierr);
}
}
/* now VEC_TEMP is what we want to keep for augmenting purposes - grab before the
preconditioner is "unwound" from right-precondtioning*/
ierr = VecCopy(VEC_TEMP, AUG_TEMP);
CHKERRQ(ierr);
ierr = KSPUnwindPreconditioner(ksp,VEC_TEMP,VEC_TEMP_MATOP);
CHKERRQ(ierr);
/* add solution to previous solution */
/* put updated solution into vdest.*/
ierr = VecCopy(vguess,vdest);
CHKERRQ(ierr);
ierr = VecAXPY(vdest,1.0,VEC_TEMP);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_MINRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar alpha,beta,ibeta,betaold,eta,c=1.0,ceta,cold=1.0,coold,s=0.0,sold=0.0,soold;
PetscScalar rho0,rho1,irho1,rho2,mrho2,rho3,mrho3,dp = 0.0;
PetscReal np;
Vec X,B,R,Z,U,V,W,UOLD,VOLD,WOLD,WOOLD;
Mat Amat,Pmat;
MatStructure pflag;
KSP_MINRES *minres = (KSP_MINRES*)ksp->data;
PetscBool 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);
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
U = ksp->work[2];
V = ksp->work[3];
W = ksp->work[4];
UOLD = ksp->work[5];
VOLD = ksp->work[6];
WOLD = ksp->work[7];
WOOLD = ksp->work[8];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ksp->its = 0;
ierr = VecSet(UOLD,0.0);CHKERRQ(ierr); /* u_old <- 0 */
ierr = VecCopy(UOLD,VOLD);CHKERRQ(ierr); /* v_old <- 0 */
ierr = VecCopy(UOLD,W);CHKERRQ(ierr); /* w <- 0 */
ierr = VecCopy(UOLD,WOLD);CHKERRQ(ierr); /* w_old <- 0 */
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - A*x */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- B*r */
ierr = VecDot(R,Z,&dp);CHKERRQ(ierr);
if (PetscRealPart(dp) < minres->haptol) {
ierr = PetscInfo2(ksp,"Detected indefinite operator %G tolerance %G\n",PetscRealPart(dp),minres->haptol);CHKERRQ(ierr);
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
PetscFunctionReturn(0);
}
dp = PetscAbsScalar(dp);
dp = PetscSqrtScalar(dp);
beta = dp; /* beta <- sqrt(r'*z */
eta = beta;
ierr = VecCopy(R,V);CHKERRQ(ierr);
ierr = VecCopy(Z,U);CHKERRQ(ierr);
ibeta = 1.0 / beta;
ierr = VecScale(V,ibeta);CHKERRQ(ierr); /* v <- r / beta */
ierr = VecScale(U,ibeta);CHKERRQ(ierr); /* u <- z / beta */
ierr = VecNorm(Z,NORM_2,&np);CHKERRQ(ierr); /* np <- ||z|| */
ierr = KSPLogResidualHistory(ksp,np);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,np);CHKERRQ(ierr);
ksp->rnorm = np;
ierr = (*ksp->converged)(ksp,0,np,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
i = 0;
do {
ksp->its = i+1;
/* Lanczos */
ierr = KSP_MatMult(ksp,Amat,U,R);CHKERRQ(ierr); /* r <- A*u */
ierr = VecDot(U,R,&alpha);CHKERRQ(ierr); /* alpha <- r'*u */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- B*r */
ierr = VecAXPY(R,-alpha,V);CHKERRQ(ierr); /* r <- r - alpha v */
ierr = VecAXPY(Z,-alpha,U);CHKERRQ(ierr); /* z <- z - alpha u */
ierr = VecAXPY(R,-beta,VOLD);CHKERRQ(ierr); /* r <- r - beta v_old */
ierr = VecAXPY(Z,-beta,UOLD);CHKERRQ(ierr); /* z <- z - beta u_old */
betaold = beta;
ierr = VecDot(R,Z,&dp);CHKERRQ(ierr);
if ( PetscRealPart(dp) < minres->haptol) {
ierr = PetscInfo2(ksp,"Detected indefinite operator %G tolerance %G\n",PetscRealPart(dp),minres->haptol);CHKERRQ(ierr);
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
break;
}
dp = PetscAbsScalar(dp);
beta = PetscSqrtScalar(dp); /* beta <- sqrt(r'*z) */
/* QR factorisation */
coold = cold; cold = c; soold = sold; sold = s;
rho0 = cold * alpha - coold * sold * betaold;
rho1 = PetscSqrtScalar(rho0*rho0 + beta*beta);
rho2 = sold * alpha + coold * cold * betaold;
rho3 = soold * betaold;
/* Givens rotation */
c = rho0 / rho1;
s = beta / rho1;
/* Update */
ierr = VecCopy(WOLD,WOOLD);CHKERRQ(ierr); /* w_oold <- w_old */
ierr = VecCopy(W,WOLD);CHKERRQ(ierr); /* w_old <- w */
ierr = VecCopy(U,W);CHKERRQ(ierr); /* w <- u */
mrho2 = -rho2;
ierr = VecAXPY(W,mrho2,WOLD);CHKERRQ(ierr); /* w <- w - rho2 w_old */
mrho3 = -rho3;
ierr = VecAXPY(W,mrho3,WOOLD);CHKERRQ(ierr); /* w <- w - rho3 w_oold */
irho1 = 1.0 / rho1;
ierr = VecScale(W,irho1);CHKERRQ(ierr); /* w <- w / rho1 */
ceta = c * eta;
ierr = VecAXPY(X,ceta,W);CHKERRQ(ierr); /* x <- x + c eta w */
eta = -s * eta;
ierr = VecCopy(V,VOLD);CHKERRQ(ierr);
ierr = VecCopy(U,UOLD);CHKERRQ(ierr);
ierr = VecCopy(R,V);CHKERRQ(ierr);
ierr = VecCopy(Z,U);CHKERRQ(ierr);
ibeta = 1.0 / beta;
ierr = VecScale(V,ibeta);CHKERRQ(ierr); /* v <- r / beta */
ierr = VecScale(U,ibeta);CHKERRQ(ierr); /* u <- z / beta */
np = ksp->rnorm * PetscAbsScalar(s);
ksp->rnorm = np;
ierr = KSPLogResidualHistory(ksp,np);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,np);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,np,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) break;
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat A,B;
Vec xx,s1,s2,yy;
PetscErrorCode ierr;
PetscInt m=45,rows[2],cols[2],bs=1,i,row,col,*idx,M;
PetscScalar rval,vals1[4],vals2[4];
PetscRandom rdm;
IS is1,is2;
PetscReal s1norm,s2norm,rnorm,tol = 1.e-4;
PetscBool flg;
MatFactorInfo info;
PetscInitialize(&argc,&args,(char *)0,help);
/* Test MatSetValues() and MatGetValues() */
ierr = PetscOptionsGetInt(PETSC_NULL,"-mat_block_size",&bs,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-mat_size",&m,PETSC_NULL);CHKERRQ(ierr);
M = m*bs;
ierr = MatCreateSeqBAIJ(PETSC_COMM_SELF,bs,M,M,1,PETSC_NULL,&A);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,M,M,15,PETSC_NULL,&B);CHKERRQ(ierr);
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_SELF,&rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,M,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&s1);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&s2);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&yy);CHKERRQ(ierr);
/* For each row add atleast 15 elements */
for (row=0; row<M; row++) {
for (i=0; i<25*bs; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
col = (PetscInt)(PetscRealPart(rval)*M);
ierr = MatSetValues(A,1,&row,1,&col,&rval,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&row,1,&col,&rval,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Now set blocks of values */
for (i=0; i<20*bs; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[0] = (PetscInt)(PetscRealPart(rval)*M);
vals1[0] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[1] = (PetscInt)(PetscRealPart(rval)*M);
vals1[1] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[0] = (PetscInt)(PetscRealPart(rval)*M);
vals1[2] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[1] = (PetscInt)(PetscRealPart(rval)*M);
vals1[3] = rval;
ierr = MatSetValues(A,2,rows,2,cols,vals1,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,2,rows,2,cols,vals1,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Test MatNorm() */
ierr = MatNorm(A,NORM_FROBENIUS,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_FROBENIUS,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if ( rnorm>tol ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_FROBENIUS()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
ierr = MatNorm(A,NORM_INFINITY,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_INFINITY,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if ( rnorm>tol ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_INFINITY()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
ierr = MatNorm(A,NORM_1,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_1,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if ( rnorm>tol ) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_NORM_1()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
/* MatShift() */
rval = 10*s1norm;
ierr = MatShift(A,rval);CHKERRQ(ierr);
ierr = MatShift(B,rval);CHKERRQ(ierr);
/* Test MatTranspose() */
ierr = MatTranspose(A,MAT_REUSE_MATRIX,&A);CHKERRQ(ierr);
ierr = MatTranspose(B,MAT_REUSE_MATRIX,&B);CHKERRQ(ierr);
/* Now do MatGetValues() */
for (i=0; i<30; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[0] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[1] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[0] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[1] = (PetscInt)(PetscRealPart(rval)*M);
ierr = MatGetValues(A,2,rows,2,cols,vals1);CHKERRQ(ierr);
ierr = MatGetValues(B,2,rows,2,cols,vals2);CHKERRQ(ierr);
ierr = PetscMemcmp(vals1,vals2,4*sizeof(PetscScalar),&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatGetValues bs = %D\n",bs);CHKERRQ(ierr);
}
}
/* Test MatMult(), MatMultAdd() */
for (i=0; i<40; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSet(s2,0.0);CHKERRQ(ierr);
ierr = MatMult(A,xx,s1);CHKERRQ(ierr);
ierr = MatMultAdd(A,xx,s2,s2);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatMult not equal to MatMultAdd Norm1=%e Norm2=%e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatMult() */
ierr = MatMultEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg){
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMult()\n");CHKERRQ(ierr);
}
/* Test MatMultAdd() */
ierr = MatMultAddEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg){
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultAdd()\n");CHKERRQ(ierr);
}
/* Test MatMultTranspose() */
ierr = MatMultTransposeEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg){
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultTranspose()\n");CHKERRQ(ierr);
}
/* Test MatMultTransposeAdd() */
ierr = MatMultTransposeAddEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg){
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultTransposeAdd()\n");CHKERRQ(ierr);
}
/* Do LUFactor() on both the matrices */
ierr = PetscMalloc(M*sizeof(PetscInt),&idx);CHKERRQ(ierr);
for (i=0; i<M; i++) idx[i] = i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,M,idx,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,M,idx,PETSC_COPY_VALUES,&is2);CHKERRQ(ierr);
ierr = PetscFree(idx);CHKERRQ(ierr);
ierr = ISSetPermutation(is1);CHKERRQ(ierr);
ierr = ISSetPermutation(is2);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info);CHKERRQ(ierr);
info.fill = 2.0;
info.dtcol = 0.0;
info.zeropivot = 1.e-14;
info.pivotinblocks = 1.0;
ierr = MatLUFactor(B,is1,is2,&info);CHKERRQ(ierr);
ierr = MatLUFactor(A,is1,is2,&info);CHKERRQ(ierr);
/* Test MatSolveAdd() */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSetRandom(yy,rdm);CHKERRQ(ierr);
ierr = MatSolveAdd(B,xx,yy,s2);CHKERRQ(ierr);
ierr = MatSolveAdd(A,xx,yy,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveAdd - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolveAdd() when x = A'b +x */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSetRandom(s1,rdm);CHKERRQ(ierr);
ierr = VecCopy(s2,s1);CHKERRQ(ierr);
ierr = MatSolveAdd(B,xx,s2,s2);CHKERRQ(ierr);
ierr = MatSolveAdd(A,xx,s1,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveAdd(same) - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolve() */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = MatSolve(B,xx,s2);CHKERRQ(ierr);
ierr = MatSolve(A,xx,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolve - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolveTranspose() */
if (bs < 8) {
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = MatSolveTranspose(B,xx,s2);CHKERRQ(ierr);
ierr = MatSolveTranspose(A,xx,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveTranspose - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
}
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&s1);CHKERRQ(ierr);
ierr = VecDestroy(&s2);CHKERRQ(ierr);
ierr = VecDestroy(&yy);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,delta,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,S,W;
KSP_CG *cg;
Mat Amat,Pmat;
PetscBool diagonalscale;
/* Dingwen */
PetscInt itv_d, itv_c;
PetscScalar CKSX1,CKSZ1,CKSR1,CKSP1,CKSS1,CKSW1;
PetscScalar CKSX2,CKSZ2,CKSR2,CKSP2,CKSS2,CKSW2;
Vec CKSAmat1;
Vec CKSAmat2;
Vec C1,C2;
PetscScalar d1,d2;
PetscScalar sumX1,sumR1;
PetscScalar sumX2,sumR2;
Vec CKPX,CKPP;
PetscScalar CKPbetaold;
PetscInt CKPi;
PetscBool flag1 = PETSC_TRUE, flag2 = PETSC_TRUE;
PetscInt pos;
PetscScalar v;
VecScatter ctx;
Vec W_SEQ;
PetscScalar *_W;
/* Dingwen */
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);
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];
/* Dingwen */
CKPX = ksp->work[3];
CKPP = ksp->work[4];
CKSAmat1 = ksp->work[5];
CKSAmat2 = ksp->work[6];
C1 = ksp->work[7];
C2 = ksp->work[8];
/* Dingwen */
/* Dingwen */
int rank; /* Get MPI variables */
MPI_Comm_rank (MPI_COMM_WORLD,&rank);
/* Dingwen */
#define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
if (cg->singlereduction) {
S = ksp->work[9];
W = ksp->work[10];
} else {
S = 0; /* unused */
W = Z;
}
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
/* Dingwen */
/* checksum coefficients initialization */
PetscInt size;
ierr = VecGetSize(B,&size);
for (i=0; i<size; i++)
{
v = 1.0;
ierr = VecSetValues(C1,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
v = i;
ierr = VecSetValues(C2,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
}
d1 = 1.0;
d2 = 2.0;
/* Dingwen */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
/* Dingwen */
ierr = VecXDot(C1,S,&CKSS1);CHKERRQ(ierr); /* Compute the initial checksum1(S) */
ierr = VecXDot(C2,S,&CKSS2);CHKERRQ(ierr); /* Compute the initial checksum2(S) */
/* Dingwen */
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
KSPCheckDot(ksp,beta);
dp = PetscSqrtReal(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
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);
if (ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
if (ksp->normtype != KSP_NORM_NATURAL) {
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
KSPCheckDot(ksp,beta);
}
/* Dingwen */
/* Checksum Initialization */
ierr = VecXDot(C1,X,&CKSX1);CHKERRQ(ierr); /* Compute the initial checksum1(X) */
ierr = VecXDot(C1,W,&CKSW1);CHKERRQ(ierr); /* Compute the initial checksum1(W) */
ierr = VecXDot(C1,R,&CKSR1);CHKERRQ(ierr); /* Compute the initial checksum1(R) */
ierr = VecXDot(C1,Z,&CKSZ1);CHKERRQ(ierr); /* Compute the initial checksum1(Z) */
ierr = VecXDot(C2,X,&CKSX2);CHKERRQ(ierr); /* Compute the initial checksum2(X) */
ierr = VecXDot(C2,W,&CKSW2);CHKERRQ(ierr); /* Compute the initial checksum2(W) */
ierr = VecXDot(C2,R,&CKSR2);CHKERRQ(ierr); /* Compute the initial checksum2(R) */
ierr = VecXDot(C2,Z,&CKSZ2);CHKERRQ(ierr); /* Compute the initial checksum2(Z) */
ierr = KSP_MatMultTranspose(ksp,Amat,C1,CKSAmat1);CHKERRQ(ierr);
ierr = VecAXPY(CKSAmat1,-d1,C1);CHKERRQ(ierr);
ierr = VecAXPY(CKSAmat1,-d2,C2);CHKERRQ(ierr); /* Compute the initial checksum1(A) */
ierr = KSP_MatMultTranspose(ksp,Amat,C2,CKSAmat2);CHKERRQ(ierr);
ierr = VecAXPY(CKSAmat2,-d2,C1);CHKERRQ(ierr);
ierr = VecAXPY(CKSAmat2,-d1,C2);CHKERRQ(ierr); /* Compute the initial checksum2(A) */
itv_c = 2;
itv_d = 10;
/* Dingwen */
i = 0;
do {
/* Dingwen */
if ((i>0) && (i%itv_d == 0))
{
ierr = VecXDot(C1,X,&sumX1);CHKERRQ(ierr);
ierr = VecXDot(C1,R,&sumR1);CHKERRQ(ierr);
if ((PetscAbsScalar(sumX1-CKSX1) > 1.0e-6) || (PetscAbsScalar(sumR1-CKSR1) > 1.0e-6))
{
/* Rollback and Recovery */
if (rank==0) printf ("Recovery start...\n");
if (rank==0) printf ("Rollback from iteration-%d to iteration-%d\n",i,CKPi);
betaold = CKPbetaold; /* Recovery scalar betaold by checkpoint*/
i = CKPi; /* Recovery integer i by checkpoint */
ierr = VecCopy(CKPP,P);CHKERRQ(ierr); /* Recovery vector P from checkpoint */
ierr = VecXDot(C1,P,&CKSP1);CHKERRQ(ierr); /* Recovery checksum1(P) by P */
ierr = VecXDot(C2,P,&CKSP2);CHKERRQ(ierr); /* Recovery checksum2(P) by P */
ierr = KSP_MatMult(ksp,Amat,P,W);CHKERRQ(ierr); /* Recovery vector W by P */
ierr = VecXDot(P,W,&dpi);CHKERRQ(ierr); /* Recovery scalar dpi by P and W */
ierr = VecCopy(CKPX,X);CHKERRQ(ierr); /* Recovery vector X from checkpoint */
ierr = VecXDot(C1,X,&CKSX1);CHKERRQ(ierr); /* Recovery checksum1(X) by X */
ierr = VecXDot(C2,X,&CKSX2);CHKERRQ(ierr); /* Recovery checksum2(X) by X */
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* Recovery vector R by X */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
ierr = VecXDot(C1,R,&CKSR1);CHKERRQ(ierr); /* Recovery checksum1(R) by R */
ierr = VecXDot(C2,R,&CKSR2);CHKERRQ(ierr); /* Recovery checksum2(R) by R */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* Recovery vector Z by R */
ierr = VecXDot(C1,Z,&CKSZ1);CHKERRQ(ierr); /* Recovery checksum1(Z) by Z */
ierr = VecXDot(C2,Z,&CKSZ2);CHKERRQ(ierr); /* Recovery checksum2(Z) by Z */
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* Recovery scalar beta by Z and R */
if (rank==0) printf ("Recovery end.\n");
}
else if (i%(itv_c*itv_d) == 0)
{
if (rank==0) printf ("Checkpoint iteration-%d\n",i);
ierr = VecCopy(X,CKPX);CHKERRQ(ierr);
ierr = VecCopy(P,CKPP);CHKERRQ(ierr);
CKPbetaold = betaold;
CKPi = i;
}
}
ksp->its = i+1;
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 ((i > 0) && (beta*betaold < 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;
/* Dingwen */
ierr = VecXDot(C1,P, &CKSP1);CHKERRQ(ierr); /* Compute the initial checksum1(P) */
ierr = VecXDot(C2,P, &CKSP2);CHKERRQ(ierr); /* Compute the initial checksum2(P) */
/* Dingwen */
} 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 */
/* Dingwen */
CKSP1 = CKSZ1 + b*CKSP1; /* Update checksum1(P) = checksum1(Z) + b*checksum1(P); */
CKSP2 = CKSZ2 + b*CKSP2; /* Update checksum2(P) = checksum2(Z) + b*checksum2(P); */
/* Dingwen */
}
dpiold = dpi;
if (!cg->singlereduction || !i) {
ierr = KSP_MatMult(ksp,Amat,P,W);CHKERRQ(ierr); /* w <- Ap */ /* MVM */
ierr = VecXDot(P,W,&dpi);CHKERRQ(ierr); /* dpi <- p'w */
/* Dingwen */
ierr = VecXDot(CKSAmat1, P, &CKSW1);CHKERRQ(ierr);
CKSW1 = CKSW1 + d1*CKSP1 + d2*CKSP2; /* Update checksum1(W) = checksum1(A)P + d1*checksum1(P) + d2*checksum2(P); */
ierr = VecXDot(CKSAmat2, P, &CKSW2);CHKERRQ(ierr);
CKSW2 = CKSW2 + d2*CKSP1 + d1*CKSP2; /* Update checksum2(W) = checksum2(A)P + d2*checksum1(P) + d1*checksum2(P); */
if((i==41)&&(flag2))
{
pos = 100;
v = 1000;
ierr = VecSetValue(W,pos,v,INSERT_VALUES);CHKERRQ(ierr);
VecAssemblyBegin(W);
VecAssemblyEnd(W);
if (rank==0) printf ("Inject an error in %d-th element of vector W after MVM W=AP at iteration-%d\n", pos,i);
flag2 = PETSC_FALSE;
}
PetscScalar delta1,delta2;
PetscScalar sumW1,sumW2;
ierr = VecXDot(C1,W,&sumW1);CHKERRQ(ierr);
ierr = VecXDot(C2,W,&sumW2);CHKERRQ(ierr);
delta1 = sumW1 - CKSW1;
delta2 = sumW2 - CKSW2;
if (PetscAbsScalar(delta1) > 1.0e-6)
{
VecScatterCreateToAll(W,&ctx,&W_SEQ);
VecScatterBegin(ctx,W,W_SEQ,INSERT_VALUES,SCATTER_FORWARD);
VecScatterEnd(ctx,W,W_SEQ,INSERT_VALUES,SCATTER_FORWARD);
VecGetArray(W_SEQ,&_W);
pos = rint(delta2/delta1);
v = _W[pos];
v = v - delta1;
ierr = VecSetValues(W,1,&pos,&v,INSERT_VALUES);CHKERRQ(ierr);
if (rank==0) printf ("Correct an error of %d-th elements of vector W after MVM W=AP at iteration-%d\n", pos, i);
}
} else {
ierr = VecAYPX(W,beta/betaold,S);CHKERRQ(ierr); /* w <- Ap */
dpi = delta - beta*beta*dpiold/(betaold*betaold); /* dpi <- p'w */
/* Dingwen */
CKSW1 = beta/betaold*CKSW1 + CKSS1; /* Update checksum1(W) = checksum1(S) + beta/betaold*checksum1(W); */
CKSW2 = beta/betaold*CKSW2 + CKSS2; /* Update checksum2(W) = checksum2(S) + beta/betaold*checksum2(W); */
/* Dingwen */
}
betaold = beta;
KSPCheckDot(ksp,beta);
if ((dpi == 0.0) || ((i > 0) && (PetscRealPart(dpi*dpiold) <= 0.0))) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite matrix\n");CHKERRQ(ierr);
break;
}
a = beta/dpi; /* a = beta/p'w */
if (eigs) d[i] = PetscSqrtReal(PetscAbsScalar(b))*e[i] + 1.0/a;
ierr = VecAXPY(X,a,P);CHKERRQ(ierr); /* x <- x + ap */
/* Dingwen */
CKSX1 = CKSX1 + a*CKSP1; /* Update checksum1(X) = checksum1(X) + a*checksum1(P); */
CKSX2 = CKSX2 + a*CKSP2; /* Update checksum2(X) = checksum2(X) + a*checksum2(P); */
/* Dingwen */
ierr = VecAXPY(R,-a,W);CHKERRQ(ierr); /* r <- r - aw */
/* Dingwen */
CKSR1 = CKSR1 - a*CKSW1; /* Update checksum1(R) = checksum1(R) - a*checksum1(W); */
CKSR2 = CKSR2 - a*CKSW2; /* Update checksum2(R) = checksum2(R) - a*checksum2(W); */
/* Dingwen */
if (ksp->normtype == KSP_NORM_PRECONDITIONED && ksp->chknorm < i+2) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
/* Dingwen */
ierr = VecXDot(C1,Z, &CKSZ1);CHKERRQ(ierr); /* Update checksum1(Z) */
ierr = VecXDot(C2,Z, &CKSZ2);CHKERRQ(ierr); /* Update checksum2(Z) */
/* Dingwen */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr); /* MVM */
/* Dingwen */
ierr = VecXDot(CKSAmat1, Z, &CKSS1);CHKERRQ(ierr);
CKSS1 = CKSS1 + d1*CKSZ1 + d2*CKSZ2; /* Update checksum1(S) = checksum1(A)Z + d1*chekcsum1(Z) + d2*checksum2(Z); */
ierr = VecXDot(CKSAmat2, Z, &CKSS2);CHKERRQ(ierr);
CKSS2 = CKSS2 + d2*CKSZ1 + d1*CKSZ2; /* Update checksum2(S) = checksum2(A)Z + d2*chekcsum1(Z) + d1*checksum2(Z); */
/* Dingwen */
}
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED && ksp->chknorm < i+2) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
/* Dingwen */
ierr = VecXDot(C1,Z, &CKSZ1);CHKERRQ(ierr); /* Update checksum1(Z) */
ierr = VecXDot(C2,Z, &CKSZ2);CHKERRQ(ierr); /* Update checksum2(Z) */
/* Dingwen */
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'*z */
}
KSPCheckDot(ksp,beta);
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else {
dp = 0.0;
}
ksp->rnorm = dp;
CHKERRQ(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 && (ksp->normtype != KSP_NORM_NATURAL)) || (ksp->chknorm >= i+2)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
/* Dingwen */
ierr = VecXDot(C1,Z, &CKSZ1);CHKERRQ(ierr); /* Update checksum1(Z) */
ierr = VecXDot(C2,Z, &CKSZ2);CHKERRQ(ierr); /* Update checksum2(Z) */
/* Dingwen */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
}
}
if ((ksp->normtype != KSP_NORM_NATURAL) || (ksp->chknorm >= i+2)) {
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
}
KSPCheckDot(ksp,beta);
}
i++;
/* Dingwen */
/* Inject error */
if ((i==50)&&(flag1))
{
pos = 1000;
v = -1;
ierr = VecSetValues(X,1,&pos,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(X);CHKERRQ(ierr);
ierr = VecAssemblyEnd(X);CHKERRQ(ierr);
flag1 = PETSC_FALSE;
if (rank==0)printf ("Inject an error in vector X at the end of iteration-%d\n", i-1);
}
/* Dingwen */
} while (i<ksp->max_it);
/* Dingwen */
ierr = VecXDot(C1,X,&sumX1);CHKERRQ(ierr);
ierr = VecXDot(C1,R,&sumR1);CHKERRQ(ierr);
ierr = VecXDot(C2,X,&sumX2);CHKERRQ(ierr);
ierr = VecXDot(C2,R,&sumR2);CHKERRQ(ierr);
if (rank==0)
{
printf ("sum1 of X = %f\n", sumX1);
printf ("checksum1(X) = %f\n", CKSX1);
printf ("sum2 of X = %f\n", sumX2);
printf ("checksum2(X) = %f\n", CKSX2);
printf ("sum1 of R = %f\n", sumR1);
printf ("checksum1(R) = %f\n", CKSR1);
printf ("sum2 of R = %f\n", sumR2);
printf ("checksum2(R) = %f\n", CKSR2);
}
VecDestroy(&W_SEQ);
VecScatterDestroy(&ctx);
/* Dingwen */
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
if (eigs) cg->ned = ksp->its;
PetscFunctionReturn(0);
}
PetscErrorCode NonlinearGS(SNES snes, Vec X, Vec B, void *ctx)
{
DMDALocalInfo info;
Field **x,**b;
PetscErrorCode ierr;
Vec localX, localB;
DM da;
PetscInt xints,xinte,yints,yinte,i,j,k,l;
PetscInt max_its,tot_its;
PetscInt sweeps;
PetscReal rtol,atol,stol;
PetscReal hx,hy,dhx,dhy,hxdhy,hydhx;
PetscReal grashof,prandtl,lid;
PetscScalar u,uxx,uyy,vx,vy,avx,avy,vxp,vxm,vyp,vym;
PetscScalar fu, fv, fomega, ftemp;
PetscScalar dfudu;
PetscScalar dfvdv;
PetscScalar dfodu, dfodv, dfodo;
PetscScalar dftdu, dftdv, dftdt;
PetscScalar yu=0, yv=0, yo=0, yt=0;
PetscScalar bjiu, bjiv, bjiomega, bjitemp;
PetscBool ptconverged;
PetscReal pfnorm,pfnorm0,pynorm,pxnorm;
AppCtx *user = (AppCtx*)ctx;
PetscFunctionBeginUser;
grashof = user->grashof;
prandtl = user->prandtl;
lid = user->lidvelocity;
tot_its = 0;
ierr = SNESNGSGetTolerances(snes,&rtol,&atol,&stol,&max_its);CHKERRQ(ierr);
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESGetDM(snes,(DM*)&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecGetArrayRead(da,localB,&b);CHKERRQ(ierr);
}
/* looks like a combination of the formfunction / formjacobian routines */
dhx = (PetscReal)(info.mx-1);dhy = (PetscReal)(info.my-1);
hx = 1.0/dhx; hy = 1.0/dhy;
hxdhy = hx*dhy; hydhx = hy*dhx;
xints = info.xs; xinte = info.xs+info.xm; yints = info.ys; yinte = info.ys+info.ym;
/* Set the boundary conditions on the momentum equations */
/* Test whether we are on the bottom edge of the global array */
if (yints == 0) {
j = 0;
yints = yints + 1;
/* bottom edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the top edge of the global array */
if (yinte == info.my) {
j = info.my - 1;
yinte = yinte - 1;
/* top edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = lid + bjiu;
x[j][i].v = bjiv;
}
}
/* Test whether we are on the left edge of the global array */
if (xints == 0) {
i = 0;
xints = xints + 1;
/* left edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the right edge of the global array */
if (xinte == info.mx) {
i = info.mx - 1;
xinte = xinte - 1;
/* right edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
for (k=0; k < sweeps; k++) {
for (j=info.ys; j<info.ys + info.ym; j++) {
for (i=info.xs; i<info.xs + info.xm; i++) {
ptconverged = PETSC_FALSE;
pfnorm0 = 0.0;
pfnorm = 0.0;
fu = 0.0;
fv = 0.0;
fomega = 0.0;
ftemp = 0.0;
for (l = 0; l < max_its && !ptconverged; l++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
bjiomega = b[j][i].omega;
bjitemp = b[j][i].temp;
} else {
bjiu = 0.0;
bjiv = 0.0;
bjiomega = 0.0;
bjitemp = 0.0;
}
if (i != 0 && i != info.mx - 1 && j != 0 && j != info.my-1) {
/* U velocity */
u = x[j][i].u;
uxx = (2.0*u - x[j][i-1].u - x[j][i+1].u)*hydhx;
uyy = (2.0*u - x[j-1][i].u - x[j+1][i].u)*hxdhy;
fu = uxx + uyy - .5*(x[j+1][i].omega-x[j-1][i].omega)*hx - bjiu;
dfudu = 2.0*(hydhx + hxdhy);
/* V velocity */
u = x[j][i].v;
uxx = (2.0*u - x[j][i-1].v - x[j][i+1].v)*hydhx;
uyy = (2.0*u - x[j-1][i].v - x[j+1][i].v)*hxdhy;
fv = uxx + uyy + .5*(x[j][i+1].omega-x[j][i-1].omega)*hy - bjiv;
dfvdv = 2.0*(hydhx + hxdhy);
/*
convective coefficients for upwinding
*/
vx = x[j][i].u; avx = PetscAbsScalar(vx);
vxp = .5*(vx+avx); vxm = .5*(vx-avx);
vy = x[j][i].v; avy = PetscAbsScalar(vy);
vyp = .5*(vy+avy); vym = .5*(vy-avy);
/* Omega */
u = x[j][i].omega;
uxx = (2.0*u - x[j][i-1].omega - x[j][i+1].omega)*hydhx;
uyy = (2.0*u - x[j-1][i].omega - x[j+1][i].omega)*hxdhy;
fomega = uxx + uyy + (vxp*(u - x[j][i-1].omega) + vxm*(x[j][i+1].omega - u))*hy +
(vyp*(u - x[j-1][i].omega) + vym*(x[j+1][i].omega - u))*hx -
.5*grashof*(x[j][i+1].temp - x[j][i-1].temp)*hy - bjiomega;
/* convective coefficient derivatives */
dfodo = 2.0*(hydhx + hxdhy) + ((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dfodu = (u - x[j][i-1].omega)*hy;
else dfodu = (x[j][i+1].omega - u)*hy;
if (PetscRealPart(vy) > 0.0) dfodv = (u - x[j-1][i].omega)*hx;
else dfodv = (x[j+1][i].omega - u)*hx;
/* Temperature */
u = x[j][i].temp;
uxx = (2.0*u - x[j][i-1].temp - x[j][i+1].temp)*hydhx;
uyy = (2.0*u - x[j-1][i].temp - x[j+1][i].temp)*hxdhy;
ftemp = uxx + uyy + prandtl*((vxp*(u - x[j][i-1].temp) + vxm*(x[j][i+1].temp - u))*hy +
(vyp*(u - x[j-1][i].temp) + vym*(x[j+1][i].temp - u))*hx) - bjitemp;
dftdt = 2.0*(hydhx + hxdhy) + prandtl*((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dftdu = prandtl*(u - x[j][i-1].temp)*hy;
else dftdu = prandtl*(x[j][i+1].temp - u)*hy;
if (PetscRealPart(vy) > 0.0) dftdv = prandtl*(u - x[j-1][i].temp)*hx;
else dftdv = prandtl*(x[j+1][i].temp - u)*hx;
/* invert the system:
[ dfu / du 0 0 0 ][yu] = [fu]
[ 0 dfv / dv 0 0 ][yv] [fv]
[ dfo / du dfo / dv dfo / do 0 ][yo] [fo]
[ dft / du dft / dv 0 dft / dt ][yt] [ft]
by simple back-substitution
*/
yu = fu / dfudu;
yv = fv / dfvdv;
yo = fomega / dfodo;
yt = ftemp / dftdt;
yo = (fomega - (dfodu*yu + dfodv*yv)) / dfodo;
yt = (ftemp - (dftdu*yu + dftdv*yv)) / dftdt;
x[j][i].u = x[j][i].u - yu;
x[j][i].v = x[j][i].v - yv;
x[j][i].temp = x[j][i].temp - yt;
x[j][i].omega = x[j][i].omega - yo;
}
if (i == 0) {
fomega = x[j][i].omega - (x[j][i+1].v - x[j][i].v)*dhx - bjiomega;
ftemp = x[j][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (i == info.mx - 1) {
fomega = x[j][i].omega - (x[j][i].v - x[j][i-1].v)*dhx - bjiomega;
ftemp = x[j][i].temp - (PetscReal)(grashof>0) - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == 0) {
fomega = x[j][i].omega + (x[j+1][i].u - x[j][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j+1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == info.my - 1) {
fomega = x[j][i].omega + (x[j][i].u - x[j-1][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j-1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
tot_its++;
pfnorm = PetscRealPart(fu*fu + fv*fv + fomega*fomega + ftemp*ftemp);
pfnorm = PetscSqrtReal(pfnorm);
pynorm = PetscRealPart(yu*yu + yv*yv + yo*yo + yt*yt);
pfnorm = PetscSqrtReal(pynorm);
pxnorm = PetscRealPart(x[j][i].u*x[j][i].u + x[j][i].v*x[j][i].v + x[j][i].omega*x[j][i].omega + x[j][i].temp*x[j][i].temp);
pxnorm = PetscSqrtReal(pxnorm);
if (l == 0) pfnorm0 = pfnorm;
if (rtol*pfnorm0 > pfnorm ||
atol > pfnorm ||
pxnorm*stol > pynorm) ptconverged = PETSC_TRUE;
}
}
}
}
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArrayRead(da,localB,&b);CHKERRQ(ierr);
}
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = PetscLogFlops(tot_its*(84.0 + 41.0 + 26.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
IFunction - Evaluates nonlinear function, F(U).
Input Parameters:
. ts - the TS context
. U - input vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. F - function vector
*/
PetscErrorCode IFunction(TS ts,PetscReal ftime,Vec U,Vec Udot,Vec F,void *ptr)
{
AppCtx *appctx = (AppCtx*)ptr;
DM da;
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx,sx;
PetscScalar rho,c,rhoxx,cxx,cx,rhox,kcxrhox;
Field *u,*f,*udot;
Vec localU;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
if (!xs) {
f[0].rho = udot[0].rho; /* u[0].rho - 0.0; */
f[0].c = udot[0].c; /* u[0].c - 1.0; */
xs++;
xm--;
}
if (xs+xm == Mx) {
f[Mx-1].rho = udot[Mx-1].rho; /* u[Mx-1].rho - 1.0; */
f[Mx-1].c = udot[Mx-1].c; /* u[Mx-1].c - 0.0; */
xm--;
}
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
rho = u[i].rho;
rhoxx = (-2.0*rho + u[i-1].rho + u[i+1].rho)*sx;
c = u[i].c;
cxx = (-2.0*c + u[i-1].c + u[i+1].c)*sx;
if (!appctx->upwind) {
rhox = .5*(u[i+1].rho - u[i-1].rho)/hx;
cx = .5*(u[i+1].c - u[i-1].c)/hx;
kcxrhox = appctx->kappa*(cxx*rho + cx*rhox);
} else {
kcxrhox = appctx->kappa*((u[i+1].c - u[i].c)*u[i+1].rho - (u[i].c - u[i-1].c)*u[i].rho)*sx;
}
f[i].rho = udot[i].rho - appctx->epsilon*rhoxx + kcxrhox - appctx->mu*PetscAbsScalar(rho)*(1.0 - rho)*PetscMax(0,PetscRealPart(c - appctx->cstar)) + appctx->beta*rho;
f[i].c = udot[i].c - appctx->delta*cxx + appctx->lambda*c + appctx->alpha*rho*c/(appctx->gamma + c);
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_Jacobi(PC pc)
{
PC_Jacobi *jac = (PC_Jacobi*)pc->data;
Vec diag,diagsqrt;
PetscErrorCode ierr;
PetscInt n,i;
PetscScalar *x;
PetscBool zeroflag = PETSC_FALSE;
PetscFunctionBegin;
/*
For most preconditioners the code would begin here something like
if (pc->setupcalled == 0) { allocate space the first time this is ever called
ierr = MatCreateVecs(pc->mat,&jac->diag);CHKERRQ(ierr);
PetscLogObjectParent((PetscObject)pc,(PetscObject)jac->diag);
}
But for this preconditioner we want to support use of both the matrix' diagonal
elements (for left or right preconditioning) and square root of diagonal elements
(for symmetric preconditioning). Hence we do not allocate space here, since we
don't know at this point which will be needed (diag and/or diagsqrt) until the user
applies the preconditioner, and we don't want to allocate BOTH unless we need
them both. Thus, the diag and diagsqrt are allocated in PCSetUp_Jacobi_NonSymmetric()
and PCSetUp_Jacobi_Symmetric(), respectively.
*/
/*
Here we set up the preconditioner; that is, we copy the diagonal values from
the matrix and put them into a format to make them quick to apply as a preconditioner.
*/
diag = jac->diag;
diagsqrt = jac->diagsqrt;
if (diag) {
if (jac->userowmax) {
ierr = MatGetRowMaxAbs(pc->pmat,diag,NULL);CHKERRQ(ierr);
} else if (jac->userowsum) {
ierr = MatGetRowSum(pc->pmat,diag);CHKERRQ(ierr);
} else {
ierr = MatGetDiagonal(pc->pmat,diag);CHKERRQ(ierr);
}
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecGetLocalSize(diag,&n);CHKERRQ(ierr);
ierr = VecGetArray(diag,&x);CHKERRQ(ierr);
if (jac->useabs) {
for (i=0; i<n; i++) x[i] = PetscAbsScalar(x[i]);
}
for (i=0; i<n; i++) {
if (x[i] == 0.0) {
x[i] = 1.0;
zeroflag = PETSC_TRUE;
}
}
ierr = VecRestoreArray(diag,&x);CHKERRQ(ierr);
}
if (diagsqrt) {
if (jac->userowmax) {
ierr = MatGetRowMaxAbs(pc->pmat,diagsqrt,NULL);CHKERRQ(ierr);
} else if (jac->userowsum) {
ierr = MatGetRowSum(pc->pmat,diagsqrt);CHKERRQ(ierr);
} else {
ierr = MatGetDiagonal(pc->pmat,diagsqrt);CHKERRQ(ierr);
}
ierr = VecGetLocalSize(diagsqrt,&n);CHKERRQ(ierr);
ierr = VecGetArray(diagsqrt,&x);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (x[i] != 0.0) x[i] = 1.0/PetscSqrtReal(PetscAbsScalar(x[i]));
else {
x[i] = 1.0;
zeroflag = PETSC_TRUE;
}
}
ierr = VecRestoreArray(diagsqrt,&x);CHKERRQ(ierr);
}
if (zeroflag) {
ierr = PetscInfo(pc,"Zero detected in diagonal of matrix, using 1 at those locations\n");CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
EXTERN_C_END
/* -------------------------------------------------------------------------- */
/*
PCSetUp_Jacobi - Prepares for the use of the Jacobi preconditioner
by setting data structures and options.
Input Parameter:
. pc - the preconditioner context
Application Interface Routine: PCSetUp()
Notes:
The interface routine PCSetUp() is not usually called directly by
the user, but instead is called by PCApply() if necessary.
*/
#undef __FUNCT__
#define __FUNCT__ "PCSetUp_Jacobi"
static PetscErrorCode PCSetUp_Jacobi(PC pc)
{
PC_Jacobi *jac = (PC_Jacobi*)pc->data;
Vec diag,diagsqrt;
PetscErrorCode ierr;
PetscInt n,i;
PetscScalar *x;
PetscBool zeroflag = PETSC_FALSE;
PetscFunctionBegin;
/*
For most preconditioners the code would begin here something like
if (pc->setupcalled == 0) { allocate space the first time this is ever called
ierr = MatGetVecs(pc->mat,&jac->diag);CHKERRQ(ierr);
PetscLogObjectParent(pc,jac->diag);
}
But for this preconditioner we want to support use of both the matrix' diagonal
elements (for left or right preconditioning) and square root of diagonal elements
(for symmetric preconditioning). Hence we do not allocate space here, since we
don't know at this point which will be needed (diag and/or diagsqrt) until the user
applies the preconditioner, and we don't want to allocate BOTH unless we need
them both. Thus, the diag and diagsqrt are allocated in PCSetUp_Jacobi_NonSymmetric()
and PCSetUp_Jacobi_Symmetric(), respectively.
*/
/*
Here we set up the preconditioner; that is, we copy the diagonal values from
the matrix and put them into a format to make them quick to apply as a preconditioner.
*/
diag = jac->diag;
diagsqrt = jac->diagsqrt;
if (diag) {
if (jac->userowmax) {
ierr = MatGetRowMaxAbs(pc->pmat,diag,PETSC_NULL);CHKERRQ(ierr);
} else if (jac->userowsum) {
ierr = MatGetRowSum(pc->pmat,diag);CHKERRQ(ierr);
} else {
ierr = MatGetDiagonal(pc->pmat,diag);CHKERRQ(ierr);
}
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecGetLocalSize(diag,&n);CHKERRQ(ierr);
ierr = VecGetArray(diag,&x);CHKERRQ(ierr);
if (jac->useabs) {
for (i=0; i<n; i++) {
x[i] = PetscAbsScalar(x[i]);
}
}
for (i=0; i<n; i++) {
if (x[i] == 0.0) {
x[i] = 1.0;
zeroflag = PETSC_TRUE;
}
}
ierr = VecRestoreArray(diag,&x);CHKERRQ(ierr);
}
if (diagsqrt) {
if (jac->userowmax) {
ierr = MatGetRowMaxAbs(pc->pmat,diagsqrt,PETSC_NULL);CHKERRQ(ierr);
} else if (jac->userowsum) {
ierr = MatGetRowSum(pc->pmat,diagsqrt);CHKERRQ(ierr);
} else {
ierr = MatGetDiagonal(pc->pmat,diagsqrt);CHKERRQ(ierr);
}
ierr = VecGetLocalSize(diagsqrt,&n);CHKERRQ(ierr);
ierr = VecGetArray(diagsqrt,&x);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (x[i] != 0.0) x[i] = 1.0/PetscSqrtReal(PetscAbsScalar(x[i]));
else {
x[i] = 1.0;
zeroflag = PETSC_TRUE;
}
}
ierr = VecRestoreArray(diagsqrt,&x);CHKERRQ(ierr);
}
if (zeroflag) {
ierr = PetscInfo(pc,"Zero detected in diagonal of matrix, using 1 at those locations\n");CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_GROPPCG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar alpha,beta = 0.0,gamma,gammaNew,t;
PetscReal dp = 0.0;
Vec x,b,r,p,s,S,z,Z;
Mat Amat,Pmat;
MatStructure pflag;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
x = ksp->vec_sol;
b = ksp->vec_rhs;
r = ksp->work[0];
p = ksp->work[1];
s = ksp->work[2];
S = ksp->work[3];
z = ksp->work[4];
Z = ksp->work[5];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,x,r);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(r,-1.0,b);CHKERRQ(ierr);
} else {
ierr = VecCopy(b,r);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,r,z);CHKERRQ(ierr); /* z <- Br */
ierr = VecCopy(z,p);CHKERRQ(ierr); /* p <- z */
ierr = VecDotBegin(r,z,&gamma);CHKERRQ(ierr); /* gamma <- z'*r */
ierr = PetscCommSplitReductionBegin(((PetscObject)r)->comm);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,p,s);CHKERRQ(ierr); /* s <- Ap */
ierr = VecDotEnd(r,z,&gamma);CHKERRQ(ierr); /* gamma <- z'*r */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
/* This could be merged with the computation of gamma above */
ierr = VecNorm(z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
/* This could be merged with the computation of gamma above */
ierr = VecNorm(r,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
if (PetscIsInfOrNanScalar(gamma)) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
KSPLogResidualHistory(ksp,dp);
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;
i++;
ierr = VecDotBegin(p,s,&t);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(((PetscObject)p)->comm);CHKERRQ(ierr);
ierr = KSP_PCApply(ksp,s,S);CHKERRQ(ierr); /* S <- Bs */
ierr = VecDotEnd(p,s,&t);CHKERRQ(ierr);
alpha = gamma / t;
ierr = VecAXPY(x, alpha,p);CHKERRQ(ierr); /* x <- x + alpha * p */
ierr = VecAXPY(r,-alpha,s);CHKERRQ(ierr); /* r <- r - alpha * s */
ierr = VecAXPY(z,-alpha,S);CHKERRQ(ierr); /* z <- z - alpha * S */
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormBegin(r,NORM_2,&dp);CHKERRQ(ierr);
} else if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormBegin(z,NORM_2,&dp);CHKERRQ(ierr);
}
ierr = VecDotBegin(r,z,&gammaNew);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(((PetscObject)r)->comm);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,z,Z);CHKERRQ(ierr); /* Z <- Az */
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormEnd(r,NORM_2,&dp);CHKERRQ(ierr);
} else if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormEnd(z,NORM_2,&dp);CHKERRQ(ierr);
}
ierr = VecDotEnd(r,z,&gammaNew);CHKERRQ(ierr);
if (ksp->normtype == KSP_NORM_NATURAL) {
if (PetscIsInfOrNanScalar(gammaNew)) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = PetscSqrtReal(PetscAbsScalar(gammaNew)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
} else if (ksp->normtype == KSP_NORM_NONE) {
dp = 0.0;
}
ksp->rnorm = dp;
KSPLogResidualHistory(ksp,dp);
ierr = KSPMonitor(ksp,i,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
beta = gammaNew / gamma;
gamma = gammaNew;
ierr = VecAYPX(p,beta,z);CHKERRQ(ierr); /* p <- z + beta * p */
ierr = VecAYPX(s,beta,Z);CHKERRQ(ierr); /* s <- Z + beta * s */
} while (i<ksp->max_it);
if (i >= ksp->max_it) {
ksp->reason = KSP_DIVERGED_ITS;
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPFGMRESCycle(PetscInt *itcount,KSP ksp)
{
KSP_FGMRES *fgmres = (KSP_FGMRES *)(ksp->data);
PetscReal res_norm;
PetscReal hapbnd,tt;
PetscBool hapend = PETSC_FALSE; /* indicates happy breakdown ending */
PetscErrorCode ierr;
PetscInt loc_it; /* local count of # of dir. in Krylov space */
PetscInt max_k = fgmres->max_k; /* max # of directions Krylov space */
Mat Amat,Pmat;
MatStructure pflag;
PetscFunctionBegin;
/* Number of pseudo iterations since last restart is the number
of prestart directions */
loc_it = 0;
/* note: (fgmres->it) is always set one less than (loc_it) It is used in
KSPBUILDSolution_FGMRES, where it is passed to KSPFGMRESBuildSoln.
Note that when KSPFGMRESBuildSoln is called from this function,
(loc_it -1) is passed, so the two are equivalent */
fgmres->it = (loc_it - 1);
/* initial residual is in VEC_VV(0) - compute its norm*/
ierr = VecNorm(VEC_VV(0),NORM_2,&res_norm);CHKERRQ(ierr);
/* first entry in right-hand-side of hessenberg system is just
the initial residual norm */
*RS(0) = res_norm;
ksp->rnorm = res_norm;
KSPLogResidualHistory(ksp,res_norm);
/* check for the convergence - maybe the current guess is good enough */
ierr = (*ksp->converged)(ksp,ksp->its,res_norm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) {
if (itcount) *itcount = 0;
PetscFunctionReturn(0);
}
/* scale VEC_VV (the initial residual) */
ierr = VecScale(VEC_VV(0),1.0/res_norm);CHKERRQ(ierr);
/* MAIN ITERATION LOOP BEGINNING*/
/* keep iterating until we have converged OR generated the max number
of directions OR reached the max number of iterations for the method */
while (!ksp->reason && loc_it < max_k && ksp->its < ksp->max_it) {
if (loc_it) KSPLogResidualHistory(ksp,res_norm);
fgmres->it = (loc_it - 1);
ierr = KSPMonitor(ksp,ksp->its,res_norm);CHKERRQ(ierr);
/* see if more space is needed for work vectors */
if (fgmres->vv_allocated <= loc_it + VEC_OFFSET + 1) {
ierr = KSPFGMRESGetNewVectors(ksp,loc_it+1);CHKERRQ(ierr);
/* (loc_it+1) is passed in as number of the first vector that should
be allocated */
}
/* CHANGE THE PRECONDITIONER? */
/* ModifyPC is the callback function that can be used to
change the PC or its attributes before its applied */
(*fgmres->modifypc)(ksp,ksp->its,loc_it,res_norm,fgmres->modifyctx);
/* apply PRECONDITIONER to direction vector and store with
preconditioned vectors in prevec */
ierr = KSP_PCApply(ksp,VEC_VV(loc_it),PREVEC(loc_it));CHKERRQ(ierr);
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
/* Multiply preconditioned vector by operator - put in VEC_VV(loc_it+1) */
ierr = MatMult(Amat,PREVEC(loc_it),VEC_VV(1+loc_it));CHKERRQ(ierr);
/* update hessenberg matrix and do Gram-Schmidt - new direction is in
VEC_VV(1+loc_it)*/
ierr = (*fgmres->orthog)(ksp,loc_it);CHKERRQ(ierr);
/* new entry in hessenburg is the 2-norm of our new direction */
ierr = VecNorm(VEC_VV(loc_it+1),NORM_2,&tt);CHKERRQ(ierr);
*HH(loc_it+1,loc_it) = tt;
*HES(loc_it+1,loc_it) = tt;
/* Happy Breakdown Check */
hapbnd = PetscAbsScalar((tt) / *RS(loc_it));
/* RS(loc_it) contains the res_norm from the last iteration */
hapbnd = PetscMin(fgmres->haptol,hapbnd);
if (tt > hapbnd) {
/* scale new direction by its norm */
ierr = VecScale(VEC_VV(loc_it+1),1.0/tt);CHKERRQ(ierr);
} else {
/* This happens when the solution is exactly reached. */
/* So there is no new direction... */
ierr = VecSet(VEC_TEMP,0.0);CHKERRQ(ierr); /* set VEC_TEMP to 0 */
hapend = PETSC_TRUE;
}
/* note that for FGMRES we could get HES(loc_it+1, loc_it) = 0 and the
current solution would not be exact if HES was singular. Note that
HH non-singular implies that HES is no singular, and HES is guaranteed
to be nonsingular when PREVECS are linearly independent and A is
nonsingular (in GMRES, the nonsingularity of A implies the nonsingularity
of HES). So we should really add a check to verify that HES is nonsingular.*/
/* Now apply rotations to new col of hessenberg (and right side of system),
calculate new rotation, and get new residual norm at the same time*/
ierr = KSPFGMRESUpdateHessenberg(ksp,loc_it,hapend,&res_norm);CHKERRQ(ierr);
if (ksp->reason) break;
loc_it++;
fgmres->it = (loc_it-1); /* Add this here in case it has converged */
ierr = PetscObjectTakeAccess(ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = res_norm;
ierr = PetscObjectGrantAccess(ksp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its,res_norm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
/* Catch error in happy breakdown and signal convergence and break from loop */
if (hapend) {
if (!ksp->reason) {
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_PLIB,"You reached the happy break down,but convergence was not indicated.");
}
break;
}
}
/* END OF ITERATION LOOP */
KSPLogResidualHistory(ksp,res_norm);
/*
Monitor if we know that we will not return for a restart */
if (ksp->reason || ksp->its >= ksp->max_it) {
ierr = KSPMonitor(ksp,ksp->its,res_norm);CHKERRQ(ierr);
}
if (itcount) *itcount = loc_it;
/*
Down here we have to solve for the "best" coefficients of the Krylov
columns, add the solution values together, and possibly unwind the
preconditioning from the solution
*/
/* Form the solution (or the solution so far) */
/* Note: must pass in (loc_it-1) for iteration count so that KSPFGMRESBuildSoln
properly navigates */
ierr = KSPFGMRESBuildSoln(RS(0),ksp->vec_sol,ksp->vec_sol,ksp,loc_it-1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_CR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i = 0;
MatStructure pflag;
PetscReal dp;
PetscScalar ai, bi;
PetscScalar apq,btop, bbot;
Vec X,B,R,RT,P,AP,ART,Q;
Mat Amat, Pmat;
PetscFunctionBegin;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
RT = ksp->work[1];
P = ksp->work[2];
AP = ksp->work[3];
ART = ksp->work[4];
Q = ksp->work[5];
/* R is the true residual norm, RT is the preconditioned residual norm */
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* R <- A*X */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* R <- B-R == B-A*X */
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* R <- B (X is 0) */
}
ierr = KSP_PCApply(ksp,R,P);CHKERRQ(ierr); /* P <- B*R */
ierr = KSP_MatMult(ksp,Amat,P,AP);CHKERRQ(ierr); /* AP <- A*P */
ierr = VecCopy(P,RT);CHKERRQ(ierr); /* RT <- P */
ierr = VecCopy(AP,ART);CHKERRQ(ierr); /* ART <- AP */
ierr = VecDotBegin(RT,ART,&btop);CHKERRQ(ierr); /* (RT,ART) */
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormBegin(RT,NORM_2,&dp);CHKERRQ(ierr); /* dp <- RT'*RT */
ierr = VecDotEnd (RT,ART,&btop);CHKERRQ(ierr); /* (RT,ART) */
ierr = VecNormEnd (RT,NORM_2,&dp);CHKERRQ(ierr); /* dp <- RT'*RT */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormBegin(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- R'*R */
ierr = VecDotEnd (RT,ART,&btop);CHKERRQ(ierr); /* (RT,ART) */
ierr = VecNormEnd (R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- RT'*RT */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = VecDotEnd (RT,ART,&btop);CHKERRQ(ierr); /* (RT,ART) */
dp = PetscSqrtReal(PetscAbsScalar(btop)); /* dp = sqrt(R,AR) */
}
if (PetscAbsScalar(btop) < 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite matrix\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ksp->its = 0;
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
i = 0;
do {
ierr = KSP_PCApply(ksp,AP,Q);CHKERRQ(ierr); /* Q <- B* AP */
ierr = VecDot(AP,Q,&apq);CHKERRQ(ierr);
if (PetscRealPart(apq) <= 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo(ksp,"KSPSolve_CR:diverging due to indefinite or negative definite PC\n");CHKERRQ(ierr);
break;
}
ai = btop/apq; /* ai = (RT,ART)/(AP,Q) */
ierr = VecAXPY(X,ai,P);CHKERRQ(ierr); /* X <- X + ai*P */
ierr = VecAXPY(RT,-ai,Q);CHKERRQ(ierr); /* RT <- RT - ai*Q */
ierr = KSP_MatMult(ksp,Amat,RT,ART);CHKERRQ(ierr); /* ART <- A*RT */
bbot = btop;
ierr = VecDotBegin(RT,ART,&btop);CHKERRQ(ierr);
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormBegin(RT,NORM_2,&dp);CHKERRQ(ierr); /* dp <- || RT || */
ierr = VecDotEnd (RT,ART,&btop);CHKERRQ(ierr);
ierr = VecNormEnd (RT,NORM_2,&dp);CHKERRQ(ierr); /* dp <- || RT || */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = VecDotEnd(RT,ART,&btop);CHKERRQ(ierr);
dp = PetscSqrtReal(PetscAbsScalar(btop)); /* dp = sqrt(R,AR) */
} else if (ksp->normtype == KSP_NORM_NONE) {
ierr = VecDotEnd(RT,ART,&btop);CHKERRQ(ierr);
dp = 0.0;
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecAXPY(R,ai,AP);CHKERRQ(ierr); /* R <- R - ai*AP */
ierr = VecNormBegin(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- R'*R */
ierr = VecDotEnd (RT,ART,&btop);CHKERRQ(ierr);
ierr = VecNormEnd (R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- R'*R */
} else SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSPNormType of %d not supported",(int)ksp->normtype);
if (PetscAbsScalar(btop) < 0.0) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite PC\n");CHKERRQ(ierr);
break;
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = dp;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
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;
bi = btop/bbot;
ierr = VecAYPX(P,bi,RT);CHKERRQ(ierr); /* P <- RT + Bi P */
ierr = VecAYPX(AP,bi,ART);CHKERRQ(ierr); /* AP <- ART + Bi AP */
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPAGMRESBuildSoln(KSP ksp,PetscInt it)
{
KSP_AGMRES *agmres = (KSP_AGMRES*)ksp->data;
PetscErrorCode ierr;
PetscInt max_k = agmres->max_k; /* Size of the non-augmented Krylov basis */
PetscInt i, j;
PetscInt r = agmres->r; /* current number of augmented eigenvectors */
PetscBLASInt KspSize;
PetscBLASInt lC;
PetscBLASInt N;
PetscBLASInt ldH = N + 1;
PetscBLASInt lwork;
PetscBLASInt info, nrhs = 1;
PetscFunctionBegin;
ierr = PetscBLASIntCast(KSPSIZE,&KspSize);CHKERRQ(ierr);
ierr = PetscBLASIntCast(4 * (KspSize+1),&lwork);CHKERRQ(ierr);
ierr = PetscBLASIntCast(KspSize+1,&lC);CHKERRQ(ierr);
ierr = PetscBLASIntCast(MAXKSPSIZE + 1,&N);CHKERRQ(ierr);
ierr = PetscBLASIntCast(N + 1,&ldH);CHKERRQ(ierr);
/* Save a copy of the Hessenberg matrix */
for (j = 0; j < N-1; j++) {
for (i = 0; i < N; i++) {
*HS(i,j) = *H(i,j);
}
}
/* QR factorize the Hessenberg matrix */
#if defined(PETSC_MISSING_LAPACK_GEQRF)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEQRF - Lapack routine is unavailable.");
#else
PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&lC, &KspSize, agmres->hh_origin, &ldH, agmres->tau, agmres->work, &lwork, &info));
if (info) SETERRQ1(PetscObjectComm((PetscObject)ksp), PETSC_ERR_LIB,"Error in LAPACK routine XGEQRF INFO=%d", info);
#endif
/* Update the right hand side of the least square problem */
ierr = PetscMemzero(agmres->nrs, N*sizeof(PetscScalar));CHKERRQ(ierr);
agmres->nrs[0] = ksp->rnorm;
#if defined(PETSC_MISSING_LAPACK_ORMQR)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEQRF - Lapack routine is unavailable.");
#else
PetscStackCallBLAS("LAPACKormqr",LAPACKormqr_("L", "T", &lC, &nrhs, &KspSize, agmres->hh_origin, &ldH, agmres->tau, agmres->nrs, &N, agmres->work, &lwork, &info));
if (info) SETERRQ1(PetscObjectComm((PetscObject)ksp), PETSC_ERR_LIB,"Error in LAPACK routine XORMQR INFO=%d",info);
#endif
ksp->rnorm = PetscAbsScalar(agmres->nrs[KspSize]);
/* solve the least-square problem */
#if defined(PETSC_MISSING_LAPACK_TRTRS)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"TRTRS - Lapack routine is unavailable.");
#else
PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U", "N", "N", &KspSize, &nrhs, agmres->hh_origin, &ldH, agmres->nrs, &N, &info));
if (info) SETERRQ1(PetscObjectComm((PetscObject)ksp), PETSC_ERR_LIB,"Error in LAPACK routine XTRTRS INFO=%d",info);
#endif
/* Accumulate the correction to the solution of the preconditioned problem in VEC_TMP */
ierr = VecZeroEntries(VEC_TMP);CHKERRQ(ierr);
ierr = VecMAXPY(VEC_TMP, max_k, agmres->nrs, &VEC_V(0));CHKERRQ(ierr);
if (!agmres->DeflPrecond) { ierr = VecMAXPY(VEC_TMP, r, &agmres->nrs[max_k], agmres->U);CHKERRQ(ierr); }
if ((ksp->pc_side == PC_RIGHT) && agmres->r && agmres->DeflPrecond) {
ierr = KSPDGMRESApplyDeflation_DGMRES(ksp, VEC_TMP, VEC_TMP_MATOP);CHKERRQ(ierr);
ierr = VecCopy(VEC_TMP_MATOP, VEC_TMP);CHKERRQ(ierr);
}
ierr = KSPUnwindPreconditioner(ksp, VEC_TMP, VEC_TMP_MATOP);CHKERRQ(ierr);
/* add the solution to the previous one */
ierr = VecAXPY(ksp->vec_sol, 1.0, VEC_TMP);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCGAMGGraph_Classical(PC pc,const Mat A,Mat *G)
{
PetscInt s,f,idx;
PetscInt r,c,ncols;
const PetscInt *rcol;
const PetscScalar *rval;
PetscInt *gcol;
PetscScalar *gval;
PetscReal rmax;
PetscInt ncolstotal,cmax = 0;
PC_MG *mg;
PC_GAMG *gamg;
PetscErrorCode ierr;
PetscInt *gsparse,*lsparse;
PetscScalar *Amax;
Mat lA,gA;
MatType mtype;
PetscFunctionBegin;
mg = (PC_MG *)pc->data;
gamg = (PC_GAMG *)mg->innerctx;
ierr = MatGetOwnershipRange(A,&s,&f);CHKERRQ(ierr);
ierr = PCGAMGClassicalGraphSplitting_Private(A,&lA,&gA);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*(f - s),&lsparse);CHKERRQ(ierr);
if (gA) {ierr = PetscMalloc(sizeof(PetscInt)*(f - s),&gsparse);CHKERRQ(ierr);}
else {
gsparse = NULL;
}
ierr = PetscMalloc(sizeof(PetscScalar)*(f - s),&Amax);CHKERRQ(ierr);
for (r = 0;r < f-s;r++) {
lsparse[r] = 0;
if (gsparse) gsparse[r] = 0;
}
for (r = 0;r < f-s;r++) {
/* determine the maximum off-diagonal in each row */
rmax = 0.;
ierr = MatGetRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
ncolstotal = ncols;
for (c = 0; c < ncols; c++) {
if (PetscAbsScalar(rval[c]) > rmax && rcol[c] != r) {
rmax = PetscAbsScalar(rval[c]);
}
}
ierr = MatRestoreRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
if (gA) {
ierr = MatGetRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
ncolstotal += ncols;
for (c = 0; c < ncols; c++) {
if (PetscAbsScalar(rval[c]) > rmax) {
rmax = PetscAbsScalar(rval[c]);
}
}
ierr = MatRestoreRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
}
Amax[r] = rmax;
if (ncolstotal > cmax) cmax = ncolstotal;
ierr = MatGetRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
idx = 0;
/* create the local and global sparsity patterns */
for (c = 0; c < ncols; c++) {
if (PetscAbsScalar(rval[c]) > gamg->threshold*PetscRealPart(Amax[r])) {
idx++;
}
}
ierr = MatRestoreRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
lsparse[r] = idx;
if (gA) {
idx = 0;
ierr = MatGetRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
for (c = 0; c < ncols; c++) {
if (PetscAbsScalar(rval[c]) > gamg->threshold*PetscRealPart(Amax[r])) {
idx++;
}
}
ierr = MatRestoreRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
gsparse[r] = idx;
}
}
ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&gval);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*cmax,&gcol);CHKERRQ(ierr);
ierr = MatCreate(PetscObjectComm((PetscObject)A),G); CHKERRQ(ierr);
ierr = MatGetType(A,&mtype);CHKERRQ(ierr);
ierr = MatSetType(*G,mtype);CHKERRQ(ierr);
ierr = MatSetSizes(*G,f-s,f-s,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(*G,0,lsparse,0,gsparse);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(*G,0,lsparse);CHKERRQ(ierr);
for (r = s;r < f;r++) {
ierr = MatGetRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
idx = 0;
for (c = 0; c < ncols; c++) {
/* classical strength of connection */
if (PetscAbsScalar(rval[c]) > gamg->threshold*PetscRealPart(Amax[r-s])) {
gcol[idx] = rcol[c];
gval[idx] = rval[c];
idx++;
}
}
ierr = MatSetValues(*G,1,&r,idx,gcol,gval,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(*G, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(*G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree(gval);CHKERRQ(ierr);
ierr = PetscFree(gcol);CHKERRQ(ierr);
ierr = PetscFree(lsparse);CHKERRQ(ierr);
ierr = PetscFree(gsparse);CHKERRQ(ierr);
ierr = PetscFree(Amax);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_PIPEFCG(KSP ksp)
{
PetscErrorCode ierr;
KSP_PIPEFCG *pipefcg;
PetscScalar gamma;
PetscReal dp=0.0;
Vec B,R,Z,X;
Mat Amat,Pmat;
#define VecXDot(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDot (x,y,a) : VecTDot (x,y,a))
PetscFunctionBegin;
pipefcg = (KSP_PIPEFCG*)ksp->data;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
/* Compute initial residual needed for convergence check*/
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* r <- b - Ax */
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- dqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecXDot(Z,R,&gamma);CHKERRQ(ierr);
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Initial Convergence Check */
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
if (ksp->normtype == KSP_NORM_NONE) {
ierr = KSPConvergedSkip (ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
} else {
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
}
if (ksp->reason) PetscFunctionReturn(0);
do {
/* A cycle is broken only if a norm breakdown occurs. If not the entire solve happens in a single cycle.
This is coded this way to allow both truncation and truncation-restart strategy
(see KSPFCDGetNumOldDirections()) */
ierr = KSPSolve_PIPEFCG_cycle(ksp);CHKERRQ(ierr);
if (ksp->reason) break;
if (pipefcg->norm_breakdown) {
pipefcg->n_restarts++;
pipefcg->norm_breakdown = PETSC_FALSE;
}
} while (ksp->its < ksp->max_it);
if (ksp->its >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
