PETSC_EXTERN void PETSC_STDCALL pcmgsetcyclesonlevel_(PC pc,PetscInt *l,PetscInt *c, int *__ierr ){
*__ierr = PCMGSetCyclesOnLevel(
(PC)PetscToPointer((pc) ),*l,*c);
}
int main(int Argc,char **Args)
{
PetscInt x_mesh = 15,levels = 3,cycles = 1,use_jacobi = 0;
PetscInt i,smooths = 1,*N,its;
PetscErrorCode ierr;
PCMGType am = PC_MG_MULTIPLICATIVE;
Mat cmat,mat[20],fmat;
KSP cksp,ksp[20],kspmg;
PetscReal e[3]; /* l_2 error,max error, residual */
const char *shellname;
Vec x,solution,X[20],R[20],B[20];
PC pcmg,pc;
PetscBool flg;
PetscInitialize(&Argc,&Args,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-x",&x_mesh,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-l",&levels,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-c",&cycles,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-smooths",&smooths,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-a",&flg);CHKERRQ(ierr);
if (flg) am = PC_MG_ADDITIVE;
ierr = PetscOptionsHasName(NULL,"-f",&flg);CHKERRQ(ierr);
if (flg) am = PC_MG_FULL;
ierr = PetscOptionsHasName(NULL,"-j",&flg);CHKERRQ(ierr);
if (flg) use_jacobi = 1;
ierr = PetscMalloc1(levels,&N);CHKERRQ(ierr);
N[0] = x_mesh;
for (i=1; i<levels; i++) {
N[i] = N[i-1]/2;
if (N[i] < 1) SETERRQ(PETSC_COMM_WORLD,1,"Too many levels");
}
ierr = Create1dLaplacian(N[levels-1],&cmat);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&kspmg);CHKERRQ(ierr);
ierr = KSPGetPC(kspmg,&pcmg);CHKERRQ(ierr);
ierr = KSPSetFromOptions(kspmg);CHKERRQ(ierr);
ierr = PCSetType(pcmg,PCMG);CHKERRQ(ierr);
ierr = PCMGSetLevels(pcmg,levels,NULL);CHKERRQ(ierr);
ierr = PCMGSetType(pcmg,am);CHKERRQ(ierr);
ierr = PCMGGetCoarseSolve(pcmg,&cksp);CHKERRQ(ierr);
ierr = KSPSetOperators(cksp,cmat,cmat);CHKERRQ(ierr);
ierr = KSPGetPC(cksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCLU);CHKERRQ(ierr);
ierr = KSPSetType(cksp,KSPPREONLY);CHKERRQ(ierr);
/* zero is finest level */
for (i=0; i<levels-1; i++) {
ierr = PCMGSetResidual(pcmg,levels - 1 - i,residual,(Mat)0);CHKERRQ(ierr);
ierr = MatCreateShell(PETSC_COMM_WORLD,N[i+1],N[i],N[i+1],N[i],(void*)0,&mat[i]);CHKERRQ(ierr);
ierr = MatShellSetOperation(mat[i],MATOP_MULT,(void (*)(void))restrct);CHKERRQ(ierr);
ierr = MatShellSetOperation(mat[i],MATOP_MULT_TRANSPOSE_ADD,(void (*)(void))interpolate);CHKERRQ(ierr);
ierr = PCMGSetInterpolation(pcmg,levels - 1 - i,mat[i]);CHKERRQ(ierr);
ierr = PCMGSetRestriction(pcmg,levels - 1 - i,mat[i]);CHKERRQ(ierr);
ierr = PCMGSetCyclesOnLevel(pcmg,levels - 1 - i,cycles);CHKERRQ(ierr);
/* set smoother */
ierr = PCMGGetSmoother(pcmg,levels - 1 - i,&ksp[i]);CHKERRQ(ierr);
ierr = KSPGetPC(ksp[i],&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetName(pc,"user_precond");CHKERRQ(ierr);
ierr = PCShellGetName(pc,&shellname);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"level=%D, PCShell name is %s\n",i,shellname);CHKERRQ(ierr);
/* this is a dummy! since KSP requires a matrix passed in */
ierr = KSPSetOperators(ksp[i],mat[i],mat[i]);CHKERRQ(ierr);
/*
We override the matrix passed in by forcing it to use Richardson with
a user provided application. This is non-standard and this practice
should be avoided.
*/
ierr = PCShellSetApplyRichardson(pc,gauss_seidel);CHKERRQ(ierr);
if (use_jacobi) {
ierr = PCShellSetApplyRichardson(pc,jacobi);CHKERRQ(ierr);
}
ierr = KSPSetType(ksp[i],KSPRICHARDSON);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(ksp[i],PETSC_TRUE);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp[i],PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,smooths);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,N[i],&x);CHKERRQ(ierr);
X[levels - 1 - i] = x;
if (i > 0) {
ierr = PCMGSetX(pcmg,levels - 1 - i,x);CHKERRQ(ierr);
}
ierr = VecCreateSeq(PETSC_COMM_SELF,N[i],&x);CHKERRQ(ierr);
B[levels -1 - i] = x;
if (i > 0) {
ierr = PCMGSetRhs(pcmg,levels - 1 - i,x);CHKERRQ(ierr);
}
ierr = VecCreateSeq(PETSC_COMM_SELF,N[i],&x);CHKERRQ(ierr);
R[levels - 1 - i] = x;
ierr = PCMGSetR(pcmg,levels - 1 - i,x);CHKERRQ(ierr);
}
/* create coarse level vectors */
ierr = VecCreateSeq(PETSC_COMM_SELF,N[levels-1],&x);CHKERRQ(ierr);
ierr = PCMGSetX(pcmg,0,x);CHKERRQ(ierr); X[0] = x;
ierr = VecCreateSeq(PETSC_COMM_SELF,N[levels-1],&x);CHKERRQ(ierr);
ierr = PCMGSetRhs(pcmg,0,x);CHKERRQ(ierr); B[0] = x;
/* create matrix multiply for finest level */
ierr = MatCreateShell(PETSC_COMM_WORLD,N[0],N[0],N[0],N[0],(void*)0,&fmat);CHKERRQ(ierr);
ierr = MatShellSetOperation(fmat,MATOP_MULT,(void (*)(void))amult);CHKERRQ(ierr);
ierr = KSPSetOperators(kspmg,fmat,fmat);CHKERRQ(ierr);
ierr = CalculateSolution(N[0],&solution);CHKERRQ(ierr);
ierr = CalculateRhs(B[levels-1]);CHKERRQ(ierr);
ierr = VecSet(X[levels-1],0.0);CHKERRQ(ierr);
ierr = residual((Mat)0,B[levels-1],X[levels-1],R[levels-1]);CHKERRQ(ierr);
ierr = CalculateError(solution,X[levels-1],R[levels-1],e);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"l_2 error %g max error %g resi %g\n",(double)e[0],(double)e[1],(double)e[2]);CHKERRQ(ierr);
ierr = KSPSolve(kspmg,B[levels-1],X[levels-1]);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(kspmg,&its);CHKERRQ(ierr);
ierr = residual((Mat)0,B[levels-1],X[levels-1],R[levels-1]);CHKERRQ(ierr);
ierr = CalculateError(solution,X[levels-1],R[levels-1],e);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"its %D l_2 error %g max error %g resi %g\n",its,(double)e[0],(double)e[1],(double)e[2]);CHKERRQ(ierr);
ierr = PetscFree(N);CHKERRQ(ierr);
ierr = VecDestroy(&solution);CHKERRQ(ierr);
/* note we have to keep a list of all vectors allocated, this is
not ideal, but putting it in MGDestroy is not so good either*/
for (i=0; i<levels; i++) {
ierr = VecDestroy(&X[i]);CHKERRQ(ierr);
ierr = VecDestroy(&B[i]);CHKERRQ(ierr);
if (i) {ierr = VecDestroy(&R[i]);CHKERRQ(ierr);}
}
for (i=0; i<levels-1; i++) {
ierr = MatDestroy(&mat[i]);CHKERRQ(ierr);
}
ierr = MatDestroy(&cmat);CHKERRQ(ierr);
ierr = MatDestroy(&fmat);CHKERRQ(ierr);
ierr = KSPDestroy(&kspmg);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
void PETScMGSolver_UpdateSolvers( PETScMGSolver* self ) {
PETScMGSolver_Level* level;
PC pc;
KSP levelKSP;
PC levelPC;
PetscErrorCode ec;
unsigned l_i;
PetscTruth smoothers_differ, flag;
PetscMPIInt size;
MPI_Comm comm;
assert( self && Stg_CheckType( self, PETScMGSolver ) );
ec = KSPGetPC( self->mgData->ksp, &pc );
CheckPETScError( ec );
ec = PCMGSetLevels( pc, self->nLevels, PETSC_NULL );
CheckPETScError( ec );
ec = PCMGSetType( pc, PC_MG_MULTIPLICATIVE );
CheckPETScError( ec );
ec=PetscOptionsGetTruth( PETSC_NULL, "-pc_mg_different_smoothers", &smoothers_differ, &flag ); CheckPETScError(ec);
ec=PetscObjectGetComm( (PetscObject)pc, &comm ); CheckPETScError(ec);
MPI_Comm_size( comm, &size );
for( l_i = 1; l_i < self->nLevels; l_i++ ) {
level = self->levels + l_i;
printf("Configuring MG level %d \n", l_i );
ec = PCMGGetSmootherDown( pc, l_i, &levelKSP );
CheckPETScError( ec );
if(smoothers_differ==PETSC_TRUE) { ec=KSPAppendOptionsPrefix( levelKSP, "down_" ); CheckPETScError(ec); }
ec = KSPSetType( levelKSP, KSPRICHARDSON ); CheckPETScError( ec );
ec = KSPGetPC( levelKSP, &levelPC ); CheckPETScError( ec );
if(size==1) {
ec = PCSetType( levelPC, PCSOR ); CheckPETScError( ec );
}
/* This does not work - bug with the order the operators are created I guess */
/* For parallel jobs you best bet is to use the command line args and let petsc work it out */
/*
else {
KSP *sub_ksp;
PetscInt k, n_local, first_local;
PC sub_pc;
PCSetType( levelPC, PCBJACOBI );
KSPSetUp( levelKSP );
PCBJacobiGetSubKSP( levelPC, &n_local,&first_local,&sub_ksp);
for(k=0;k<n_local;k++ ) {
KSPSetType( sub_ksp[k], KSPFGMRES );
KSPGetPC( sub_ksp[k], &sub_pc );
PCSetType( sub_pc, PCSOR );
}
}
*/
ec = KSPSetTolerances( levelKSP, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, level->nDownIts ); CheckPETScError( ec );
if( l_i == self->nLevels - 1 ) {
ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_TRUE ); CheckPETScError( ec );
}
else { ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_FALSE ); CheckPETScError( ec ); }
ec = PCMGGetSmootherUp( pc, l_i, &levelKSP ); CheckPETScError( ec );
if(smoothers_differ==PETSC_TRUE) { ec=KSPAppendOptionsPrefix( levelKSP, "up_" ); CheckPETScError(ec); }
ec = KSPSetType( levelKSP, KSPRICHARDSON ); CheckPETScError( ec );
ec = KSPGetPC( levelKSP, &levelPC ); CheckPETScError( ec );
if(size==1) {
ec = PCSetType( levelPC, PCSOR ); CheckPETScError( ec );
}
ec = KSPSetTolerances( levelKSP, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, level->nUpIts ); CheckPETScError( ec );
ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_TRUE ); CheckPETScError( ec );
ec = PCMGSetCyclesOnLevel( pc, l_i, level->nCycles ); CheckPETScError( ec );
}
}
