int main(int argc,char **args)
{
Mat mat;
Vec b,u;
PC pc;
PetscErrorCode ierr;
PetscInt n = 5,i,col[3];
PetscScalar value[3];
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
/* Create vectors */
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&b);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&u);CHKERRQ(ierr);
/* Create and assemble matrix */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,n,n,NULL,&mat);CHKERRQ(ierr);
value[0] = -1.0; value[1] = 2.0; value[2] = -1.0;
for (i=1; i<n-1; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1;
ierr = MatSetValues(mat,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
i = n - 1; col[0] = n - 2; col[1] = n - 1;
ierr = MatSetValues(mat,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0;
ierr = MatSetValues(mat,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create PC context and set up data structures */
ierr = PCCreate(PETSC_COMM_WORLD,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCSOR);CHKERRQ(ierr);
ierr = PCSetFromOptions(pc);CHKERRQ(ierr);
ierr = PCSetOperators(pc,mat,mat);CHKERRQ(ierr);
ierr = PCSetUp(pc);CHKERRQ(ierr);
value[0] = 1.0;
for (i=0; i<n; i++) {
ierr = VecSet(u,0.0);CHKERRQ(ierr);
ierr = VecSetValues(u,1,&i,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(u);CHKERRQ(ierr);
ierr = VecAssemblyEnd(u);CHKERRQ(ierr);
ierr = PCApply(pc,u,b);CHKERRQ(ierr);
ierr = VecView(b,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
/* Free data structures */
ierr = MatDestroy(&mat);CHKERRQ(ierr);
ierr = PCDestroy(&pc);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
void precond(const HpddmCustomOperator* const H, const K* in, K* out, int mu)
{
int n, nu;
MatGetLocalSize(H->_A, &n, NULL);
for (nu = 0; nu < mu; ++nu) {
VecPlaceArray(H->_b, in + nu * n);
VecPlaceArray(H->_x, out + nu * n);
PCApply(H->_M, H->_b, H->_x);
VecResetArray(H->_x);
VecResetArray(H->_b);
}
}
bool
PETScPCLSWrapper::solveSystem(SAMRAIVectorReal<NDIM, double>& x, SAMRAIVectorReal<NDIM, double>& b)
{
if (!d_is_initialized) initializeSolverState(x, b);
// Update the PETSc Vec wrappers.
PETScSAMRAIVectorReal::replaceSAMRAIVector(d_petsc_x, Pointer<SAMRAIVectorReal<NDIM, double> >(&x, false));
PETScSAMRAIVectorReal::replaceSAMRAIVector(d_petsc_b, Pointer<SAMRAIVectorReal<NDIM, double> >(&b, false));
// Apply the preconditioner.
int ierr = PCApply(d_petsc_pc, d_petsc_x, d_petsc_b);
IBTK_CHKERRQ(ierr);
return true;
} // solveSystem
PetscErrorCode MatMultASPIN(Mat m,Vec X,Vec Y)
{
PetscErrorCode ierr;
void *ctx;
SNES snes;
PetscInt n,i;
VecScatter *oscatter;
SNES *subsnes;
PetscBool match;
MPI_Comm comm;
KSP ksp;
PC pc;
Vec *x,*b;
Vec W;
SNES npc;
PetscFunctionBegin;
ierr = MatShellGetContext(m,&ctx);CHKERRQ(ierr);
snes = (SNES)ctx;
ierr = SNESGetPC(snes,&npc);CHKERRQ(ierr);
ierr = SNESGetFunction(npc,&W,NULL,NULL);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)npc,SNESNASM,&match);CHKERRQ(ierr);
if (!match) {
ierr = PetscObjectGetComm((PetscObject)snes,&comm);
SETERRQ(comm,PETSC_ERR_ARG_WRONGSTATE,"MatMultASPIN requires that the nonlinear preconditioner be Nonlinear additive Schwarz");
}
ierr = SNESNASMGetSubdomains(npc,&n,&subsnes,NULL,&oscatter,NULL);CHKERRQ(ierr);
ierr = SNESNASMGetSubdomainVecs(npc,&n,&x,&b,NULL,NULL);CHKERRQ(ierr);
ierr = VecSet(Y,0);CHKERRQ(ierr);
ierr = MatMult(npc->jacobian_pre,X,W);CHKERRQ(ierr);
for (i=0;i<n;i++) {
ierr = VecScatterBegin(oscatter[i],W,b[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
for (i=0;i<n;i++) {
ierr = VecScatterEnd(oscatter[i],W,b[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecSet(x[i],0.);CHKERRQ(ierr);
ierr = SNESGetKSP(subsnes[i],&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCApply(pc,b[i],x[i]);CHKERRQ(ierr);
ierr = VecScatterBegin(oscatter[i],x[i],Y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
for (i=0;i<n;i++) {
ierr = VecScatterEnd(oscatter[i],x[i],Y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCApplyNullSpaceCorrectionPC(PC pc,Vec x,Vec y)
{
NullSpaceCorrection_ctx pc_ctx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PCShellGetContext(pc,(void**)&pc_ctx);CHKERRQ(ierr);
/* E */
ierr = MatMultTranspose(pc_ctx->Lbasis_mat,x,pc_ctx->work_small_2);CHKERRQ(ierr);
ierr = MatMultAdd(pc_ctx->Kbasis_mat,pc_ctx->work_small_2,x,pc_ctx->work_full_1);CHKERRQ(ierr);
/* P^-1 */
ierr = PCApply(pc_ctx->local_pc,pc_ctx->work_full_1,pc_ctx->work_full_2);CHKERRQ(ierr);
/* E^T */
ierr = MatMultTranspose(pc_ctx->Kbasis_mat,pc_ctx->work_full_2,pc_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecScale(pc_ctx->work_small_1,-1.0);CHKERRQ(ierr);
ierr = MatMultAdd(pc_ctx->Lbasis_mat,pc_ctx->work_small_1,pc_ctx->work_full_2,pc_ctx->work_full_1);CHKERRQ(ierr);
/* Sum contributions */
ierr = MatMultAdd(pc_ctx->basis_mat,pc_ctx->work_small_2,pc_ctx->work_full_1,y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSPSolve_Sundials(realtype tn,N_Vector y,N_Vector fy,N_Vector r,N_Vector z,
realtype _gamma,realtype delta,int lr,void *P_data,N_Vector vtemp)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc = cvode->pc;
Vec rr = cvode->w1,zz = cvode->w2;
PetscErrorCode ierr;
PetscScalar *r_data,*z_data;
PetscFunctionBegin;
/* Make the PETSc work vectors rr and zz point to the arrays in the SUNDIALS vectors r and z respectively*/
r_data = (PetscScalar *) N_VGetArrayPointer(r);
z_data = (PetscScalar *) N_VGetArrayPointer(z);
ierr = VecPlaceArray(rr,r_data); CHKERRQ(ierr);
ierr = VecPlaceArray(zz,z_data); CHKERRQ(ierr);
/* Solve the Px=r and put the result in zz */
ierr = PCApply(pc,rr,zz); CHKERRQ(ierr);
ierr = VecResetArray(rr); CHKERRQ(ierr);
ierr = VecResetArray(zz); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_GCR_cycle( KSP ksp )
{
KSP_GCR *ctx = (KSP_GCR*)ksp->data;
PetscErrorCode ierr;
PetscScalar r_dot_v;
Mat A, B;
PC pc;
Vec s,v,r;
PetscReal norm_r,nrm;
PetscInt k, i, restart;
Vec x;
PetscReal res;
PetscFunctionBegin;
restart = ctx->restart;
ierr = KSPGetPC( ksp, &pc );CHKERRQ(ierr);
ierr = KSPGetOperators( ksp, &A, &B, 0 );CHKERRQ(ierr);
x = ksp->vec_sol;
r = ctx->R;
for ( k=0; k<restart; k++ ) {
v = ctx->VV[k];
s = ctx->SS[k];
if (ctx->modifypc) {
ierr = (*ctx->modifypc)(ksp,ksp->its,ksp->rnorm,ctx->modifypc_ctx);CHKERRQ(ierr);
}
ierr = PCApply( pc, r, s );CHKERRQ(ierr); /* s = B^{-1} r */
ierr = MatMult( A, s, v );CHKERRQ(ierr); /* v = A s */
ierr = VecMDot( v,k, ctx->VV, ctx->val );CHKERRQ(ierr);
for (i=0; i<k; i++) ctx->val[i] = -ctx->val[i];
ierr = VecMAXPY(v,k,ctx->val,ctx->VV);CHKERRQ(ierr); /* v = v - sum_{i=0}^{k-1} alpha_i v_i */
ierr = VecMAXPY(s,k,ctx->val,ctx->SS);CHKERRQ(ierr); /* s = s - sum_{i=0}^{k-1} alpha_i s_i */
ierr = VecDotNorm2(r,v,&r_dot_v,&nrm);CHKERRQ(ierr);
nrm = PetscSqrtReal(nrm);
r_dot_v = r_dot_v/nrm;
ierr = VecScale( v, 1.0/nrm );CHKERRQ(ierr);
ierr = VecScale( s, 1.0/nrm );CHKERRQ(ierr);
ierr = VecAXPY( x, r_dot_v, s );CHKERRQ(ierr);
ierr = VecAXPY( r, -r_dot_v, v );CHKERRQ(ierr);
if (ksp->its > ksp->chknorm ) {
ierr = VecNorm( r, NORM_2, &norm_r );CHKERRQ(ierr);
}
/* update the local counter and the global counter */
ksp->its++;
res = norm_r;
ksp->rnorm = res;
KSPLogResidualHistory(ksp,res);
ierr = KSPMonitor(ksp,ksp->its,res);CHKERRQ(ierr);
if ( ksp->its > ksp->chknorm ) {
ierr = (*ksp->converged)(ksp,ksp->its,res,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
if ( ksp->its >= ksp->max_it ) {
ksp->reason = KSP_CONVERGED_ITS;
break;
}
}
ctx->n_restarts++;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_LSQR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,size1,size2;
PetscScalar rho,rhobar,phi,phibar,theta,c,s,tmp,tau;
PetscReal beta,alpha,rnorm;
Vec X,B,V,V1,U,U1,TMP,W,W2,SE,Z = NULL;
Mat Amat,Pmat;
MatStructure pflag;
KSP_LSQR *lsqr = (KSP_LSQR*)ksp->data;
PetscBool diagonalscale,nopreconditioner;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ksp->pc,PCNONE,&nopreconditioner);CHKERRQ(ierr);
/* nopreconditioner =PETSC_FALSE; */
/* Calculate norm of right hand side */
ierr = VecNorm(ksp->vec_rhs,NORM_2,&lsqr->rhs_norm);CHKERRQ(ierr);
/* mark norm of matrix with negative number to indicate it has not yet been computed */
lsqr->anorm = -1.0;
/* vectors of length m, where system size is mxn */
B = ksp->vec_rhs;
U = lsqr->vwork_m[0];
U1 = lsqr->vwork_m[1];
/* vectors of length n */
X = ksp->vec_sol;
W = lsqr->vwork_n[0];
V = lsqr->vwork_n[1];
V1 = lsqr->vwork_n[2];
W2 = lsqr->vwork_n[3];
if (!nopreconditioner) Z = lsqr->vwork_n[4];
/* standard error vector */
SE = lsqr->se;
if (SE) {
ierr = VecGetSize(SE,&size1);CHKERRQ(ierr);
ierr = VecGetSize(X,&size2);CHKERRQ(ierr);
if (size1 != size2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Standard error vector (size %d) does not match solution vector (size %d)",size1,size2);
ierr = VecSet(SE,0.0);CHKERRQ(ierr);
}
/* Compute initial residual, temporarily use work vector u */
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,U);CHKERRQ(ierr); /* u <- b - Ax */
ierr = VecAYPX(U,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,U);CHKERRQ(ierr); /* u <- b (x is 0) */
}
/* Test for nothing to do */
ierr = VecNorm(U,NORM_2,&rnorm);CHKERRQ(ierr);
ierr = PetscObjectAMSTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = rnorm;
ierr = PetscObjectAMSGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
beta = rnorm;
ierr = VecScale(U,1.0/beta);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,U,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
PetscFunctionReturn(0);
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V,1.0/alpha);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecCopy(V,W);CHKERRQ(ierr);
} else {
ierr = VecCopy(Z,W);CHKERRQ(ierr);
}
lsqr->arnorm = alpha * beta;
phibar = beta;
rhobar = alpha;
i = 0;
do {
if (nopreconditioner) {
ierr = KSP_MatMult(ksp,Amat,V,U1);CHKERRQ(ierr);
} else {
ierr = KSP_MatMult(ksp,Amat,Z,U1);CHKERRQ(ierr);
}
ierr = VecAXPY(U1,-alpha,U);CHKERRQ(ierr);
ierr = VecNorm(U1,NORM_2,&beta);CHKERRQ(ierr);
if (beta == 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
ierr = VecScale(U1,1.0/beta);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,U1,V1);CHKERRQ(ierr);
ierr = VecAXPY(V1,-beta,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V1,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V1,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V1,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V1,1.0/alpha);CHKERRQ(ierr);
rho = PetscSqrtScalar(rhobar*rhobar + beta*beta);
c = rhobar / rho;
s = beta / rho;
theta = s * alpha;
rhobar = -c * alpha;
phi = c * phibar;
phibar = s * phibar;
tau = s * phi;
ierr = VecAXPY(X,phi/rho,W);CHKERRQ(ierr); /* x <- x + (phi/rho) w */
if (SE) {
ierr = VecCopy(W,W2);CHKERRQ(ierr);
ierr = VecSquare(W2);CHKERRQ(ierr);
ierr = VecScale(W2,1.0/(rho*rho));CHKERRQ(ierr);
ierr = VecAXPY(SE, 1.0, W2);CHKERRQ(ierr); /* SE <- SE + (w^2/rho^2) */
}
if (nopreconditioner) {
ierr = VecAYPX(W,-theta/rho,V1);CHKERRQ(ierr); /* w <- v - (theta/rho) w */
} else {
ierr = VecAYPX(W,-theta/rho,Z);CHKERRQ(ierr); /* w <- z - (theta/rho) w */
}
lsqr->arnorm = alpha*PetscAbsScalar(tau);
rnorm = PetscRealPart(phibar);
ierr = PetscObjectAMSTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = rnorm;
ierr = PetscObjectAMSGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
SWAP(U1,U,TMP);
SWAP(V1,V,TMP);
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it && !ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
/* Finish off the standard error estimates */
if (SE) {
tmp = 1.0;
ierr = MatGetSize(Amat,&size1,&size2);CHKERRQ(ierr);
if (size1 > size2) tmp = size1 - size2;
tmp = rnorm / PetscSqrtScalar(tmp);
ierr = VecSqrtAbs(SE);CHKERRQ(ierr);
ierr = VecScale(SE,tmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_FBCGSR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,j,N;
PetscScalar tau,sigma,alpha,omega,beta;
PetscReal rho;
PetscScalar xi1,xi2,xi3,xi4;
Vec X,B,P,P2,RP,R,V,S,T,S2;
PetscScalar *PETSC_RESTRICT rp, *PETSC_RESTRICT r, *PETSC_RESTRICT p;
PetscScalar *PETSC_RESTRICT v, *PETSC_RESTRICT s, *PETSC_RESTRICT t, *PETSC_RESTRICT s2;
PetscScalar insums[4],outsums[4];
KSP_BCGS *bcgs = (KSP_BCGS*)ksp->data;
PC pc;
PetscFunctionBegin;
if (!ksp->vec_rhs->petscnative) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Only coded for PETSc vectors");
ierr = VecGetLocalSize(ksp->vec_sol,&N);
CHKERRQ(ierr);
X = ksp->vec_sol;
B = ksp->vec_rhs;
P2 = ksp->work[0];
/* The followings are involved in modified inner product calculations and vector updates */
RP = ksp->work[1];
ierr = VecGetArray(RP,(PetscScalar**)&rp);
CHKERRQ(ierr);
ierr = VecRestoreArray(RP,NULL);
CHKERRQ(ierr);
R = ksp->work[2];
ierr = VecGetArray(R,(PetscScalar**)&r);
CHKERRQ(ierr);
ierr = VecRestoreArray(R,NULL);
CHKERRQ(ierr);
P = ksp->work[3];
ierr = VecGetArray(P,(PetscScalar**)&p);
CHKERRQ(ierr);
ierr = VecRestoreArray(P,NULL);
CHKERRQ(ierr);
V = ksp->work[4];
ierr = VecGetArray(V,(PetscScalar**)&v);
CHKERRQ(ierr);
ierr = VecRestoreArray(V,NULL);
CHKERRQ(ierr);
S = ksp->work[5];
ierr = VecGetArray(S,(PetscScalar**)&s);
CHKERRQ(ierr);
ierr = VecRestoreArray(S,NULL);
CHKERRQ(ierr);
T = ksp->work[6];
ierr = VecGetArray(T,(PetscScalar**)&t);
CHKERRQ(ierr);
ierr = VecRestoreArray(T,NULL);
CHKERRQ(ierr);
S2 = ksp->work[7];
ierr = VecGetArray(S2,(PetscScalar**)&s2);
CHKERRQ(ierr);
ierr = VecRestoreArray(S2,NULL);
CHKERRQ(ierr);
/* Only supports right preconditioning */
if (ksp->pc_side != PC_RIGHT) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSP fbcgsr does not support %s",PCSides[ksp->pc_side]);
if (!ksp->guess_zero) {
if (!bcgs->guess) {
ierr = VecDuplicate(X,&bcgs->guess);
CHKERRQ(ierr);
}
ierr = VecCopy(X,bcgs->guess);
CHKERRQ(ierr);
} else {
ierr = VecSet(X,0.0);
CHKERRQ(ierr);
}
/* Compute initial residual */
ierr = KSPGetPC(ksp,&pc);
CHKERRQ(ierr);
ierr = PCSetUp(pc);
CHKERRQ(ierr);
if (!ksp->guess_zero) {
ierr = MatMult(pc->mat,X,P2);
CHKERRQ(ierr); /* P2 is used as temporary storage */
ierr = VecCopy(B,R);
CHKERRQ(ierr);
ierr = VecAXPY(R,-1.0,P2);
CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);
CHKERRQ(ierr);
}
/* Test for nothing to do */
if (ksp->normtype != KSP_NORM_NONE) {
ierr = VecNorm(R,NORM_2,&rho);
CHKERRQ(ierr);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);
CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = rho;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);
CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rho);
CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,rho);
CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,rho,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
/* Initialize iterates */
ierr = VecCopy(R,RP);
CHKERRQ(ierr); /* rp <- r */
ierr = VecCopy(R,P);
CHKERRQ(ierr); /* p <- r */
/* Big loop */
for (i=0; i<ksp->max_it; i++) {
/* matmult and pc */
ierr = PCApply(pc,P,P2);
CHKERRQ(ierr); /* p2 <- K p */
ierr = MatMult(pc->mat,P2,V);
CHKERRQ(ierr); /* v <- A p2 */
/* inner prodcuts */
if (i==0) {
tau = rho*rho;
ierr = VecDot(V,RP,&sigma);
CHKERRQ(ierr); /* sigma <- (v,rp) */
} else {
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
tau = sigma = 0.0;
for (j=0; j<N; j++) {
tau += r[j]*rp[j]; /* tau <- (r,rp) */
sigma += v[j]*rp[j]; /* sigma <- (v,rp) */
}
PetscLogFlops(4.0*N);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
insums[0] = tau;
insums[1] = sigma;
ierr = PetscLogEventBarrierBegin(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = MPI_Allreduce(insums,outsums,2,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = PetscLogEventBarrierEnd(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
tau = outsums[0];
sigma = outsums[1];
}
/* scalar update */
alpha = tau / sigma;
/* vector update */
ierr = VecWAXPY(S,-alpha,V,R);
CHKERRQ(ierr); /* s <- r - alpha v */
/* matmult and pc */
ierr = PCApply(pc,S,S2);
CHKERRQ(ierr); /* s2 <- K s */
ierr = MatMult(pc->mat,S2,T);
CHKERRQ(ierr); /* t <- A s2 */
/* inner prodcuts */
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
xi1 = xi2 = xi3 = xi4 = 0.0;
for (j=0; j<N; j++) {
xi1 += s[j]*s[j]; /* xi1 <- (s,s) */
xi2 += t[j]*s[j]; /* xi2 <- (t,s) */
xi3 += t[j]*t[j]; /* xi3 <- (t,t) */
xi4 += t[j]*rp[j]; /* xi4 <- (t,rp) */
}
PetscLogFlops(8.0*N);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
insums[0] = xi1;
insums[1] = xi2;
insums[2] = xi3;
insums[3] = xi4;
ierr = PetscLogEventBarrierBegin(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = MPI_Allreduce(insums,outsums,4,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = PetscLogEventBarrierEnd(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
xi1 = outsums[0];
xi2 = outsums[1];
xi3 = outsums[2];
xi4 = outsums[3];
/* test denominator */
if (xi3 == 0.0) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_PLIB,"Divide by zero");
if (sigma == 0.0) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_PLIB,"Divide by zero");
/* scalar updates */
omega = xi2 / xi3;
beta = -xi4 / sigma;
rho = PetscSqrtReal(PetscAbsScalar(xi1 - omega * xi2)); /* residual norm */
/* vector updates */
ierr = VecAXPBYPCZ(X,alpha,omega,1.0,P2,S2);
CHKERRQ(ierr); /* x <- alpha * p2 + omega * s2 + x */
/* convergence test */
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);
CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = rho;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);
CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rho);
CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rho);
CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rho,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
if (ksp->reason) break;
/* vector updates */
ierr = PetscLogEventBegin(VEC_Ops,0,0,0,0);
CHKERRQ(ierr);
for (j=0; j<N; j++) {
r[j] = s[j] - omega * t[j]; /* r <- s - omega t */
p[j] = r[j] + beta * (p[j] - omega * v[j]); /* p <- r + beta * (p - omega v) */
}
PetscLogFlops(6.0*N);
ierr = PetscLogEventEnd(VEC_Ops,0,0,0,0);
CHKERRQ(ierr);
}
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, IS local_dofs)
{
PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
PC_IS *pcis = (PC_IS*)pc->data;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
KSP local_ksp;
PC newpc;
NullSpaceCorrection_ctx shell_ctx;
Mat local_mat,local_pmat,small_mat,inv_small_mat;
Vec work1,work2;
const Vec *nullvecs;
VecScatter scatter_ctx;
IS is_aux;
MatFactorInfo matinfo;
PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat;
PetscScalar one = 1.0,zero = 0.0, m_one = -1.0;
PetscInt basis_dofs,basis_size,nnsp_size,i,k;
PetscBool nnsp_has_cnst;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Infer the local solver */
ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr);
if (isdir) {
/* Dirichlet solver */
local_ksp = pcbddc->ksp_D;
} else {
/* Neumann solver */
local_ksp = pcbddc->ksp_R;
}
ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
/* Get null space vecs */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr);
basis_size = nnsp_size;
if (nnsp_has_cnst) {
basis_size++;
}
if (basis_dofs) {
/* Create shell ctx */
ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
/* Create work vectors in shell context */
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr);
/* Allocate workspace */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Restrict local null space on selected dofs (Dirichlet or Neumann)
and compute matrices N and K*N */
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr);
}
for (k=0;k<nnsp_size;k++) {
ierr = VecScatterBegin(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (basis_dofs) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
}
if (basis_dofs) {
if (nnsp_has_cnst) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecSet(work1,one);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Assemble another Mat object in shell context */
ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr);
ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr);
ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
ierr = PetscMalloc1(basis_size*basis_size,&array_mat);CHKERRQ(ierr);
for (k=0;k<basis_size;k++) {
ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr);
ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=0;i<basis_size;i++) {
array_mat[i*basis_size+k]=array[i];
}
ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
}
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr);
ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr);
ierr = PetscFree(array_mat);CHKERRQ(ierr);
ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr);
ierr = MatDestroy(&small_mat);CHKERRQ(ierr);
ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr);
/* Rebuild local PC */
ierr = KSPGetPC(local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr);
ierr = PCSetOperators(newpc,local_mat,local_mat);CHKERRQ(ierr);
ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr);
ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCSetUp(newpc);CHKERRQ(ierr);
ierr = KSPSetPC(local_ksp,newpc);CHKERRQ(ierr);
ierr = PCDestroy(&newpc);CHKERRQ(ierr);
ierr = KSPSetUp(local_ksp);CHKERRQ(ierr);
}
/* test */
if (pcbddc->dbg_flag && basis_dofs) {
KSP check_ksp;
PC check_pc;
Mat test_mat;
Vec work3;
PetscReal test_err,lambda_min,lambda_max;
PetscBool setsym,issym=PETSC_FALSE;
PetscInt tabs;
ierr = PetscViewerASCIIGetTab(pcbddc->dbg_viewer,&tabs);CHKERRQ(ierr);
ierr = KSPGetPC(local_ksp,&check_pc);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr);
ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr);
ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr);
ierr = VecCopy(work1,work2);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr);
ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr);
ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_FALSE);CHKERRQ(ierr);
if (isdir) {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Dirichlet ");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Neumann ");CHKERRQ(ierr);
}
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"solver is :%1.14e\n",test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISetTab(pcbddc->dbg_viewer,tabs);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr);
ierr = MatShift(test_mat,one);CHKERRQ(ierr);
ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = MatDestroy(&test_mat);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
/* Create ksp object suitable for extreme eigenvalues' estimation */
ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(check_ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(check_ksp,local_mat,local_mat);CHKERRQ(ierr);
ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
if (issym) {
ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
}
ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr);
ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr);
ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecDestroy(&work3);CHKERRQ(ierr);
}
/* all processes shoud call this, even the void ones */
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL pcapply_(PC pc,Vec x,Vec y, int *__ierr ){
*__ierr = PCApply(
(PC)PetscToPointer((pc) ),
(Vec)PetscToPointer((x) ),
(Vec)PetscToPointer((y) ));
}
