xref: /petsc/src/ksp/pc/impls/gamg/classical.c (revision 8e6d0c3091d44ae9c0797ea42c92efcea56ec583)
1*8e6d0c30SPeter Brune #include <../src/ksp/pc/impls/gamg/gamg.h>        /*I "petscpc.h" I*/
2*8e6d0c30SPeter Brune #include <petsc-private/kspimpl.h>
3*8e6d0c30SPeter Brune 
4*8e6d0c30SPeter Brune typedef struct {
5*8e6d0c30SPeter Brune   PetscReal dummy; /* empty struct; save for later */
6*8e6d0c30SPeter Brune } PC_GAMG_Classical;
7*8e6d0c30SPeter Brune 
8*8e6d0c30SPeter Brune 
9*8e6d0c30SPeter Brune #undef __FUNCT__
10*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGClassicalCreateGhostVector"
11*8e6d0c30SPeter Brune PetscErrorCode PCGAMGClassicalCreateGhostVector(Mat G,Vec *gvec,PetscInt **global)
12*8e6d0c30SPeter Brune {
13*8e6d0c30SPeter Brune   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)G->data;
14*8e6d0c30SPeter Brune   PetscErrorCode ierr;
15*8e6d0c30SPeter Brune   PetscBool      isMPIAIJ;
16*8e6d0c30SPeter Brune 
17*8e6d0c30SPeter Brune   PetscFunctionBegin;
18*8e6d0c30SPeter Brune   ierr = PetscObjectTypeCompare((PetscObject)G, MATMPIAIJ, &isMPIAIJ ); CHKERRQ(ierr);
19*8e6d0c30SPeter Brune   if (isMPIAIJ) {
20*8e6d0c30SPeter Brune     if (gvec)ierr = VecDuplicate(aij->lvec,gvec);CHKERRQ(ierr);
21*8e6d0c30SPeter Brune     if (global)*global = aij->garray;
22*8e6d0c30SPeter Brune   } else {
23*8e6d0c30SPeter Brune     /* no off-processor nodes */
24*8e6d0c30SPeter Brune     if (gvec)*gvec = NULL;
25*8e6d0c30SPeter Brune     if (global)*global = NULL;
26*8e6d0c30SPeter Brune   }
27*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
28*8e6d0c30SPeter Brune }
29*8e6d0c30SPeter Brune 
30*8e6d0c30SPeter Brune #undef __FUNCT__
31*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGClassicalGraphSplitting"
32*8e6d0c30SPeter Brune /*
33*8e6d0c30SPeter Brune  Split the relevant graph into diagonal and off-diagonal parts in local numbering; for now this
34*8e6d0c30SPeter Brune  a roundabout private interface to the mats' internal diag and offdiag mats.
35*8e6d0c30SPeter Brune  */
36*8e6d0c30SPeter Brune PetscErrorCode PCGAMGClassicalGraphSplitting(Mat G,Mat *Gd, Mat *Go)
37*8e6d0c30SPeter Brune {
38*8e6d0c30SPeter Brune   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)G->data;
39*8e6d0c30SPeter Brune   PetscErrorCode ierr;
40*8e6d0c30SPeter Brune   PetscBool      isMPIAIJ;
41*8e6d0c30SPeter Brune   PetscFunctionBegin;
42*8e6d0c30SPeter Brune   ierr = PetscObjectTypeCompare((PetscObject)G, MATMPIAIJ, &isMPIAIJ ); CHKERRQ(ierr);
43*8e6d0c30SPeter Brune   if (isMPIAIJ) {
44*8e6d0c30SPeter Brune     *Gd = aij->A;
45*8e6d0c30SPeter Brune     *Go = aij->B;
46*8e6d0c30SPeter Brune   } else {
47*8e6d0c30SPeter Brune     *Gd = G;
48*8e6d0c30SPeter Brune     *Go = NULL;
49*8e6d0c30SPeter Brune   }
50*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
51*8e6d0c30SPeter Brune }
52*8e6d0c30SPeter Brune 
53*8e6d0c30SPeter Brune #undef __FUNCT__
54*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGGraph_Classical"
55*8e6d0c30SPeter Brune PetscErrorCode PCGAMGGraph_Classical(PC pc,Mat A,Mat *G)
56*8e6d0c30SPeter Brune {
57*8e6d0c30SPeter Brune   PetscInt          s,f,idx;
58*8e6d0c30SPeter Brune   PetscInt          r,c,ncols,*gcol;
59*8e6d0c30SPeter Brune   const PetscInt    *rcol;
60*8e6d0c30SPeter Brune   const PetscScalar *rval;
61*8e6d0c30SPeter Brune   PetscScalar       *gval;
62*8e6d0c30SPeter Brune   PetscReal         rmax,Amax;
63*8e6d0c30SPeter Brune   PetscInt          cmax;
64*8e6d0c30SPeter Brune   PC_MG             *mg;
65*8e6d0c30SPeter Brune   PC_GAMG           *gamg;
66*8e6d0c30SPeter Brune   PetscErrorCode    ierr;
67*8e6d0c30SPeter Brune   PetscInt          *gsparse,*lsparse;
68*8e6d0c30SPeter Brune   Mat               lA,gA;
69*8e6d0c30SPeter Brune   MatType           mtype;
70*8e6d0c30SPeter Brune 
71*8e6d0c30SPeter Brune   PetscFunctionBegin;
72*8e6d0c30SPeter Brune   mg   = (PC_MG *)pc->data;
73*8e6d0c30SPeter Brune   gamg = (PC_GAMG *)mg->innerctx;
74*8e6d0c30SPeter Brune 
75*8e6d0c30SPeter Brune   ierr = MatGetOwnershipRange(A,&s,&f);CHKERRQ(ierr);
76*8e6d0c30SPeter Brune 
77*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*(f - s),&lsparse);CHKERRQ(ierr);
78*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*(f - s),&gsparse);CHKERRQ(ierr);
79*8e6d0c30SPeter Brune 
80*8e6d0c30SPeter Brune   ierr = PCGAMGClassicalGraphSplitting(A,&lA,&gA);CHKERRQ(ierr);
81*8e6d0c30SPeter Brune 
82*8e6d0c30SPeter Brune   /* find the maximum off-diagonal entry in the matrix */
83*8e6d0c30SPeter Brune   rmax = 0.;
84*8e6d0c30SPeter Brune   cmax = 0;
85*8e6d0c30SPeter Brune   for (r = s;r < f;r++) {
86*8e6d0c30SPeter Brune     ierr = MatGetRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
87*8e6d0c30SPeter Brune     for (c = 0; c < ncols; c++) {
88*8e6d0c30SPeter Brune       if (rcol[c] != r)
89*8e6d0c30SPeter Brune         if (PetscAbsScalar(rval[c]) > rmax) rmax = PetscAbsScalar(rval[c]);
90*8e6d0c30SPeter Brune     }
91*8e6d0c30SPeter Brune     if (ncols > cmax) cmax = ncols;
92*8e6d0c30SPeter Brune     ierr = MatRestoreRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
93*8e6d0c30SPeter Brune   }
94*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&gval);CHKERRQ(ierr);
95*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*cmax,&gcol);CHKERRQ(ierr);
96*8e6d0c30SPeter Brune   ierr = MPI_Reduce(&rmax,&Amax,1,MPI_DOUBLE,MPI_MAX,0,PetscObjectComm((PetscObject)pc));
97*8e6d0c30SPeter Brune 
98*8e6d0c30SPeter Brune   ierr = PetscInfo1(pc,"Maximum off-diagonal value in classical AMG graph: %f",rmax);CHKERRQ(ierr);
99*8e6d0c30SPeter Brune 
100*8e6d0c30SPeter Brune   for (r = 0;r < f-s;r++) {
101*8e6d0c30SPeter Brune     lsparse[r] = 0;
102*8e6d0c30SPeter Brune     gsparse[r] = 0;
103*8e6d0c30SPeter Brune   }
104*8e6d0c30SPeter Brune 
105*8e6d0c30SPeter Brune   /* for now this recreates the entire matrix due to a bug in MatCoarsen */
106*8e6d0c30SPeter Brune   for (r = 0;r < f-s;r++) {
107*8e6d0c30SPeter Brune     ierr = MatGetRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
108*8e6d0c30SPeter Brune     idx = 0;
109*8e6d0c30SPeter Brune     for (c = 0; c < ncols; c++) {
110*8e6d0c30SPeter Brune       if (PetscAbsScalar(rval[c]) > gamg->threshold*Amax) {
111*8e6d0c30SPeter Brune         idx++;
112*8e6d0c30SPeter Brune       } else {
113*8e6d0c30SPeter Brune         idx++;
114*8e6d0c30SPeter Brune       }
115*8e6d0c30SPeter Brune     }
116*8e6d0c30SPeter Brune     ierr = MatRestoreRow(lA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
117*8e6d0c30SPeter Brune     lsparse[r] = idx;
118*8e6d0c30SPeter Brune   }
119*8e6d0c30SPeter Brune   if (gA) {
120*8e6d0c30SPeter Brune     for (r = 0;r < f-s;r++) {
121*8e6d0c30SPeter Brune       ierr = MatGetRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
122*8e6d0c30SPeter Brune       idx = 0;
123*8e6d0c30SPeter Brune       for (c = 0; c < ncols; c++) {
124*8e6d0c30SPeter Brune         if (PetscAbsScalar(rval[c]) > gamg->threshold*Amax) {
125*8e6d0c30SPeter Brune           idx++;
126*8e6d0c30SPeter Brune         } else {
127*8e6d0c30SPeter Brune           idx++;
128*8e6d0c30SPeter Brune         }
129*8e6d0c30SPeter Brune       }
130*8e6d0c30SPeter Brune       ierr = MatRestoreRow(gA,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
131*8e6d0c30SPeter Brune       gsparse[r] = idx;
132*8e6d0c30SPeter Brune     }
133*8e6d0c30SPeter Brune   }
134*8e6d0c30SPeter Brune   ierr = MatCreate(PetscObjectComm((PetscObject)A),G); CHKERRQ(ierr);
135*8e6d0c30SPeter Brune   ierr = MatGetType(A,&mtype);CHKERRQ(ierr);
136*8e6d0c30SPeter Brune   ierr = MatSetType(*G,mtype);CHKERRQ(ierr);
137*8e6d0c30SPeter Brune   ierr = MatSetSizes(*G,f-s,f-s,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
138*8e6d0c30SPeter Brune   ierr = MatMPIAIJSetPreallocation(*G,0,lsparse,0,gsparse);CHKERRQ(ierr);
139*8e6d0c30SPeter Brune   ierr = MatSeqAIJSetPreallocation(*G,0,lsparse);CHKERRQ(ierr);
140*8e6d0c30SPeter Brune   for (r = s;r < f;r++) {
141*8e6d0c30SPeter Brune     ierr = MatGetRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
142*8e6d0c30SPeter Brune     idx = 0;
143*8e6d0c30SPeter Brune     for (c = 0; c < ncols; c++) {
144*8e6d0c30SPeter Brune       /* classical strength of connection */
145*8e6d0c30SPeter Brune       if (PetscAbsScalar(rval[c]) > gamg->threshold*Amax) {
146*8e6d0c30SPeter Brune         gcol[idx] = rcol[c];
147*8e6d0c30SPeter Brune         gval[idx] = rval[c];
148*8e6d0c30SPeter Brune         idx++;
149*8e6d0c30SPeter Brune       } else {
150*8e6d0c30SPeter Brune         gcol[idx] = rcol[c];
151*8e6d0c30SPeter Brune         gval[idx] = 0.;
152*8e6d0c30SPeter Brune         idx++;
153*8e6d0c30SPeter Brune       }
154*8e6d0c30SPeter Brune     }
155*8e6d0c30SPeter Brune     ierr = MatSetValues(*G,1,&r,idx,gcol,gval,INSERT_VALUES);CHKERRQ(ierr);
156*8e6d0c30SPeter Brune     ierr = MatRestoreRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr);
157*8e6d0c30SPeter Brune   }
158*8e6d0c30SPeter Brune   ierr = MatAssemblyBegin(*G, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
159*8e6d0c30SPeter Brune   ierr = MatAssemblyEnd(*G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
160*8e6d0c30SPeter Brune 
161*8e6d0c30SPeter Brune 
162*8e6d0c30SPeter Brune 
163*8e6d0c30SPeter Brune   ierr = PetscFree(gval);CHKERRQ(ierr);
164*8e6d0c30SPeter Brune   ierr = PetscFree(gcol);CHKERRQ(ierr);
165*8e6d0c30SPeter Brune   ierr = PetscFree(lsparse);CHKERRQ(ierr);
166*8e6d0c30SPeter Brune   ierr = PetscFree(gsparse);CHKERRQ(ierr);
167*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
168*8e6d0c30SPeter Brune }
169*8e6d0c30SPeter Brune 
170*8e6d0c30SPeter Brune 
171*8e6d0c30SPeter Brune #undef __FUNCT__
172*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGCoarsen_Classical"
173*8e6d0c30SPeter Brune PetscErrorCode PCGAMGCoarsen_Classical(PC pc,Mat *G,PetscCoarsenData **agg_lists)
174*8e6d0c30SPeter Brune {
175*8e6d0c30SPeter Brune   PetscErrorCode   ierr;
176*8e6d0c30SPeter Brune   MatCoarsen       crs;
177*8e6d0c30SPeter Brune   MPI_Comm         fcomm = ((PetscObject)pc)->comm;
178*8e6d0c30SPeter Brune 
179*8e6d0c30SPeter Brune   PetscFunctionBegin;
180*8e6d0c30SPeter Brune 
181*8e6d0c30SPeter Brune 
182*8e6d0c30SPeter Brune   /* construct the graph if necessary */
183*8e6d0c30SPeter Brune   if (!G) {
184*8e6d0c30SPeter Brune     SETERRQ(fcomm,PETSC_ERR_ARG_WRONGSTATE,"Must set Graph in PC in PCGAMG before coarsening");
185*8e6d0c30SPeter Brune   }
186*8e6d0c30SPeter Brune 
187*8e6d0c30SPeter Brune   ierr = MatCoarsenCreate(fcomm,&crs);CHKERRQ(ierr);
188*8e6d0c30SPeter Brune   ierr = MatCoarsenSetFromOptions(crs);CHKERRQ(ierr);
189*8e6d0c30SPeter Brune   ierr = MatCoarsenSetAdjacency(crs,*G);CHKERRQ(ierr);
190*8e6d0c30SPeter Brune   ierr = MatCoarsenSetStrictAggs(crs,PETSC_TRUE);CHKERRQ(ierr);
191*8e6d0c30SPeter Brune   ierr = MatCoarsenApply(crs);CHKERRQ(ierr);
192*8e6d0c30SPeter Brune   ierr = MatCoarsenGetData(crs,agg_lists);CHKERRQ(ierr);
193*8e6d0c30SPeter Brune   ierr = MatCoarsenDestroy(&crs);CHKERRQ(ierr);
194*8e6d0c30SPeter Brune 
195*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
196*8e6d0c30SPeter Brune }
197*8e6d0c30SPeter Brune 
198*8e6d0c30SPeter Brune #undef __FUNCT__
199*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGClassicalGhost"
200*8e6d0c30SPeter Brune /*
201*8e6d0c30SPeter Brune  Find all ghost nodes that are coarse and output the fine/coarse splitting for those as well
202*8e6d0c30SPeter Brune 
203*8e6d0c30SPeter Brune  Input:
204*8e6d0c30SPeter Brune  G - graph;
205*8e6d0c30SPeter Brune  gvec - Global Vector
206*8e6d0c30SPeter Brune  avec - Local part of the scattered vec
207*8e6d0c30SPeter Brune  bvec - Global part of the scattered vec
208*8e6d0c30SPeter Brune 
209*8e6d0c30SPeter Brune  Output:
210*8e6d0c30SPeter Brune  findx - indirection t
211*8e6d0c30SPeter Brune 
212*8e6d0c30SPeter Brune  */
213*8e6d0c30SPeter Brune PetscErrorCode PCGAMGClassicalGhost(Mat G,Vec v,Vec gv)
214*8e6d0c30SPeter Brune {
215*8e6d0c30SPeter Brune   PetscErrorCode ierr;
216*8e6d0c30SPeter Brune   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)G->data;
217*8e6d0c30SPeter Brune   PetscBool      isMPIAIJ;
218*8e6d0c30SPeter Brune 
219*8e6d0c30SPeter Brune   PetscFunctionBegin;
220*8e6d0c30SPeter Brune   ierr = PetscObjectTypeCompare((PetscObject)G, MATMPIAIJ, &isMPIAIJ ); CHKERRQ(ierr);
221*8e6d0c30SPeter Brune   if (isMPIAIJ) {
222*8e6d0c30SPeter Brune     ierr = VecScatterBegin(aij->Mvctx,v,gv,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
223*8e6d0c30SPeter Brune     ierr = VecScatterEnd(aij->Mvctx,v,gv,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
224*8e6d0c30SPeter Brune   }
225*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
226*8e6d0c30SPeter Brune }
227*8e6d0c30SPeter Brune 
228*8e6d0c30SPeter Brune #undef __FUNCT__
229*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGProlongator_Classical"
230*8e6d0c30SPeter Brune PetscErrorCode PCGAMGProlongator_Classical(PC pc, Mat A, Mat G, PetscCoarsenData *agg_lists,Mat *P)
231*8e6d0c30SPeter Brune {
232*8e6d0c30SPeter Brune   PetscErrorCode    ierr;
233*8e6d0c30SPeter Brune   MPI_Comm          comm;
234*8e6d0c30SPeter Brune   Mat               lG,gG,lA,gA;     /* on and off diagonal matrices */
235*8e6d0c30SPeter Brune   PetscInt          fn;                        /* fine local blocked sizes */
236*8e6d0c30SPeter Brune   PetscInt          cn;                        /* coarse local blocked sizes */
237*8e6d0c30SPeter Brune   PetscInt          gn;                        /* size of the off-diagonal fine vector */
238*8e6d0c30SPeter Brune   PetscInt          fs,fe;                     /* fine (row) ownership range*/
239*8e6d0c30SPeter Brune   PetscInt          cs,ce;                     /* coarse (column) ownership range */
240*8e6d0c30SPeter Brune   PetscInt          i,j,k;                     /* indices! */
241*8e6d0c30SPeter Brune   PetscBool         iscoarse;                  /* flag for determining if a node is coarse */
242*8e6d0c30SPeter Brune   PetscInt          *lcid,*gcid;               /* on and off-processor coarse unknown IDs */
243*8e6d0c30SPeter Brune   PetscInt          *lsparse,*gsparse;         /* on and off-processor sparsity patterns for prolongator */
244*8e6d0c30SPeter Brune   PetscScalar       pij;
245*8e6d0c30SPeter Brune   const PetscScalar *rval;
246*8e6d0c30SPeter Brune   const PetscInt    *rcol;
247*8e6d0c30SPeter Brune   PetscScalar       g_pos,g_neg,a_pos,a_neg,diag,invdiag,alpha,beta;
248*8e6d0c30SPeter Brune   Vec               F;   /* vec of coarse size */
249*8e6d0c30SPeter Brune   Vec               C;   /* vec of fine size */
250*8e6d0c30SPeter Brune   Vec               gF;  /* vec of off-diagonal fine size */
251*8e6d0c30SPeter Brune   MatType           mtype;
252*8e6d0c30SPeter Brune   PetscInt          c_indx;
253*8e6d0c30SPeter Brune   const PetscScalar *vcols;
254*8e6d0c30SPeter Brune   const PetscInt    *icols;
255*8e6d0c30SPeter Brune   PetscScalar       c_scalar;
256*8e6d0c30SPeter Brune   PetscInt          ncols,col;
257*8e6d0c30SPeter Brune   PetscInt          row_f,row_c;
258*8e6d0c30SPeter Brune   PetscInt          cmax=0,ncolstotal,idx;
259*8e6d0c30SPeter Brune   PetscScalar       *pvals;
260*8e6d0c30SPeter Brune   PetscInt          *pcols;
261*8e6d0c30SPeter Brune 
262*8e6d0c30SPeter Brune   PetscFunctionBegin;
263*8e6d0c30SPeter Brune   comm = ((PetscObject)pc)->comm;
264*8e6d0c30SPeter Brune   ierr = MatGetOwnershipRange(A,&fs,&fe); CHKERRQ(ierr);
265*8e6d0c30SPeter Brune   fn = (fe - fs);
266*8e6d0c30SPeter Brune 
267*8e6d0c30SPeter Brune   ierr = MatGetVecs(A,&F,NULL);CHKERRQ(ierr);
268*8e6d0c30SPeter Brune 
269*8e6d0c30SPeter Brune   /* get the number of local unknowns and the indices of the local unknowns */
270*8e6d0c30SPeter Brune 
271*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*fn,&lsparse);CHKERRQ(ierr);
272*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*fn,&gsparse);CHKERRQ(ierr);
273*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*fn,&lcid);CHKERRQ(ierr);
274*8e6d0c30SPeter Brune 
275*8e6d0c30SPeter Brune   /* count the number of coarse unknowns */
276*8e6d0c30SPeter Brune   cn = 0;
277*8e6d0c30SPeter Brune   for (i=0;i<fn;i++) {
278*8e6d0c30SPeter Brune     /* filter out singletons */
279*8e6d0c30SPeter Brune     ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr);
280*8e6d0c30SPeter Brune     lcid[i] = -1;
281*8e6d0c30SPeter Brune     if (!iscoarse) {
282*8e6d0c30SPeter Brune       cn++;
283*8e6d0c30SPeter Brune     }
284*8e6d0c30SPeter Brune   }
285*8e6d0c30SPeter Brune 
286*8e6d0c30SPeter Brune    /* create the coarse vector */
287*8e6d0c30SPeter Brune   ierr = VecCreateMPI(comm,cn,PETSC_DECIDE,&C);CHKERRQ(ierr);
288*8e6d0c30SPeter Brune   ierr = VecGetOwnershipRange(C,&cs,&ce);CHKERRQ(ierr);
289*8e6d0c30SPeter Brune 
290*8e6d0c30SPeter Brune   /* construct a global vector indicating the global indices of the coarse unknowns */
291*8e6d0c30SPeter Brune   cn = 0;
292*8e6d0c30SPeter Brune   for (i=0;i<fn;i++) {
293*8e6d0c30SPeter Brune     ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr);
294*8e6d0c30SPeter Brune     if (!iscoarse) {
295*8e6d0c30SPeter Brune       lcid[i] = cs+cn;
296*8e6d0c30SPeter Brune       cn++;
297*8e6d0c30SPeter Brune     } else {
298*8e6d0c30SPeter Brune       lcid[i] = -1;
299*8e6d0c30SPeter Brune     }
300*8e6d0c30SPeter Brune     c_scalar = (PetscScalar)lcid[i];
301*8e6d0c30SPeter Brune     c_indx = fs+i;
302*8e6d0c30SPeter Brune     ierr = VecSetValues(F,1,&c_indx,&c_scalar,INSERT_VALUES);CHKERRQ(ierr);
303*8e6d0c30SPeter Brune   }
304*8e6d0c30SPeter Brune 
305*8e6d0c30SPeter Brune   ierr = VecAssemblyBegin(F);CHKERRQ(ierr);
306*8e6d0c30SPeter Brune   ierr = VecAssemblyEnd(F);CHKERRQ(ierr);
307*8e6d0c30SPeter Brune 
308*8e6d0c30SPeter Brune   /* split the graph into two */
309*8e6d0c30SPeter Brune   ierr = PCGAMGClassicalGraphSplitting(G,&lG,&gG);CHKERRQ(ierr);
310*8e6d0c30SPeter Brune   ierr = PCGAMGClassicalGraphSplitting(A,&lA,&gA);CHKERRQ(ierr);
311*8e6d0c30SPeter Brune 
312*8e6d0c30SPeter Brune   /* scatter to the ghost vector */
313*8e6d0c30SPeter Brune   ierr = PCGAMGClassicalCreateGhostVector(G,&gF,NULL);CHKERRQ(ierr);
314*8e6d0c30SPeter Brune   ierr = PCGAMGClassicalGhost(G,F,gF);CHKERRQ(ierr);
315*8e6d0c30SPeter Brune 
316*8e6d0c30SPeter Brune   if (gG) {
317*8e6d0c30SPeter Brune     ierr = VecGetSize(gF,&gn);CHKERRQ(ierr);
318*8e6d0c30SPeter Brune     ierr = PetscMalloc(sizeof(PetscInt)*gn,&gcid);CHKERRQ(ierr);
319*8e6d0c30SPeter Brune     for (i=0;i<gn;i++) {
320*8e6d0c30SPeter Brune       ierr = VecGetValues(gF,1,&i,&c_scalar);CHKERRQ(ierr);
321*8e6d0c30SPeter Brune       gcid[i] = (PetscInt)PetscRealPart(c_scalar);
322*8e6d0c30SPeter Brune     }
323*8e6d0c30SPeter Brune   }
324*8e6d0c30SPeter Brune 
325*8e6d0c30SPeter Brune   ierr = VecDestroy(&F);CHKERRQ(ierr);
326*8e6d0c30SPeter Brune   ierr = VecDestroy(&gF);CHKERRQ(ierr);
327*8e6d0c30SPeter Brune   ierr = VecDestroy(&C);CHKERRQ(ierr);
328*8e6d0c30SPeter Brune 
329*8e6d0c30SPeter Brune   /* count the on and off processor sparsity patterns for the prolongator */
330*8e6d0c30SPeter Brune 
331*8e6d0c30SPeter Brune   for (i=0;i<fn;i++) {
332*8e6d0c30SPeter Brune     /* on */
333*8e6d0c30SPeter Brune     ierr = MatGetRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
334*8e6d0c30SPeter Brune     ncolstotal = ncols;
335*8e6d0c30SPeter Brune     lsparse[i] = 0;
336*8e6d0c30SPeter Brune     if (lcid[i] >= 0) {
337*8e6d0c30SPeter Brune       lsparse[i] = 1;
338*8e6d0c30SPeter Brune       gsparse[i] = 0;
339*8e6d0c30SPeter Brune     } else {
340*8e6d0c30SPeter Brune       for (j = 0;j < ncols;j++) {
341*8e6d0c30SPeter Brune         col = icols[j];
342*8e6d0c30SPeter Brune         if (lcid[col] >= 0 && vcols[j] != 0.) {
343*8e6d0c30SPeter Brune           lsparse[i] += 1;
344*8e6d0c30SPeter Brune         }
345*8e6d0c30SPeter Brune       }
346*8e6d0c30SPeter Brune 
347*8e6d0c30SPeter Brune       ierr = MatRestoreRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
348*8e6d0c30SPeter Brune       ncolstotal += ncols;
349*8e6d0c30SPeter Brune       /* off */
350*8e6d0c30SPeter Brune       gsparse[i] = 0;
351*8e6d0c30SPeter Brune       if (gG) {
352*8e6d0c30SPeter Brune         ierr = MatGetRow(gG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
353*8e6d0c30SPeter Brune         for (j = 0; j < ncols; j++) {
354*8e6d0c30SPeter Brune           col = icols[j];
355*8e6d0c30SPeter Brune           if (gcid[col] >= 0 && vcols[j] != 0.) {
356*8e6d0c30SPeter Brune             gsparse[i] += 1;
357*8e6d0c30SPeter Brune           }
358*8e6d0c30SPeter Brune         }
359*8e6d0c30SPeter Brune         ierr = MatRestoreRow(gG,i,&ncols,NULL,NULL);CHKERRQ(ierr);
360*8e6d0c30SPeter Brune       }
361*8e6d0c30SPeter Brune       if (ncolstotal > cmax) cmax = ncolstotal;
362*8e6d0c30SPeter Brune     }
363*8e6d0c30SPeter Brune   }
364*8e6d0c30SPeter Brune 
365*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscInt)*cmax,&pcols);CHKERRQ(ierr);
366*8e6d0c30SPeter Brune   ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&pvals);CHKERRQ(ierr);
367*8e6d0c30SPeter Brune 
368*8e6d0c30SPeter Brune   /* preallocate and create the prolongator */
369*8e6d0c30SPeter Brune   ierr = MatCreate(comm,P); CHKERRQ(ierr);
370*8e6d0c30SPeter Brune   ierr = MatGetType(G,&mtype);CHKERRQ(ierr);
371*8e6d0c30SPeter Brune   ierr = MatSetType(*P,mtype);CHKERRQ(ierr);
372*8e6d0c30SPeter Brune 
373*8e6d0c30SPeter Brune   ierr = MatSetSizes(*P,fn,cn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
374*8e6d0c30SPeter Brune   ierr = MatMPIAIJSetPreallocation(*P,0,lsparse,0,gsparse);CHKERRQ(ierr);
375*8e6d0c30SPeter Brune   ierr = MatSeqAIJSetPreallocation(*P,0,lsparse);CHKERRQ(ierr);
376*8e6d0c30SPeter Brune 
377*8e6d0c30SPeter Brune   /* loop over local fine nodes -- get the diagonal, the sum of positive and negative strong and weak weights, and set up the row */
378*8e6d0c30SPeter Brune   for (i = 0;i < fn;i++) {
379*8e6d0c30SPeter Brune     /* determine on or off */
380*8e6d0c30SPeter Brune     row_f = i + fs;
381*8e6d0c30SPeter Brune     row_c = lcid[i];
382*8e6d0c30SPeter Brune     if (row_c >= 0) {
383*8e6d0c30SPeter Brune       pij = 1.;
384*8e6d0c30SPeter Brune       ierr = MatSetValues(*P,1,&row_f,1,&row_c,&pij,INSERT_VALUES);CHKERRQ(ierr);
385*8e6d0c30SPeter Brune     } else {
386*8e6d0c30SPeter Brune       g_pos = 0.;
387*8e6d0c30SPeter Brune       g_neg = 0.;
388*8e6d0c30SPeter Brune       a_pos = 0.;
389*8e6d0c30SPeter Brune       a_neg = 0.;
390*8e6d0c30SPeter Brune       diag = 0.;
391*8e6d0c30SPeter Brune 
392*8e6d0c30SPeter Brune       /* local strong connections */
393*8e6d0c30SPeter Brune       ierr = MatGetRow(lG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
394*8e6d0c30SPeter Brune       for (k = 0; k < ncols; k++) {
395*8e6d0c30SPeter Brune         if (PetscRealPart(rval[k]) > 0) {
396*8e6d0c30SPeter Brune           g_pos += rval[k];
397*8e6d0c30SPeter Brune         } else {
398*8e6d0c30SPeter Brune           g_neg += rval[k];
399*8e6d0c30SPeter Brune         }
400*8e6d0c30SPeter Brune       }
401*8e6d0c30SPeter Brune       ierr = MatRestoreRow(lG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
402*8e6d0c30SPeter Brune 
403*8e6d0c30SPeter Brune 
404*8e6d0c30SPeter Brune       /* ghosted strong connections */
405*8e6d0c30SPeter Brune       if (gG) {
406*8e6d0c30SPeter Brune         ierr = MatGetRow(gG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
407*8e6d0c30SPeter Brune         for (k = 0; k < ncols; k++) {
408*8e6d0c30SPeter Brune           if (PetscRealPart(rval[k]) > 0.) {
409*8e6d0c30SPeter Brune             g_pos += PetscRealPart(rval[k]);
410*8e6d0c30SPeter Brune           } else {
411*8e6d0c30SPeter Brune             g_neg += PetscRealPart(rval[k]);
412*8e6d0c30SPeter Brune           }
413*8e6d0c30SPeter Brune         }
414*8e6d0c30SPeter Brune         ierr = MatRestoreRow(gG,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
415*8e6d0c30SPeter Brune       }
416*8e6d0c30SPeter Brune 
417*8e6d0c30SPeter Brune       /* local all connections */
418*8e6d0c30SPeter Brune       ierr = MatGetRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
419*8e6d0c30SPeter Brune       for (k = 0; k < ncols; k++) {
420*8e6d0c30SPeter Brune         if (PetscRealPart(rval[k]) > 0) {
421*8e6d0c30SPeter Brune           a_pos += PetscRealPart(rval[k]);
422*8e6d0c30SPeter Brune         } else {
423*8e6d0c30SPeter Brune           a_neg += PetscRealPart(rval[k]);
424*8e6d0c30SPeter Brune         }
425*8e6d0c30SPeter Brune         if (rcol[k] == i) {
426*8e6d0c30SPeter Brune           diag = PetscRealPart(rval[k]);
427*8e6d0c30SPeter Brune         }
428*8e6d0c30SPeter Brune       }
429*8e6d0c30SPeter Brune       ierr = MatRestoreRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
430*8e6d0c30SPeter Brune 
431*8e6d0c30SPeter Brune       /* ghosted all connections */
432*8e6d0c30SPeter Brune       if (gA) {
433*8e6d0c30SPeter Brune         ierr = MatGetRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
434*8e6d0c30SPeter Brune         for (k = 0; k < ncols; k++) {
435*8e6d0c30SPeter Brune           if (PetscRealPart(rval[k]) > 0.) {
436*8e6d0c30SPeter Brune             a_pos += PetscRealPart(rval[k]);
437*8e6d0c30SPeter Brune           } else {
438*8e6d0c30SPeter Brune             a_neg += PetscRealPart(rval[k]);
439*8e6d0c30SPeter Brune           }
440*8e6d0c30SPeter Brune         }
441*8e6d0c30SPeter Brune         ierr = MatRestoreRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr);
442*8e6d0c30SPeter Brune       }
443*8e6d0c30SPeter Brune 
444*8e6d0c30SPeter Brune       if (g_neg == 0.) {
445*8e6d0c30SPeter Brune         alpha = 0.;
446*8e6d0c30SPeter Brune       } else {
447*8e6d0c30SPeter Brune         alpha = -a_neg/g_neg;
448*8e6d0c30SPeter Brune       }
449*8e6d0c30SPeter Brune 
450*8e6d0c30SPeter Brune       if (g_pos == 0.) {
451*8e6d0c30SPeter Brune         diag += a_pos;
452*8e6d0c30SPeter Brune         beta = 0.;
453*8e6d0c30SPeter Brune       } else {
454*8e6d0c30SPeter Brune         beta = -a_pos/g_pos;
455*8e6d0c30SPeter Brune       }
456*8e6d0c30SPeter Brune 
457*8e6d0c30SPeter Brune       invdiag = 1. / diag;
458*8e6d0c30SPeter Brune       /* on */
459*8e6d0c30SPeter Brune       ierr = MatGetRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
460*8e6d0c30SPeter Brune       idx = 0;
461*8e6d0c30SPeter Brune       for (j = 0;j < ncols;j++) {
462*8e6d0c30SPeter Brune         col = icols[j];
463*8e6d0c30SPeter Brune         if (lcid[col] >= 0 && vcols[j] != 0.) {
464*8e6d0c30SPeter Brune           row_f = i + fs;
465*8e6d0c30SPeter Brune           row_c = lcid[col];
466*8e6d0c30SPeter Brune           /* set the values for on-processor ones */
467*8e6d0c30SPeter Brune           if (PetscRealPart(vcols[j]) < 0.) {
468*8e6d0c30SPeter Brune             pij = vcols[j]*alpha*invdiag;
469*8e6d0c30SPeter Brune           } else {
470*8e6d0c30SPeter Brune             pij = vcols[j]*beta*invdiag;
471*8e6d0c30SPeter Brune           }
472*8e6d0c30SPeter Brune           if (PetscAbsScalar(pij) != 0.) {
473*8e6d0c30SPeter Brune             pvals[idx] = pij;
474*8e6d0c30SPeter Brune             pcols[idx] = row_c;
475*8e6d0c30SPeter Brune             idx++;
476*8e6d0c30SPeter Brune           }
477*8e6d0c30SPeter Brune         }
478*8e6d0c30SPeter Brune       }
479*8e6d0c30SPeter Brune       ierr = MatRestoreRow(lG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
480*8e6d0c30SPeter Brune       /* off */
481*8e6d0c30SPeter Brune       if (gG) {
482*8e6d0c30SPeter Brune         ierr = MatGetRow(gG,i,&ncols,&icols,&vcols);CHKERRQ(ierr);
483*8e6d0c30SPeter Brune         for (j = 0; j < ncols; j++) {
484*8e6d0c30SPeter Brune           col = icols[j];
485*8e6d0c30SPeter Brune           if (gcid[col] >= 0 && vcols[j] != 0.) {
486*8e6d0c30SPeter Brune             row_f = i + fs;
487*8e6d0c30SPeter Brune             row_c = gcid[col];
488*8e6d0c30SPeter Brune             /* set the values for on-processor ones */
489*8e6d0c30SPeter Brune             if (PetscRealPart(vcols[j]) < 0.) {
490*8e6d0c30SPeter Brune               pij = vcols[j]*alpha*invdiag;
491*8e6d0c30SPeter Brune             } else {
492*8e6d0c30SPeter Brune               pij = vcols[j]*beta*invdiag;
493*8e6d0c30SPeter Brune             }
494*8e6d0c30SPeter Brune             if (PetscAbsScalar(pij) != 0.) {
495*8e6d0c30SPeter Brune               pvals[idx] = pij;
496*8e6d0c30SPeter Brune               pcols[idx] = row_c;
497*8e6d0c30SPeter Brune               idx++;
498*8e6d0c30SPeter Brune             }
499*8e6d0c30SPeter Brune           }
500*8e6d0c30SPeter Brune         }
501*8e6d0c30SPeter Brune         ierr = MatSetValues(*P,1,&row_f,idx,pcols,pvals,INSERT_VALUES);CHKERRQ(ierr);
502*8e6d0c30SPeter Brune         ierr = MatRestoreRow(gG,i,&ncols,NULL,NULL);CHKERRQ(ierr);
503*8e6d0c30SPeter Brune       }
504*8e6d0c30SPeter Brune     }
505*8e6d0c30SPeter Brune   }
506*8e6d0c30SPeter Brune   ierr = MatAssemblyBegin(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
507*8e6d0c30SPeter Brune   ierr = MatAssemblyEnd(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
508*8e6d0c30SPeter Brune 
509*8e6d0c30SPeter Brune   ierr = PetscFree(lsparse);CHKERRQ(ierr);
510*8e6d0c30SPeter Brune   ierr = PetscFree(gsparse);CHKERRQ(ierr);
511*8e6d0c30SPeter Brune   ierr = PetscFree(pcols);CHKERRQ(ierr);
512*8e6d0c30SPeter Brune   ierr = PetscFree(pvals);CHKERRQ(ierr);
513*8e6d0c30SPeter Brune   ierr = PetscFree(lcid);CHKERRQ(ierr);
514*8e6d0c30SPeter Brune   if (gG) {ierr = PetscFree(gcid);CHKERRQ(ierr);}
515*8e6d0c30SPeter Brune 
516*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
517*8e6d0c30SPeter Brune }
518*8e6d0c30SPeter Brune 
519*8e6d0c30SPeter Brune #undef __FUNCT__
520*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGDestroy_Classical"
521*8e6d0c30SPeter Brune PetscErrorCode PCGAMGDestroy_Classical(PC pc)
522*8e6d0c30SPeter Brune {
523*8e6d0c30SPeter Brune   PetscErrorCode ierr;
524*8e6d0c30SPeter Brune   PC_MG          *mg          = (PC_MG*)pc->data;
525*8e6d0c30SPeter Brune   PC_GAMG        *pc_gamg     = (PC_GAMG*)mg->innerctx;
526*8e6d0c30SPeter Brune 
527*8e6d0c30SPeter Brune   PetscFunctionBegin;
528*8e6d0c30SPeter Brune   ierr = PetscFree(pc_gamg->subctx);CHKERRQ(ierr);
529*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
530*8e6d0c30SPeter Brune }
531*8e6d0c30SPeter Brune 
532*8e6d0c30SPeter Brune #undef __FUNCT__
533*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGSetFromOptions_Classical"
534*8e6d0c30SPeter Brune PetscErrorCode PCGAMGSetFromOptions_Classical(PC pc)
535*8e6d0c30SPeter Brune {
536*8e6d0c30SPeter Brune   PetscFunctionBegin;
537*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
538*8e6d0c30SPeter Brune }
539*8e6d0c30SPeter Brune 
540*8e6d0c30SPeter Brune #undef __FUNCT__
541*8e6d0c30SPeter Brune #define __FUNCT__ "PCGAMGSetData_Classical"
542*8e6d0c30SPeter Brune PetscErrorCode PCGAMGSetData_Classical(PC pc, Mat A)
543*8e6d0c30SPeter Brune {
544*8e6d0c30SPeter Brune   PC_MG          *mg      = (PC_MG*)pc->data;
545*8e6d0c30SPeter Brune   PC_GAMG        *pc_gamg = (PC_GAMG*)mg->innerctx;
546*8e6d0c30SPeter Brune 
547*8e6d0c30SPeter Brune   PetscFunctionBegin;
548*8e6d0c30SPeter Brune   /* no data for classical AMG */
549*8e6d0c30SPeter Brune   pc_gamg->data           = NULL;
550*8e6d0c30SPeter Brune   pc_gamg->data_cell_cols = 1;
551*8e6d0c30SPeter Brune   pc_gamg->data_cell_rows = 1;
552*8e6d0c30SPeter Brune   pc_gamg->data_sz = 0;
553*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
554*8e6d0c30SPeter Brune }
555*8e6d0c30SPeter Brune 
556*8e6d0c30SPeter Brune /* -------------------------------------------------------------------------- */
557*8e6d0c30SPeter Brune /*
558*8e6d0c30SPeter Brune    PCCreateGAMG_Classical
559*8e6d0c30SPeter Brune 
560*8e6d0c30SPeter Brune */
561*8e6d0c30SPeter Brune #undef __FUNCT__
562*8e6d0c30SPeter Brune #define __FUNCT__ "PCCreateGAMG_Classical"
563*8e6d0c30SPeter Brune PetscErrorCode  PCCreateGAMG_Classical(PC pc)
564*8e6d0c30SPeter Brune {
565*8e6d0c30SPeter Brune   PetscErrorCode ierr;
566*8e6d0c30SPeter Brune   PC_MG             *mg      = (PC_MG*)pc->data;
567*8e6d0c30SPeter Brune   PC_GAMG           *pc_gamg = (PC_GAMG*)mg->innerctx;
568*8e6d0c30SPeter Brune   PC_GAMG_Classical *pc_gamg_classical;
569*8e6d0c30SPeter Brune 
570*8e6d0c30SPeter Brune   PetscFunctionBegin;
571*8e6d0c30SPeter Brune   if (pc_gamg->subctx) {
572*8e6d0c30SPeter Brune     /* call base class */
573*8e6d0c30SPeter Brune     ierr = PCDestroy_GAMG(pc);CHKERRQ(ierr);
574*8e6d0c30SPeter Brune   }
575*8e6d0c30SPeter Brune 
576*8e6d0c30SPeter Brune   /* create sub context for SA */
577*8e6d0c30SPeter Brune   ierr = PetscNewLog(pc, PC_GAMG_Classical, &pc_gamg_classical);CHKERRQ(ierr);
578*8e6d0c30SPeter Brune   pc_gamg->subctx = pc_gamg_classical;
579*8e6d0c30SPeter Brune   pc->ops->setfromoptions = PCGAMGSetFromOptions_Classical;
580*8e6d0c30SPeter Brune   /* reset does not do anything; setup not virtual */
581*8e6d0c30SPeter Brune 
582*8e6d0c30SPeter Brune   /* set internal function pointers */
583*8e6d0c30SPeter Brune   pc_gamg->ops->destroy     = PCGAMGDestroy_Classical;
584*8e6d0c30SPeter Brune   pc_gamg->ops->graph       = PCGAMGGraph_Classical;
585*8e6d0c30SPeter Brune   pc_gamg->ops->coarsen     = PCGAMGCoarsen_Classical;
586*8e6d0c30SPeter Brune   pc_gamg->ops->prolongator = PCGAMGProlongator_Classical;
587*8e6d0c30SPeter Brune   pc_gamg->ops->optprol     = NULL;
588*8e6d0c30SPeter Brune   pc_gamg->ops->formkktprol = NULL;
589*8e6d0c30SPeter Brune 
590*8e6d0c30SPeter Brune   pc_gamg->ops->createdefaultdata = PCGAMGSetData_Classical;
591*8e6d0c30SPeter Brune   PetscFunctionReturn(0);
592*8e6d0c30SPeter Brune }
593