xref: /petsc/src/ksp/pc/impls/gamg/agg.c (revision 206f7c91e9f27f5ebda8b3a10559db99accbf25c)
1 /*
2  GAMG geometric-algebric multiogrid PC - Mark Adams 2011
3  */
4 
5 #include <../src/ksp/pc/impls/gamg/gamg.h>        /*I "petscpc.h" I*/
6 /*  Next line needed to deactivate KSP_Solve logging */
7 #include <petsc/private/kspimpl.h>
8 #include <petscblaslapack.h>
9 #include <petscdm.h>
10 
11 typedef struct {
12   PetscInt  nsmooths;
13   PetscBool sym_graph;
14   PetscInt  square_graph;
15 } PC_GAMG_AGG;
16 
17 #undef __FUNCT__
18 #define __FUNCT__ "PCGAMGSetNSmooths"
19 /*@
20    PCGAMGSetNSmooths - Set number of smoothing steps (1 is typical)
21 
22    Not Collective on PC
23 
24    Input Parameters:
25 .  pc - the preconditioner context
26 
27    Options Database Key:
28 .  -pc_gamg_agg_nsmooths <nsmooth, default=1> - number of smoothing steps to use with smooth aggregation
29 
30    Level: intermediate
31 
32    Concepts: Aggregation AMG preconditioner
33 
34 .seealso: ()
35 @*/
36 PetscErrorCode PCGAMGSetNSmooths(PC pc, PetscInt n)
37 {
38   PetscErrorCode ierr;
39 
40   PetscFunctionBegin;
41   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
42   ierr = PetscTryMethod(pc,"PCGAMGSetNSmooths_C",(PC,PetscInt),(pc,n));CHKERRQ(ierr);
43   PetscFunctionReturn(0);
44 }
45 
46 #undef __FUNCT__
47 #define __FUNCT__ "PCGAMGSetNSmooths_AGG"
48 static PetscErrorCode PCGAMGSetNSmooths_AGG(PC pc, PetscInt n)
49 {
50   PC_MG       *mg          = (PC_MG*)pc->data;
51   PC_GAMG     *pc_gamg     = (PC_GAMG*)mg->innerctx;
52   PC_GAMG_AGG *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
53 
54   PetscFunctionBegin;
55   pc_gamg_agg->nsmooths = n;
56   PetscFunctionReturn(0);
57 }
58 
59 #undef __FUNCT__
60 #define __FUNCT__ "PCGAMGSetSymGraph"
61 /*@
62    PCGAMGSetSymGraph - Symmetrize the graph before computing the aggregation. Some algorithms require the graph be symmetric
63 
64    Not Collective on PC
65 
66    Input Parameters:
67 +  pc - the preconditioner context
68 .  n - PETSC_TRUE or PETSC_FALSE
69 
70    Options Database Key:
71 .  -pc_gamg_sym_graph <true,default=false> - symmetrize the graph before computing the aggregation
72 
73    Level: intermediate
74 
75    Concepts: Aggregation AMG preconditioner
76 
77 .seealso: PCGAMGSetSquareGraph()
78 @*/
79 PetscErrorCode PCGAMGSetSymGraph(PC pc, PetscBool n)
80 {
81   PetscErrorCode ierr;
82 
83   PetscFunctionBegin;
84   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
85   ierr = PetscTryMethod(pc,"PCGAMGSetSymGraph_C",(PC,PetscBool),(pc,n));CHKERRQ(ierr);
86   PetscFunctionReturn(0);
87 }
88 
89 #undef __FUNCT__
90 #define __FUNCT__ "PCGAMGSetSymGraph_AGG"
91 static PetscErrorCode PCGAMGSetSymGraph_AGG(PC pc, PetscBool n)
92 {
93   PC_MG       *mg          = (PC_MG*)pc->data;
94   PC_GAMG     *pc_gamg     = (PC_GAMG*)mg->innerctx;
95   PC_GAMG_AGG *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
96 
97   PetscFunctionBegin;
98   pc_gamg_agg->sym_graph = n;
99   PetscFunctionReturn(0);
100 }
101 
102 #undef __FUNCT__
103 #define __FUNCT__ "PCGAMGSetSquareGraph"
104 /*@
105    PCGAMGSetSquareGraph -  Square the graph, ie. compute A'*A before aggregating it
106 
107    Not Collective on PC
108 
109    Input Parameters:
110 +  pc - the preconditioner context
111 -  n - PETSC_TRUE or PETSC_FALSE
112 
113    Options Database Key:
114 .  -pc_gamg_square_graph <n,default = 1> - number of levels to square the graph on before aggregating it
115 
116    Level: intermediate
117 
118    Concepts: Aggregation AMG preconditioner
119 
120 .seealso: PCGAMGSetSymGraph()
121 @*/
122 PetscErrorCode PCGAMGSetSquareGraph(PC pc, PetscInt n)
123 {
124   PetscErrorCode ierr;
125 
126   PetscFunctionBegin;
127   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
128   ierr = PetscTryMethod(pc,"PCGAMGSetSquareGraph_C",(PC,PetscInt),(pc,n));CHKERRQ(ierr);
129   PetscFunctionReturn(0);
130 }
131 
132 #undef __FUNCT__
133 #define __FUNCT__ "PCGAMGSetSquareGraph_AGG"
134 static PetscErrorCode PCGAMGSetSquareGraph_AGG(PC pc, PetscInt n)
135 {
136   PC_MG       *mg          = (PC_MG*)pc->data;
137   PC_GAMG     *pc_gamg     = (PC_GAMG*)mg->innerctx;
138   PC_GAMG_AGG *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
139 
140   PetscFunctionBegin;
141   pc_gamg_agg->square_graph = n;
142   PetscFunctionReturn(0);
143 }
144 
145 #undef __FUNCT__
146 #define __FUNCT__ "PCSetFromOptions_GAMG_AGG"
147 static PetscErrorCode PCSetFromOptions_GAMG_AGG(PetscOptionItems *PetscOptionsObject,PC pc)
148 {
149   PetscErrorCode ierr;
150   PC_MG          *mg          = (PC_MG*)pc->data;
151   PC_GAMG        *pc_gamg     = (PC_GAMG*)mg->innerctx;
152   PC_GAMG_AGG    *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
153 
154   PetscFunctionBegin;
155   ierr = PetscOptionsHead(PetscOptionsObject,"GAMG-AGG options");CHKERRQ(ierr);
156   {
157     ierr = PetscOptionsInt("-pc_gamg_agg_nsmooths","smoothing steps for smoothed aggregation, usually 1","PCGAMGSetNSmooths",pc_gamg_agg->nsmooths,&pc_gamg_agg->nsmooths,NULL);CHKERRQ(ierr);
158     ierr = PetscOptionsBool("-pc_gamg_sym_graph","Set for asymmetric matrices","PCGAMGSetSymGraph",pc_gamg_agg->sym_graph,&pc_gamg_agg->sym_graph,NULL);CHKERRQ(ierr);
159     ierr = PetscOptionsInt("-pc_gamg_square_graph","Number of levels to square graph for faster coarsening and lower coarse grid complexity","PCGAMGSetSquareGraph",pc_gamg_agg->square_graph,&pc_gamg_agg->square_graph,NULL);CHKERRQ(ierr);
160   }
161   ierr = PetscOptionsTail();CHKERRQ(ierr);
162   PetscFunctionReturn(0);
163 }
164 
165 /* -------------------------------------------------------------------------- */
166 #undef __FUNCT__
167 #define __FUNCT__ "PCDestroy_GAMG_AGG"
168 static PetscErrorCode PCDestroy_GAMG_AGG(PC pc)
169 {
170   PetscErrorCode ierr;
171   PC_MG          *mg          = (PC_MG*)pc->data;
172   PC_GAMG        *pc_gamg     = (PC_GAMG*)mg->innerctx;
173 
174   PetscFunctionBegin;
175   ierr = PetscFree(pc_gamg->subctx);CHKERRQ(ierr);
176   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCSetCoordinates_C",NULL);CHKERRQ(ierr);
177   PetscFunctionReturn(0);
178 }
179 
180 /* -------------------------------------------------------------------------- */
181 /*
182    PCSetCoordinates_AGG
183      - collective
184 
185    Input Parameter:
186    . pc - the preconditioner context
187    . ndm - dimesion of data (used for dof/vertex for Stokes)
188    . a_nloc - number of vertices local
189    . coords - [a_nloc][ndm] - interleaved coordinate data: {x_0, y_0, z_0, x_1, y_1, ...}
190 */
191 
192 #undef __FUNCT__
193 #define __FUNCT__ "PCSetCoordinates_AGG"
194 static PetscErrorCode PCSetCoordinates_AGG(PC pc, PetscInt ndm, PetscInt a_nloc, PetscReal *coords)
195 {
196   PC_MG          *mg      = (PC_MG*)pc->data;
197   PC_GAMG        *pc_gamg = (PC_GAMG*)mg->innerctx;
198   PetscErrorCode ierr;
199   PetscInt       arrsz,kk,ii,jj,nloc,ndatarows,ndf;
200   Mat            mat = pc->pmat;
201 
202   PetscFunctionBegin;
203   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
204   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
205   nloc = a_nloc;
206 
207   /* SA: null space vectors */
208   ierr = MatGetBlockSize(mat, &ndf);CHKERRQ(ierr); /* this does not work for Stokes */
209   if (coords && ndf==1) pc_gamg->data_cell_cols = 1; /* scalar w/ coords and SA (not needed) */
210   else if (coords) {
211     if (ndm > ndf) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"degrees of motion %d > block size %d",ndm,ndf);
212     pc_gamg->data_cell_cols = (ndm==2 ? 3 : 6); /* displacement elasticity */
213     if (ndm != ndf) {
214       if (pc_gamg->data_cell_cols != ndf) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Don't know how to create null space for ndm=%d, ndf=%d.  Use MatSetNearNullSpace.",ndm,ndf);
215     }
216   } else pc_gamg->data_cell_cols = ndf; /* no data, force SA with constant null space vectors */
217   pc_gamg->data_cell_rows = ndatarows = ndf;
218   if (pc_gamg->data_cell_cols <= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"pc_gamg->data_cell_cols %D <= 0",pc_gamg->data_cell_cols);
219   arrsz = nloc*pc_gamg->data_cell_rows*pc_gamg->data_cell_cols;
220 
221   /* create data - syntactic sugar that should be refactored at some point */
222   if (!pc_gamg->data || (pc_gamg->data_sz != arrsz)) {
223     ierr = PetscFree(pc_gamg->data);CHKERRQ(ierr);
224     ierr = PetscMalloc1(arrsz+1, &pc_gamg->data);CHKERRQ(ierr);
225   }
226   /* copy data in - column oriented */
227   for (kk=0; kk<nloc; kk++) {
228     const PetscInt M     = nloc*pc_gamg->data_cell_rows; /* stride into data */
229     PetscReal      *data = &pc_gamg->data[kk*ndatarows]; /* start of cell */
230     if (pc_gamg->data_cell_cols==1) *data = 1.0;
231     else {
232       /* translational modes */
233       for (ii=0;ii<ndatarows;ii++) {
234         for (jj=0;jj<ndatarows;jj++) {
235           if (ii==jj)data[ii*M + jj] = 1.0;
236           else data[ii*M + jj] = 0.0;
237         }
238       }
239 
240       /* rotational modes */
241       if (coords) {
242         if (ndm == 2) {
243           data   += 2*M;
244           data[0] = -coords[2*kk+1];
245           data[1] =  coords[2*kk];
246         } else {
247           data   += 3*M;
248           data[0] = 0.0;             data[M+0] =  coords[3*kk+2]; data[2*M+0] = -coords[3*kk+1];
249           data[1] = -coords[3*kk+2]; data[M+1] = 0.0;             data[2*M+1] =  coords[3*kk];
250           data[2] =  coords[3*kk+1]; data[M+2] = -coords[3*kk];   data[2*M+2] = 0.0;
251         }
252       }
253     }
254   }
255 
256   pc_gamg->data_sz = arrsz;
257   PetscFunctionReturn(0);
258 }
259 
260 typedef PetscInt NState;
261 static const NState NOT_DONE=-2;
262 static const NState DELETED =-1;
263 static const NState REMOVED =-3;
264 #define IS_SELECTED(s) (s!=DELETED && s!=NOT_DONE && s!=REMOVED)
265 
266 /* -------------------------------------------------------------------------- */
267 /*
268    smoothAggs - greedy grab of with G1 (unsquared graph) -- AIJ specific
269      - AGG-MG specific: clears singletons out of 'selected_2'
270 
271    Input Parameter:
272    . Gmat_2 - glabal matrix of graph (data not defined)   base (squared) graph
273    . Gmat_1 - base graph to grab with                 base graph
274    Input/Output Parameter:
275    . aggs_2 - linked list of aggs with gids)
276 */
277 #undef __FUNCT__
278 #define __FUNCT__ "smoothAggs"
279 static PetscErrorCode smoothAggs(Mat Gmat_2, Mat Gmat_1,PetscCoarsenData *aggs_2)
280 {
281   PetscErrorCode ierr;
282   PetscBool      isMPI;
283   Mat_SeqAIJ     *matA_1, *matB_1=0, *matA_2, *matB_2=0;
284   MPI_Comm       comm;
285   PetscInt       lid,*ii,*idx,ix,Iend,my0,kk,n,j;
286   Mat_MPIAIJ     *mpimat_2 = 0, *mpimat_1=0;
287   const PetscInt nloc      = Gmat_2->rmap->n;
288   PetscScalar    *cpcol_1_state,*cpcol_2_state,*cpcol_2_par_orig,*lid_parent_gid;
289   PetscInt       *lid_cprowID_1;
290   NState         *lid_state;
291   Vec            ghost_par_orig2;
292 
293   PetscFunctionBegin;
294   ierr = PetscObjectGetComm((PetscObject)Gmat_2,&comm);CHKERRQ(ierr);
295   ierr = MatGetOwnershipRange(Gmat_1,&my0,&Iend);CHKERRQ(ierr);
296 
297   if (PETSC_FALSE) {
298     PetscViewer viewer; char fname[32]; static int llev=0;
299     sprintf(fname,"Gmat2_%d.m",llev++);
300     PetscViewerASCIIOpen(comm,fname,&viewer);
301     ierr = PetscViewerPushFormat(viewer, PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
302     ierr = MatView(Gmat_2, viewer);CHKERRQ(ierr);
303     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
304     ierr = PetscViewerDestroy(&viewer);
305   }
306 
307   /* get submatrices */
308   ierr = PetscObjectTypeCompare((PetscObject)Gmat_1, MATMPIAIJ, &isMPI);CHKERRQ(ierr);
309   if (isMPI) {
310     /* grab matrix objects */
311     mpimat_2 = (Mat_MPIAIJ*)Gmat_2->data;
312     mpimat_1 = (Mat_MPIAIJ*)Gmat_1->data;
313     matA_1   = (Mat_SeqAIJ*)mpimat_1->A->data;
314     matB_1   = (Mat_SeqAIJ*)mpimat_1->B->data;
315     matA_2   = (Mat_SeqAIJ*)mpimat_2->A->data;
316     matB_2   = (Mat_SeqAIJ*)mpimat_2->B->data;
317 
318     /* force compressed row storage for B matrix in AuxMat */
319     ierr = MatCheckCompressedRow(mpimat_1->B,matB_1->nonzerorowcnt,&matB_1->compressedrow,matB_1->i,Gmat_1->rmap->n,-1.0);CHKERRQ(ierr);
320 
321     ierr = PetscMalloc1(nloc, &lid_cprowID_1);CHKERRQ(ierr);
322     for (lid = 0; lid < nloc; lid++) lid_cprowID_1[lid] = -1;
323     for (ix=0; ix<matB_1->compressedrow.nrows; ix++) {
324       PetscInt lid = matB_1->compressedrow.rindex[ix];
325       lid_cprowID_1[lid] = ix;
326     }
327   } else {
328     PetscBool        isAIJ;
329     ierr = PetscObjectTypeCompare((PetscObject)Gmat_1,MATSEQAIJ,&isAIJ);CHKERRQ(ierr);
330     if (!isAIJ) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Require AIJ matrix.");
331     matA_1        = (Mat_SeqAIJ*)Gmat_1->data;
332     matA_2        = (Mat_SeqAIJ*)Gmat_2->data;
333     lid_cprowID_1 = NULL;
334   }
335   if (nloc>0) {
336     if (!(!matB_1 || matB_1->compressedrow.use)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"!(matB_1==0 || matB_1->compressedrow.use)");
337     if (!(!matB_2 || matB_2->compressedrow.use)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"!(matB_2==0 || matB_2->compressedrow.use)");
338   }
339   /* get state of locals and selected gid for deleted */
340   ierr = PetscMalloc2(nloc, &lid_state,nloc, &lid_parent_gid);CHKERRQ(ierr);
341   for (lid = 0; lid < nloc; lid++) {
342     lid_parent_gid[lid] = -1.0;
343     lid_state[lid]      = DELETED;
344   }
345 
346   /* set lid_state */
347   for (lid = 0; lid < nloc; lid++) {
348     PetscCDIntNd *pos;
349     ierr = PetscCDGetHeadPos(aggs_2,lid,&pos);CHKERRQ(ierr);
350     if (pos) {
351       PetscInt gid1;
352 
353       ierr = PetscCDIntNdGetID(pos, &gid1);CHKERRQ(ierr);
354       if (gid1 != lid+my0) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"gid1 %D != lid %D + my0 %D",gid1,lid,my0);
355       lid_state[lid] = gid1;
356     }
357   }
358 
359   /* map local to selected local, DELETED means a ghost owns it */
360   for (lid=kk=0; lid<nloc; lid++) {
361     NState state = lid_state[lid];
362     if (IS_SELECTED(state)) {
363       PetscCDIntNd *pos;
364       ierr = PetscCDGetHeadPos(aggs_2,lid,&pos);CHKERRQ(ierr);
365       while (pos) {
366         PetscInt gid1;
367         ierr = PetscCDIntNdGetID(pos, &gid1);CHKERRQ(ierr);
368         ierr = PetscCDGetNextPos(aggs_2,lid,&pos);CHKERRQ(ierr);
369 
370         if (gid1 >= my0 && gid1 < Iend) lid_parent_gid[gid1-my0] = (PetscScalar)(lid + my0);
371       }
372     }
373   }
374   /* get 'cpcol_1/2_state' & cpcol_2_par_orig - uses mpimat_1/2->lvec for temp space */
375   if (isMPI) {
376     Vec tempVec;
377     /* get 'cpcol_1_state' */
378     ierr = MatCreateVecs(Gmat_1, &tempVec, 0);CHKERRQ(ierr);
379     for (kk=0,j=my0; kk<nloc; kk++,j++) {
380       PetscScalar v = (PetscScalar)lid_state[kk];
381       ierr = VecSetValues(tempVec, 1, &j, &v, INSERT_VALUES);CHKERRQ(ierr);
382     }
383     ierr = VecAssemblyBegin(tempVec);CHKERRQ(ierr);
384     ierr = VecAssemblyEnd(tempVec);CHKERRQ(ierr);
385     ierr = VecScatterBegin(mpimat_1->Mvctx,tempVec, mpimat_1->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
386     ierr = VecScatterEnd(mpimat_1->Mvctx,tempVec, mpimat_1->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
387     ierr = VecGetArray(mpimat_1->lvec, &cpcol_1_state);CHKERRQ(ierr);
388     /* get 'cpcol_2_state' */
389     ierr = VecScatterBegin(mpimat_2->Mvctx,tempVec, mpimat_2->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
390     ierr =   VecScatterEnd(mpimat_2->Mvctx,tempVec, mpimat_2->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
391     ierr = VecGetArray(mpimat_2->lvec, &cpcol_2_state);CHKERRQ(ierr);
392     /* get 'cpcol_2_par_orig' */
393     for (kk=0,j=my0; kk<nloc; kk++,j++) {
394       PetscScalar v = (PetscScalar)lid_parent_gid[kk];
395       ierr = VecSetValues(tempVec, 1, &j, &v, INSERT_VALUES);CHKERRQ(ierr);
396     }
397     ierr = VecAssemblyBegin(tempVec);CHKERRQ(ierr);
398     ierr = VecAssemblyEnd(tempVec);CHKERRQ(ierr);
399     ierr = VecDuplicate(mpimat_2->lvec, &ghost_par_orig2);CHKERRQ(ierr);
400     ierr = VecScatterBegin(mpimat_2->Mvctx,tempVec, ghost_par_orig2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
401     ierr = VecScatterEnd(mpimat_2->Mvctx,tempVec, ghost_par_orig2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
402     ierr = VecGetArray(ghost_par_orig2, &cpcol_2_par_orig);CHKERRQ(ierr);
403 
404     ierr = VecDestroy(&tempVec);CHKERRQ(ierr);
405   } /* ismpi */
406 
407   /* doit */
408   for (lid=0; lid<nloc; lid++) {
409     NState state = lid_state[lid];
410     if (IS_SELECTED(state)) {
411       /* steal locals */
412       ii  = matA_1->i; n = ii[lid+1] - ii[lid];
413       idx = matA_1->j + ii[lid];
414       for (j=0; j<n; j++) {
415         PetscInt lidj   = idx[j], sgid;
416         NState   statej = lid_state[lidj];
417         if (statej==DELETED && (sgid=(PetscInt)PetscRealPart(lid_parent_gid[lidj])) != lid+my0) { /* steal local */
418           lid_parent_gid[lidj] = (PetscScalar)(lid+my0); /* send this if sgid is not local */
419           if (sgid >= my0 && sgid < Iend) {       /* I'm stealing this local from a local sgid */
420             PetscInt   hav=0,slid=sgid-my0,gidj=lidj+my0;
421             PetscCDIntNd *pos,*last=NULL;
422             /* looking for local from local so id_llist_2 works */
423             ierr = PetscCDGetHeadPos(aggs_2,slid,&pos);CHKERRQ(ierr);
424             while (pos) {
425               PetscInt gid;
426               ierr = PetscCDIntNdGetID(pos, &gid);CHKERRQ(ierr);
427               if (gid == gidj) {
428                 if (!last) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"last cannot be null");
429                 ierr = PetscCDRemoveNextNode(aggs_2, slid, last);CHKERRQ(ierr);
430                 ierr = PetscCDAppendNode(aggs_2, lid, pos);CHKERRQ(ierr);
431                 hav  = 1;
432                 break;
433               } else last = pos;
434 
435               ierr = PetscCDGetNextPos(aggs_2,slid,&pos);CHKERRQ(ierr);
436             }
437             if (hav!=1) {
438               if (!hav) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"failed to find adj in 'selected' lists - structurally unsymmetric matrix");
439               SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"found node %d times???",hav);
440             }
441           } else {            /* I'm stealing this local, owned by a ghost */
442             if (sgid != -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Have un-symmetric graph (apparently). Use '-pc_gamg_sym_graph true' to symetrize the graph or '-pc_gamg_threshold -1.0' if the matrix is structurally symmetric.");
443             ierr = PetscCDAppendID(aggs_2, lid, lidj+my0);CHKERRQ(ierr);
444           }
445         }
446       } /* local neighbors */
447     } else if (state == DELETED && lid_cprowID_1) {
448       PetscInt sgidold = (PetscInt)PetscRealPart(lid_parent_gid[lid]);
449       /* see if I have a selected ghost neighbor that will steal me */
450       if ((ix=lid_cprowID_1[lid]) != -1) {
451         ii  = matB_1->compressedrow.i; n = ii[ix+1] - ii[ix];
452         idx = matB_1->j + ii[ix];
453         for (j=0; j<n; j++) {
454           PetscInt cpid   = idx[j];
455           NState   statej = (NState)PetscRealPart(cpcol_1_state[cpid]);
456           if (IS_SELECTED(statej) && sgidold != (PetscInt)statej) { /* ghost will steal this, remove from my list */
457             lid_parent_gid[lid] = (PetscScalar)statej; /* send who selected */
458             if (sgidold>=my0 && sgidold<Iend) { /* this was mine */
459               PetscInt   hav=0,oldslidj=sgidold-my0;
460               PetscCDIntNd *pos,*last=NULL;
461               /* remove from 'oldslidj' list */
462               ierr = PetscCDGetHeadPos(aggs_2,oldslidj,&pos);CHKERRQ(ierr);
463               while (pos) {
464                 PetscInt gid;
465                 ierr = PetscCDIntNdGetID(pos, &gid);CHKERRQ(ierr);
466                 if (lid+my0 == gid) {
467                   /* id_llist_2[lastid] = id_llist_2[flid];   /\* remove lid from oldslidj list *\/ */
468                   if (!last) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"last cannot be null");
469                   ierr = PetscCDRemoveNextNode(aggs_2, oldslidj, last);CHKERRQ(ierr);
470                   /* ghost (PetscScalar)statej will add this later */
471                   hav = 1;
472                   break;
473                 } else last = pos;
474 
475                 ierr = PetscCDGetNextPos(aggs_2,oldslidj,&pos);CHKERRQ(ierr);
476               }
477               if (hav!=1) {
478                 if (!hav) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"failed to find adj in 'selected' lists - structurally unsymmetric matrix");
479                 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"found node %d times???",hav);
480               }
481             } else {
482               /* ghosts remove this later */
483             }
484           }
485         }
486       }
487     } /* selected/deleted */
488   } /* node loop */
489 
490   if (isMPI) {
491     PetscScalar     *cpcol_2_parent,*cpcol_2_gid;
492     Vec             tempVec,ghostgids2,ghostparents2;
493     PetscInt        cpid,nghost_2;
494     PCGAMGHashTable gid_cpid;
495 
496     ierr = VecGetSize(mpimat_2->lvec, &nghost_2);CHKERRQ(ierr);
497     ierr = MatCreateVecs(Gmat_2, &tempVec, 0);CHKERRQ(ierr);
498 
499     /* get 'cpcol_2_parent' */
500     for (kk=0,j=my0; kk<nloc; kk++,j++) {
501       ierr = VecSetValues(tempVec, 1, &j, &lid_parent_gid[kk], INSERT_VALUES);CHKERRQ(ierr);
502     }
503     ierr = VecAssemblyBegin(tempVec);CHKERRQ(ierr);
504     ierr = VecAssemblyEnd(tempVec);CHKERRQ(ierr);
505     ierr = VecDuplicate(mpimat_2->lvec, &ghostparents2);CHKERRQ(ierr);
506     ierr = VecScatterBegin(mpimat_2->Mvctx,tempVec, ghostparents2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
507     ierr = VecScatterEnd(mpimat_2->Mvctx,tempVec, ghostparents2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
508     ierr = VecGetArray(ghostparents2, &cpcol_2_parent);CHKERRQ(ierr);
509 
510     /* get 'cpcol_2_gid' */
511     for (kk=0,j=my0; kk<nloc; kk++,j++) {
512       PetscScalar v = (PetscScalar)j;
513       ierr = VecSetValues(tempVec, 1, &j, &v, INSERT_VALUES);CHKERRQ(ierr);
514     }
515     ierr = VecAssemblyBegin(tempVec);CHKERRQ(ierr);
516     ierr = VecAssemblyEnd(tempVec);CHKERRQ(ierr);
517     ierr = VecDuplicate(mpimat_2->lvec, &ghostgids2);CHKERRQ(ierr);
518     ierr = VecScatterBegin(mpimat_2->Mvctx,tempVec, ghostgids2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
519     ierr = VecScatterEnd(mpimat_2->Mvctx,tempVec, ghostgids2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
520     ierr = VecGetArray(ghostgids2, &cpcol_2_gid);CHKERRQ(ierr);
521 
522     ierr = VecDestroy(&tempVec);CHKERRQ(ierr);
523 
524     /* look for deleted ghosts and add to table */
525     ierr = PCGAMGHashTableCreate(2*nghost_2+1, &gid_cpid);CHKERRQ(ierr);
526     for (cpid = 0; cpid < nghost_2; cpid++) {
527       NState state = (NState)PetscRealPart(cpcol_2_state[cpid]);
528       if (state==DELETED) {
529         PetscInt sgid_new = (PetscInt)PetscRealPart(cpcol_2_parent[cpid]);
530         PetscInt sgid_old = (PetscInt)PetscRealPart(cpcol_2_par_orig[cpid]);
531         if (sgid_old == -1 && sgid_new != -1) {
532           PetscInt gid = (PetscInt)PetscRealPart(cpcol_2_gid[cpid]);
533           ierr = PCGAMGHashTableAdd(&gid_cpid, gid, cpid);CHKERRQ(ierr);
534         }
535       }
536     }
537 
538     /* look for deleted ghosts and see if they moved - remove it */
539     for (lid=0; lid<nloc; lid++) {
540       NState state = lid_state[lid];
541       if (IS_SELECTED(state)) {
542         PetscCDIntNd *pos,*last=NULL;
543         /* look for deleted ghosts and see if they moved */
544         ierr = PetscCDGetHeadPos(aggs_2,lid,&pos);CHKERRQ(ierr);
545         while (pos) {
546           PetscInt gid;
547           ierr = PetscCDIntNdGetID(pos, &gid);CHKERRQ(ierr);
548 
549           if (gid < my0 || gid >= Iend) {
550             ierr = PCGAMGHashTableFind(&gid_cpid, gid, &cpid);CHKERRQ(ierr);
551             if (cpid != -1) {
552               /* a moved ghost - */
553               /* id_llist_2[lastid] = id_llist_2[flid];    /\* remove 'flid' from list *\/ */
554               ierr = PetscCDRemoveNextNode(aggs_2, lid, last);CHKERRQ(ierr);
555             } else last = pos;
556           } else last = pos;
557 
558           ierr = PetscCDGetNextPos(aggs_2,lid,&pos);CHKERRQ(ierr);
559         } /* loop over list of deleted */
560       } /* selected */
561     }
562     ierr = PCGAMGHashTableDestroy(&gid_cpid);CHKERRQ(ierr);
563 
564     /* look at ghosts, see if they changed - and it */
565     for (cpid = 0; cpid < nghost_2; cpid++) {
566       PetscInt sgid_new = (PetscInt)PetscRealPart(cpcol_2_parent[cpid]);
567       if (sgid_new >= my0 && sgid_new < Iend) { /* this is mine */
568         PetscInt     gid     = (PetscInt)PetscRealPart(cpcol_2_gid[cpid]);
569         PetscInt     slid_new=sgid_new-my0,hav=0;
570         PetscCDIntNd *pos;
571 
572         /* search for this gid to see if I have it */
573         ierr = PetscCDGetHeadPos(aggs_2,slid_new,&pos);CHKERRQ(ierr);
574         while (pos) {
575           PetscInt gidj;
576           ierr = PetscCDIntNdGetID(pos, &gidj);CHKERRQ(ierr);
577           ierr = PetscCDGetNextPos(aggs_2,slid_new,&pos);CHKERRQ(ierr);
578 
579           if (gidj == gid) { hav = 1; break; }
580         }
581         if (hav != 1) {
582           /* insert 'flidj' into head of llist */
583           ierr = PetscCDAppendID(aggs_2, slid_new, gid);CHKERRQ(ierr);
584         }
585       }
586     }
587 
588     ierr = VecRestoreArray(mpimat_1->lvec, &cpcol_1_state);CHKERRQ(ierr);
589     ierr = VecRestoreArray(mpimat_2->lvec, &cpcol_2_state);CHKERRQ(ierr);
590     ierr = VecRestoreArray(ghostparents2, &cpcol_2_parent);CHKERRQ(ierr);
591     ierr = VecRestoreArray(ghostgids2, &cpcol_2_gid);CHKERRQ(ierr);
592     ierr = PetscFree(lid_cprowID_1);CHKERRQ(ierr);
593     ierr = VecDestroy(&ghostgids2);CHKERRQ(ierr);
594     ierr = VecDestroy(&ghostparents2);CHKERRQ(ierr);
595     ierr = VecDestroy(&ghost_par_orig2);CHKERRQ(ierr);
596   }
597 
598   ierr = PetscFree2(lid_state,lid_parent_gid);CHKERRQ(ierr);
599   PetscFunctionReturn(0);
600 }
601 
602 /* -------------------------------------------------------------------------- */
603 /*
604    PCSetData_AGG - called if data is not set with PCSetCoordinates.
605       Looks in Mat for near null space.
606       Does not work for Stokes
607 
608   Input Parameter:
609    . pc -
610    . a_A - matrix to get (near) null space out of.
611 */
612 #undef __FUNCT__
613 #define __FUNCT__ "PCSetData_AGG"
614 static PetscErrorCode PCSetData_AGG(PC pc, Mat a_A)
615 {
616   PetscErrorCode ierr;
617   PC_MG          *mg      = (PC_MG*)pc->data;
618   PC_GAMG        *pc_gamg = (PC_GAMG*)mg->innerctx;
619   MatNullSpace   mnull;
620   PetscFunctionBegin;
621 
622   ierr = MatGetNearNullSpace(a_A, &mnull);CHKERRQ(ierr);
623   if (!mnull) {
624     DM dm;
625     ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
626     if (!dm) {
627       ierr = MatGetDM(a_A, &dm);CHKERRQ(ierr);
628     }
629     if (dm) {
630       PetscObject deformation;
631       PetscInt    Nf;
632 
633       ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
634       if (Nf) {
635         ierr = DMGetField(dm, 0, &deformation);CHKERRQ(ierr);
636         ierr = PetscObjectQuery((PetscObject)deformation,"nearnullspace",(PetscObject*)&mnull);CHKERRQ(ierr);
637         if (!mnull) {
638           ierr = PetscObjectQuery((PetscObject)deformation,"nullspace",(PetscObject*)&mnull);CHKERRQ(ierr);
639         }
640       }
641     }
642   }
643 
644   if (!mnull) {
645     PetscInt bs,NN,MM;
646     ierr = MatGetBlockSize(a_A, &bs);CHKERRQ(ierr);
647     ierr = MatGetLocalSize(a_A, &MM, &NN);CHKERRQ(ierr);
648     if (MM % bs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"MM %D must be divisible by bs %D",MM,bs);
649     ierr = PCSetCoordinates_AGG(pc, bs, MM/bs, NULL);CHKERRQ(ierr);
650   } else {
651     PetscReal *nullvec;
652     PetscBool has_const;
653     PetscInt  i,j,mlocal,nvec,bs;
654     const Vec *vecs; const PetscScalar *v;
655     ierr = MatGetLocalSize(a_A,&mlocal,NULL);CHKERRQ(ierr);
656     ierr = MatNullSpaceGetVecs(mnull, &has_const, &nvec, &vecs);CHKERRQ(ierr);
657     pc_gamg->data_sz = (nvec+!!has_const)*mlocal;
658     ierr = PetscMalloc1((nvec+!!has_const)*mlocal,&nullvec);CHKERRQ(ierr);
659     if (has_const) for (i=0; i<mlocal; i++) nullvec[i] = 1.0;
660     for (i=0; i<nvec; i++) {
661       ierr = VecGetArrayRead(vecs[i],&v);CHKERRQ(ierr);
662       for (j=0; j<mlocal; j++) nullvec[(i+!!has_const)*mlocal + j] = PetscRealPart(v[j]);
663       ierr = VecRestoreArrayRead(vecs[i],&v);CHKERRQ(ierr);
664     }
665     pc_gamg->data           = nullvec;
666     pc_gamg->data_cell_cols = (nvec+!!has_const);
667 
668     ierr = MatGetBlockSize(a_A, &bs);CHKERRQ(ierr);
669 
670     pc_gamg->data_cell_rows = bs;
671   }
672   PetscFunctionReturn(0);
673 }
674 
675 /* -------------------------------------------------------------------------- */
676 /*
677  formProl0
678 
679    Input Parameter:
680    . agg_llists - list of arrays with aggregates -- list from selected vertices of aggregate unselected vertices
681    . bs - row block size
682    . nSAvec - column bs of new P
683    . my0crs - global index of start of locals
684    . data_stride - bs*(nloc nodes + ghost nodes) [data_stride][nSAvec]
685    . data_in[data_stride*nSAvec] - local data on fine grid
686    . flid_fgid[data_stride/bs] - make local to global IDs, includes ghosts in 'locals_llist'
687   Output Parameter:
688    . a_data_out - in with fine grid data (w/ghosts), out with coarse grid data
689    . a_Prol - prolongation operator
690 */
691 #undef __FUNCT__
692 #define __FUNCT__ "formProl0"
693 static PetscErrorCode formProl0(PetscCoarsenData *agg_llists,PetscInt bs,PetscInt nSAvec,PetscInt my0crs,PetscInt data_stride,PetscReal data_in[],const PetscInt flid_fgid[],PetscReal **a_data_out,Mat a_Prol)
694 {
695   PetscErrorCode  ierr;
696   PetscInt        Istart,my0,Iend,nloc,clid,flid = 0,aggID,kk,jj,ii,mm,ndone,nSelected,minsz,nghosts,out_data_stride;
697   MPI_Comm        comm;
698   PetscMPIInt     rank;
699   PetscReal       *out_data;
700   PetscCDIntNd    *pos;
701   PCGAMGHashTable fgid_flid;
702 
703 /* #define OUT_AGGS */
704 #if defined(OUT_AGGS)
705   static PetscInt llev = 0; char fname[32]; FILE *file = NULL; PetscInt pM;
706 #endif
707 
708   PetscFunctionBegin;
709   ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr);
710   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
711   ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr);
712   nloc = (Iend-Istart)/bs; my0 = Istart/bs;
713   if ((Iend-Istart) % bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Iend %D - Istart %d must be divisible by bs %D",Iend,Istart,bs);
714   Iend   /= bs;
715   nghosts = data_stride/bs - nloc;
716 
717   ierr = PCGAMGHashTableCreate(2*nghosts+1, &fgid_flid);CHKERRQ(ierr);
718   for (kk=0; kk<nghosts; kk++) {
719     ierr = PCGAMGHashTableAdd(&fgid_flid, flid_fgid[nloc+kk], nloc+kk);CHKERRQ(ierr);
720   }
721 
722 #if defined(OUT_AGGS)
723   sprintf(fname,"aggs_%d_%d.m",llev++,rank);
724   if (llev==1) file = fopen(fname,"w");
725   MatGetSize(a_Prol, &pM, &jj);
726 #endif
727 
728   /* count selected -- same as number of cols of P */
729   for (nSelected=mm=0; mm<nloc; mm++) {
730     PetscBool ise;
731     ierr = PetscCDEmptyAt(agg_llists, mm, &ise);CHKERRQ(ierr);
732     if (!ise) nSelected++;
733   }
734   ierr = MatGetOwnershipRangeColumn(a_Prol, &ii, &jj);CHKERRQ(ierr);
735   if ((ii/nSAvec) != my0crs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"ii %D /nSAvec %D  != my0crs %D",ii,nSAvec,my0crs);
736   if (nSelected != (jj-ii)/nSAvec) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"nSelected %D != (jj %D - ii %D)/nSAvec %D",nSelected,jj,ii,nSAvec);
737 
738   /* aloc space for coarse point data (output) */
739   out_data_stride = nSelected*nSAvec;
740 
741   ierr = PetscMalloc1(out_data_stride*nSAvec, &out_data);CHKERRQ(ierr);
742   for (ii=0;ii<out_data_stride*nSAvec;ii++) out_data[ii]=PETSC_MAX_REAL;
743   *a_data_out = out_data; /* output - stride nSelected*nSAvec */
744 
745   /* find points and set prolongation */
746   minsz = 100;
747   ndone = 0;
748   for (mm = clid = 0; mm < nloc; mm++) {
749     ierr = PetscCDSizeAt(agg_llists, mm, &jj);CHKERRQ(ierr);
750     if (jj > 0) {
751       const PetscInt lid = mm, cgid = my0crs + clid;
752       PetscInt       cids[100]; /* max bs */
753       PetscBLASInt   asz  =jj,M=asz*bs,N=nSAvec,INFO;
754       PetscBLASInt   Mdata=M+((N-M>0) ? N-M : 0),LDA=Mdata,LWORK=N*bs;
755       PetscScalar    *qqc,*qqr,*TAU,*WORK;
756       PetscInt       *fids;
757       PetscReal      *data;
758       /* count agg */
759       if (asz<minsz) minsz = asz;
760 
761       /* get block */
762       ierr = PetscMalloc5(Mdata*N, &qqc,M*N, &qqr,N, &TAU,LWORK, &WORK,M, &fids);CHKERRQ(ierr);
763 
764       aggID = 0;
765       ierr  = PetscCDGetHeadPos(agg_llists,lid,&pos);CHKERRQ(ierr);
766       while (pos) {
767         PetscInt gid1;
768         ierr = PetscCDIntNdGetID(pos, &gid1);CHKERRQ(ierr);
769         ierr = PetscCDGetNextPos(agg_llists,lid,&pos);CHKERRQ(ierr);
770 
771         if (gid1 >= my0 && gid1 < Iend) flid = gid1 - my0;
772         else {
773           ierr = PCGAMGHashTableFind(&fgid_flid, gid1, &flid);CHKERRQ(ierr);
774           if (flid < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot find gid1 in table");
775         }
776         /* copy in B_i matrix - column oriented */
777         data = &data_in[flid*bs];
778         for (ii = 0; ii < bs; ii++) {
779           for (jj = 0; jj < N; jj++) {
780             PetscReal d = data[jj*data_stride + ii];
781             qqc[jj*Mdata + aggID*bs + ii] = d;
782           }
783         }
784 #if defined(OUT_AGGS)
785         if (llev==1) {
786           char     str[] = "plot(%e,%e,'r*'), hold on,\n", col[] = "rgbkmc", sim[] = "*os+h>d<vx^";
787           PetscInt MM,pi,pj;
788           str[12] = col[(clid+17*rank)%6]; str[13] = sim[(clid+17*rank)%11];
789           MM      = (PetscInt)(PetscSqrtReal((PetscReal)pM));
790           pj      = gid1/MM; pi = gid1%MM;
791           fprintf(file,str,(double)pi,(double)pj);
792           /* fprintf(file,str,data[2*data_stride+1],-data[2*data_stride]); */
793         }
794 #endif
795         /* set fine IDs */
796         for (kk=0; kk<bs; kk++) fids[aggID*bs + kk] = flid_fgid[flid]*bs + kk;
797 
798         aggID++;
799       }
800 
801       /* pad with zeros */
802       for (ii = asz*bs; ii < Mdata; ii++) {
803         for (jj = 0; jj < N; jj++, kk++) {
804           qqc[jj*Mdata + ii] = .0;
805         }
806       }
807 
808       ndone += aggID;
809       /* QR */
810       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
811       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Mdata, &N, qqc, &LDA, TAU, WORK, &LWORK, &INFO));
812       ierr = PetscFPTrapPop();CHKERRQ(ierr);
813       if (INFO != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"xGEQRF error");
814       /* get R - column oriented - output B_{i+1} */
815       {
816         PetscReal *data = &out_data[clid*nSAvec];
817         for (jj = 0; jj < nSAvec; jj++) {
818           for (ii = 0; ii < nSAvec; ii++) {
819             if (data[jj*out_data_stride + ii] != PETSC_MAX_REAL) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"data[jj*out_data_stride + ii] != %e",PETSC_MAX_REAL);
820            if (ii <= jj) data[jj*out_data_stride + ii] = PetscRealPart(qqc[jj*Mdata + ii]);
821            else data[jj*out_data_stride + ii] = 0.;
822           }
823         }
824       }
825 
826       /* get Q - row oriented */
827       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Mdata, &N, &N, qqc, &LDA, TAU, WORK, &LWORK, &INFO));
828       if (INFO != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"xORGQR error arg %d",-INFO);
829 
830       for (ii = 0; ii < M; ii++) {
831         for (jj = 0; jj < N; jj++) {
832           qqr[N*ii + jj] = qqc[jj*Mdata + ii];
833         }
834       }
835 
836       /* add diagonal block of P0 */
837       for (kk=0; kk<N; kk++) {
838         cids[kk] = N*cgid + kk; /* global col IDs in P0 */
839       }
840       ierr = MatSetValues(a_Prol,M,fids,N,cids,qqr,INSERT_VALUES);CHKERRQ(ierr);
841 
842       ierr = PetscFree5(qqc,qqr,TAU,WORK,fids);CHKERRQ(ierr);
843       clid++;
844     } /* coarse agg */
845   } /* for all fine nodes */
846   ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
847   ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
848 
849 /* ierr = MPIU_Allreduce(&ndone, &ii, 1, MPIU_INT, MPIU_SUM, comm); */
850 /* MatGetSize(a_Prol, &kk, &jj); */
851 /* ierr = MPIU_Allreduce(&minsz, &jj, 1, MPIU_INT, MPIU_MIN, comm); */
852 /* PetscPrintf(comm," **** [%d]%s %d total done, %d nodes (%d local done), min agg. size = %d\n",rank,__FUNCT__,ii,kk/bs,ndone,jj); */
853 
854 #if defined(OUT_AGGS)
855   if (llev==1) fclose(file);
856 #endif
857   ierr = PCGAMGHashTableDestroy(&fgid_flid);CHKERRQ(ierr);
858   PetscFunctionReturn(0);
859 }
860 
861 #undef __FUNCT__
862 #define __FUNCT__ "PCView_GAMG_AGG"
863 static PetscErrorCode PCView_GAMG_AGG(PC pc,PetscViewer viewer)
864 {
865   PetscErrorCode ierr;
866   PC_MG          *mg      = (PC_MG*)pc->data;
867   PC_GAMG        *pc_gamg = (PC_GAMG*)mg->innerctx;
868   PC_GAMG_AGG    *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
869 
870   PetscFunctionBegin;
871   ierr = PetscViewerASCIIPrintf(viewer,"      AGG specific options\n");CHKERRQ(ierr);
872   ierr = PetscViewerASCIIPrintf(viewer,"        Symmetric graph %s\n",pc_gamg_agg->sym_graph ? "true" : "false");CHKERRQ(ierr);
873   ierr = PetscViewerASCIIPrintf(viewer,"        Number of levels to square graph %D\n",pc_gamg_agg->square_graph);CHKERRQ(ierr);
874   ierr = PetscViewerASCIIPrintf(viewer,"        Number smoothing steps %D\n",pc_gamg_agg->nsmooths);CHKERRQ(ierr);
875   PetscFunctionReturn(0);
876 }
877 
878 /* -------------------------------------------------------------------------- */
879 /*
880    PCGAMGGraph_AGG
881 
882   Input Parameter:
883    . pc - this
884    . Amat - matrix on this fine level
885   Output Parameter:
886    . a_Gmat -
887 */
888 #undef __FUNCT__
889 #define __FUNCT__ "PCGAMGGraph_AGG"
890 static PetscErrorCode PCGAMGGraph_AGG(PC pc,Mat Amat,Mat *a_Gmat)
891 {
892   PetscErrorCode            ierr;
893   PC_MG                     *mg          = (PC_MG*)pc->data;
894   PC_GAMG                   *pc_gamg     = (PC_GAMG*)mg->innerctx;
895   const PetscReal           vfilter      = pc_gamg->threshold;
896   PC_GAMG_AGG               *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
897   Mat                       Gmat;
898   MPI_Comm                  comm;
899   PetscBool /* set,flg , */ symm;
900 
901   PetscFunctionBegin;
902   ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
903   ierr = PetscLogEventBegin(PC_GAMGGraph_AGG,0,0,0,0);CHKERRQ(ierr);
904 
905   /* ierr = MatIsSymmetricKnown(Amat, &set, &flg);CHKERRQ(ierr); || !(set && flg) -- this causes lot of symm calls */
906   symm = (PetscBool)(pc_gamg_agg->sym_graph); /* && !pc_gamg_agg->square_graph; */
907 
908   ierr = PCGAMGCreateGraph(Amat, &Gmat);CHKERRQ(ierr);
909   ierr = PCGAMGFilterGraph(&Gmat, vfilter, symm);CHKERRQ(ierr);
910 
911   *a_Gmat = Gmat;
912 
913   ierr = PetscLogEventEnd(PC_GAMGGraph_AGG,0,0,0,0);CHKERRQ(ierr);
914   PetscFunctionReturn(0);
915 }
916 
917 /* -------------------------------------------------------------------------- */
918 /*
919    PCGAMGCoarsen_AGG
920 
921   Input Parameter:
922    . a_pc - this
923   Input/Output Parameter:
924    . a_Gmat1 - graph on this fine level - coarsening can change this (squares it)
925   Output Parameter:
926    . agg_lists - list of aggregates
927 */
928 #undef __FUNCT__
929 #define __FUNCT__ "PCGAMGCoarsen_AGG"
930 static PetscErrorCode PCGAMGCoarsen_AGG(PC a_pc,Mat *a_Gmat1,PetscCoarsenData **agg_lists)
931 {
932   PetscErrorCode ierr;
933   PC_MG          *mg          = (PC_MG*)a_pc->data;
934   PC_GAMG        *pc_gamg     = (PC_GAMG*)mg->innerctx;
935   PC_GAMG_AGG    *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
936   Mat            mat,Gmat2, Gmat1 = *a_Gmat1;  /* squared graph */
937   IS             perm;
938   PetscInt       Istart,Iend,Ii,nloc,bs,n,m;
939   PetscInt       *permute;
940   PetscBool      *bIndexSet;
941   MatCoarsen     crs;
942   MPI_Comm       comm;
943   PetscMPIInt    rank;
944   PetscReal      rr;
945   PetscInt       iSwapIndex;
946 
947   PetscFunctionBegin;
948   ierr = PetscLogEventBegin(PC_GAMGCoarsen_AGG,0,0,0,0);CHKERRQ(ierr);
949   ierr = PetscObjectGetComm((PetscObject)Gmat1,&comm);CHKERRQ(ierr);
950   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
951   ierr = MatGetLocalSize(Gmat1, &n, &m);CHKERRQ(ierr);
952   ierr = MatGetBlockSize(Gmat1, &bs);CHKERRQ(ierr);
953   if (bs != 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"bs %D must be 1",bs);
954   nloc = n/bs;
955 
956   if (pc_gamg->current_level < pc_gamg_agg->square_graph) {
957     ierr = PetscInfo2(a_pc,"Square Graph on level %d of %d to square\n",pc_gamg->current_level+1,pc_gamg_agg->square_graph);CHKERRQ(ierr);
958     ierr = MatTransposeMatMult(Gmat1, Gmat1, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &Gmat2);CHKERRQ(ierr);
959   } else Gmat2 = Gmat1;
960 
961   /* get MIS aggs - randomize */
962   ierr = PetscMalloc1(nloc, &permute);CHKERRQ(ierr);
963   ierr = PetscCalloc1(nloc, &bIndexSet);CHKERRQ(ierr);
964   for (Ii = 0; Ii < nloc; Ii++) {
965     permute[Ii]   = Ii;
966   }
967   ierr = MatGetOwnershipRange(Gmat1, &Istart, &Iend);CHKERRQ(ierr);
968   for (Ii = 0; Ii < nloc; Ii++) {
969     ierr = PetscRandomGetValueReal(pc_gamg->random,&rr);CHKERRQ(ierr);
970     iSwapIndex = (PetscInt) (rr*nloc);
971     if (!bIndexSet[iSwapIndex] && iSwapIndex != Ii) {
972       PetscInt iTemp = permute[iSwapIndex];
973       permute[iSwapIndex]   = permute[Ii];
974       permute[Ii]           = iTemp;
975       bIndexSet[iSwapIndex] = PETSC_TRUE;
976     }
977   }
978   ierr = PetscFree(bIndexSet);CHKERRQ(ierr);
979 
980   ierr = ISCreateGeneral(PETSC_COMM_SELF, nloc, permute, PETSC_USE_POINTER, &perm);CHKERRQ(ierr);
981 #if defined PETSC_GAMG_USE_LOG
982   ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET4],0,0,0,0);CHKERRQ(ierr);
983 #endif
984   ierr = MatCoarsenCreate(comm, &crs);CHKERRQ(ierr);
985   ierr = MatCoarsenSetFromOptions(crs);CHKERRQ(ierr);
986   ierr = MatCoarsenSetGreedyOrdering(crs, perm);CHKERRQ(ierr);
987   ierr = MatCoarsenSetAdjacency(crs, Gmat2);CHKERRQ(ierr);
988   ierr = MatCoarsenSetStrictAggs(crs, PETSC_TRUE);CHKERRQ(ierr);
989   ierr = MatCoarsenApply(crs);CHKERRQ(ierr);
990   ierr = MatCoarsenGetData(crs, agg_lists);CHKERRQ(ierr); /* output */
991   ierr = MatCoarsenDestroy(&crs);CHKERRQ(ierr);
992 
993   ierr = ISDestroy(&perm);CHKERRQ(ierr);
994   ierr = PetscFree(permute);CHKERRQ(ierr);
995 #if defined PETSC_GAMG_USE_LOG
996   ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET4],0,0,0,0);CHKERRQ(ierr);
997 #endif
998 
999   /* smooth aggs */
1000   if (Gmat2 != Gmat1) {
1001     const PetscCoarsenData *llist = *agg_lists;
1002     ierr     = smoothAggs(Gmat2, Gmat1, *agg_lists);CHKERRQ(ierr);
1003     ierr     = MatDestroy(&Gmat1);CHKERRQ(ierr);
1004     *a_Gmat1 = Gmat2; /* output */
1005     ierr     = PetscCDGetMat(llist, &mat);CHKERRQ(ierr);
1006     if (mat) SETERRQ(comm,PETSC_ERR_ARG_WRONG, "Auxilary matrix with squared graph????");
1007   } else {
1008     const PetscCoarsenData *llist = *agg_lists;
1009     /* see if we have a matrix that takes precedence (returned from MatCoarsenApply) */
1010     ierr = PetscCDGetMat(llist, &mat);CHKERRQ(ierr);
1011     if (mat) {
1012       ierr     = MatDestroy(&Gmat1);CHKERRQ(ierr);
1013       *a_Gmat1 = mat; /* output */
1014     }
1015   }
1016   ierr = PetscLogEventEnd(PC_GAMGCoarsen_AGG,0,0,0,0);CHKERRQ(ierr);
1017   PetscFunctionReturn(0);
1018 }
1019 
1020 /* -------------------------------------------------------------------------- */
1021 /*
1022  PCGAMGProlongator_AGG
1023 
1024  Input Parameter:
1025  . pc - this
1026  . Amat - matrix on this fine level
1027  . Graph - used to get ghost data for nodes in
1028  . agg_lists - list of aggregates
1029  Output Parameter:
1030  . a_P_out - prolongation operator to the next level
1031  */
1032 #undef __FUNCT__
1033 #define __FUNCT__ "PCGAMGProlongator_AGG"
1034 static PetscErrorCode PCGAMGProlongator_AGG(PC pc,Mat Amat,Mat Gmat,PetscCoarsenData *agg_lists,Mat *a_P_out)
1035 {
1036   PC_MG          *mg       = (PC_MG*)pc->data;
1037   PC_GAMG        *pc_gamg  = (PC_GAMG*)mg->innerctx;
1038   const PetscInt col_bs = pc_gamg->data_cell_cols;
1039   PetscErrorCode ierr;
1040   PetscInt       Istart,Iend,nloc,ii,jj,kk,my0,nLocalSelected,bs;
1041   Mat            Prol;
1042   PetscMPIInt    rank, size;
1043   MPI_Comm       comm;
1044   PetscReal      *data_w_ghost;
1045   PetscInt       myCrs0, nbnodes=0, *flid_fgid;
1046   MatType        mtype;
1047 
1048   PetscFunctionBegin;
1049   ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
1050   if (col_bs < 1) SETERRQ(comm,PETSC_ERR_PLIB,"Column bs cannot be less than 1");
1051   ierr = PetscLogEventBegin(PC_GAMGProlongator_AGG,0,0,0,0);CHKERRQ(ierr);
1052   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
1053   ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
1054   ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
1055   ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
1056   nloc = (Iend-Istart)/bs; my0 = Istart/bs;
1057   if ((Iend-Istart) % bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(Iend %D - Istart %D) not divisible by bs %D",Iend,Istart,bs);
1058 
1059   /* get 'nLocalSelected' */
1060   for (ii=0, nLocalSelected = 0; ii < nloc; ii++) {
1061     PetscBool ise;
1062     /* filter out singletons 0 or 1? */
1063     ierr = PetscCDEmptyAt(agg_lists, ii, &ise);CHKERRQ(ierr);
1064     if (!ise) nLocalSelected++;
1065   }
1066 
1067   /* create prolongator, create P matrix */
1068   ierr = MatGetType(Amat,&mtype);CHKERRQ(ierr);
1069   ierr = MatCreate(comm, &Prol);CHKERRQ(ierr);
1070   ierr = MatSetSizes(Prol,nloc*bs,nLocalSelected*col_bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
1071   ierr = MatSetBlockSizes(Prol, bs, col_bs);CHKERRQ(ierr);
1072   ierr = MatSetType(Prol, mtype);CHKERRQ(ierr);
1073   ierr = MatSeqAIJSetPreallocation(Prol, col_bs, NULL);CHKERRQ(ierr);
1074   ierr = MatMPIAIJSetPreallocation(Prol,col_bs, NULL,col_bs, NULL);CHKERRQ(ierr);
1075 
1076   /* can get all points "removed" */
1077   ierr =  MatGetSize(Prol, &kk, &ii);CHKERRQ(ierr);
1078   if (!ii) {
1079     ierr = PetscInfo(pc,"No selected points on coarse grid\n");CHKERRQ(ierr);
1080     ierr = MatDestroy(&Prol);CHKERRQ(ierr);
1081     *a_P_out = NULL;  /* out */
1082     ierr = PetscLogEventEnd(PC_GAMGProlongator_AGG,0,0,0,0);CHKERRQ(ierr);
1083     PetscFunctionReturn(0);
1084   }
1085   ierr = PetscInfo1(pc,"New grid %D nodes\n",ii/col_bs);CHKERRQ(ierr);
1086   ierr = MatGetOwnershipRangeColumn(Prol, &myCrs0, &kk);CHKERRQ(ierr);
1087 
1088   if ((kk-myCrs0) % col_bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(kk %D -myCrs0 %D) not divisible by col_bs %D",kk,myCrs0,col_bs);
1089   myCrs0 = myCrs0/col_bs;
1090   if ((kk/col_bs-myCrs0) != nLocalSelected) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(kk %D/col_bs %D - myCrs0 %D) != nLocalSelected %D)",kk,col_bs,myCrs0,nLocalSelected);
1091 
1092   /* create global vector of data in 'data_w_ghost' */
1093 #if defined PETSC_GAMG_USE_LOG
1094   ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET7],0,0,0,0);CHKERRQ(ierr);
1095 #endif
1096   if (size > 1) { /*  */
1097     PetscReal *tmp_gdata,*tmp_ldata,*tp2;
1098     ierr = PetscMalloc1(nloc, &tmp_ldata);CHKERRQ(ierr);
1099     for (jj = 0; jj < col_bs; jj++) {
1100       for (kk = 0; kk < bs; kk++) {
1101         PetscInt        ii,stride;
1102         const PetscReal *tp = pc_gamg->data + jj*bs*nloc + kk;
1103         for (ii = 0; ii < nloc; ii++, tp += bs) tmp_ldata[ii] = *tp;
1104 
1105         ierr = PCGAMGGetDataWithGhosts(Gmat, 1, tmp_ldata, &stride, &tmp_gdata);CHKERRQ(ierr);
1106 
1107         if (!jj && !kk) { /* now I know how many todal nodes - allocate */
1108           ierr    = PetscMalloc1(stride*bs*col_bs, &data_w_ghost);CHKERRQ(ierr);
1109           nbnodes = bs*stride;
1110         }
1111         tp2 = data_w_ghost + jj*bs*stride + kk;
1112         for (ii = 0; ii < stride; ii++, tp2 += bs) *tp2 = tmp_gdata[ii];
1113         ierr = PetscFree(tmp_gdata);CHKERRQ(ierr);
1114       }
1115     }
1116     ierr = PetscFree(tmp_ldata);CHKERRQ(ierr);
1117   } else {
1118     nbnodes      = bs*nloc;
1119     data_w_ghost = (PetscReal*)pc_gamg->data;
1120   }
1121 
1122   /* get P0 */
1123   if (size > 1) {
1124     PetscReal *fid_glid_loc,*fiddata;
1125     PetscInt  stride;
1126 
1127     ierr = PetscMalloc1(nloc, &fid_glid_loc);CHKERRQ(ierr);
1128     for (kk=0; kk<nloc; kk++) fid_glid_loc[kk] = (PetscReal)(my0+kk);
1129     ierr = PCGAMGGetDataWithGhosts(Gmat, 1, fid_glid_loc, &stride, &fiddata);CHKERRQ(ierr);
1130     ierr = PetscMalloc1(stride, &flid_fgid);CHKERRQ(ierr);
1131     for (kk=0; kk<stride; kk++) flid_fgid[kk] = (PetscInt)fiddata[kk];
1132     ierr = PetscFree(fiddata);CHKERRQ(ierr);
1133 
1134     if (stride != nbnodes/bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"stride %D != nbnodes %D/bs %D",stride,nbnodes,bs);
1135     ierr = PetscFree(fid_glid_loc);CHKERRQ(ierr);
1136   } else {
1137     ierr = PetscMalloc1(nloc, &flid_fgid);CHKERRQ(ierr);
1138     for (kk=0; kk<nloc; kk++) flid_fgid[kk] = my0 + kk;
1139   }
1140 #if defined PETSC_GAMG_USE_LOG
1141   ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET7],0,0,0,0);CHKERRQ(ierr);
1142   ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET8],0,0,0,0);CHKERRQ(ierr);
1143 #endif
1144   {
1145     PetscReal *data_out = NULL;
1146     ierr = formProl0(agg_lists, bs, col_bs, myCrs0, nbnodes,data_w_ghost, flid_fgid, &data_out, Prol);CHKERRQ(ierr);
1147     ierr = PetscFree(pc_gamg->data);CHKERRQ(ierr);
1148 
1149     pc_gamg->data           = data_out;
1150     pc_gamg->data_cell_rows = col_bs;
1151     pc_gamg->data_sz        = col_bs*col_bs*nLocalSelected;
1152   }
1153 #if defined PETSC_GAMG_USE_LOG
1154   ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET8],0,0,0,0);CHKERRQ(ierr);
1155 #endif
1156   if (size > 1) {ierr = PetscFree(data_w_ghost);CHKERRQ(ierr);}
1157   ierr = PetscFree(flid_fgid);CHKERRQ(ierr);
1158 
1159   *a_P_out = Prol;  /* out */
1160 
1161   ierr = PetscLogEventEnd(PC_GAMGProlongator_AGG,0,0,0,0);CHKERRQ(ierr);
1162   PetscFunctionReturn(0);
1163 }
1164 
1165 /* -------------------------------------------------------------------------- */
1166 /*
1167    PCGAMGOptProlongator_AGG
1168 
1169   Input Parameter:
1170    . pc - this
1171    . Amat - matrix on this fine level
1172  In/Output Parameter:
1173    . a_P - prolongation operator to the next level
1174 */
1175 #undef __FUNCT__
1176 #define __FUNCT__ "PCGAMGOptProlongator_AGG"
1177 static PetscErrorCode PCGAMGOptProlongator_AGG(PC pc,Mat Amat,Mat *a_P)
1178 {
1179   PetscErrorCode ierr;
1180   PC_MG          *mg          = (PC_MG*)pc->data;
1181   PC_GAMG        *pc_gamg     = (PC_GAMG*)mg->innerctx;
1182   PC_GAMG_AGG    *pc_gamg_agg = (PC_GAMG_AGG*)pc_gamg->subctx;
1183   PetscInt       jj;
1184   Mat            Prol  = *a_P;
1185   MPI_Comm       comm;
1186   KSP            eksp;
1187   Vec            bb, xx;
1188   PC             epc;
1189   PetscReal      alpha, emax, emin;
1190 
1191   PetscFunctionBegin;
1192   ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
1193   ierr = PetscLogEventBegin(PC_GAMGOptProlongator_AGG,0,0,0,0);CHKERRQ(ierr);
1194 
1195   /* compute maximum value of operator to be used in smoother */
1196   if (0 < pc_gamg_agg->nsmooths) {
1197     ierr = MatCreateVecs(Amat, &bb, 0);CHKERRQ(ierr);
1198     ierr = MatCreateVecs(Amat, &xx, 0);CHKERRQ(ierr);
1199     ierr = VecSetRandom(bb,pc_gamg->random);CHKERRQ(ierr);
1200 
1201     ierr = KSPCreate(comm,&eksp);CHKERRQ(ierr);
1202     ierr = KSPSetErrorIfNotConverged(eksp,pc->erroriffailure);CHKERRQ(ierr);
1203     ierr = KSPSetTolerances(eksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,10);CHKERRQ(ierr);
1204     ierr = KSPSetNormType(eksp, KSP_NORM_NONE);CHKERRQ(ierr);
1205     ierr = KSPSetOptionsPrefix(eksp,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1206     ierr = KSPAppendOptionsPrefix(eksp, "gamg_est_");CHKERRQ(ierr);
1207     ierr = KSPSetFromOptions(eksp);CHKERRQ(ierr);
1208 
1209     ierr = KSPSetInitialGuessNonzero(eksp, PETSC_FALSE);CHKERRQ(ierr);
1210     ierr = KSPSetOperators(eksp, Amat, Amat);CHKERRQ(ierr);
1211     ierr = KSPSetComputeSingularValues(eksp,PETSC_TRUE);CHKERRQ(ierr);
1212 
1213     ierr = KSPGetPC(eksp, &epc);CHKERRQ(ierr);
1214     ierr = PCSetType(epc, PCJACOBI);CHKERRQ(ierr);  /* smoother in smoothed agg. */
1215 
1216     /* solve - keep stuff out of logging */
1217     ierr = PetscLogEventDeactivate(KSP_Solve);CHKERRQ(ierr);
1218     ierr = PetscLogEventDeactivate(PC_Apply);CHKERRQ(ierr);
1219     ierr = KSPSolve(eksp, bb, xx);CHKERRQ(ierr);
1220     ierr = PetscLogEventActivate(KSP_Solve);CHKERRQ(ierr);
1221     ierr = PetscLogEventActivate(PC_Apply);CHKERRQ(ierr);
1222 
1223     ierr = KSPComputeExtremeSingularValues(eksp, &emax, &emin);CHKERRQ(ierr);
1224     ierr = PetscInfo3(pc,"Smooth P0: max eigen=%e min=%e PC=%s\n",emax,emin,PCJACOBI);CHKERRQ(ierr);
1225     ierr = VecDestroy(&xx);CHKERRQ(ierr);
1226     ierr = VecDestroy(&bb);CHKERRQ(ierr);
1227     ierr = KSPDestroy(&eksp);CHKERRQ(ierr);
1228   }
1229 
1230   /* smooth P0 */
1231   for (jj = 0; jj < pc_gamg_agg->nsmooths; jj++) {
1232     Mat       tMat;
1233     Vec       diag;
1234 
1235 #if defined PETSC_GAMG_USE_LOG
1236     ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET9],0,0,0,0);CHKERRQ(ierr);
1237 #endif
1238 
1239     /* smooth P1 := (I - omega/lam D^{-1}A)P0 */
1240     ierr  = MatMatMult(Amat, Prol, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &tMat);CHKERRQ(ierr);
1241     ierr  = MatCreateVecs(Amat, &diag, 0);CHKERRQ(ierr);
1242     ierr  = MatGetDiagonal(Amat, diag);CHKERRQ(ierr); /* effectively PCJACOBI */
1243     ierr  = VecReciprocal(diag);CHKERRQ(ierr);
1244     ierr  = MatDiagonalScale(tMat, diag, 0);CHKERRQ(ierr);
1245     ierr  = VecDestroy(&diag);CHKERRQ(ierr);
1246     alpha = -1.4/emax;
1247     ierr  = MatAYPX(tMat, alpha, Prol, SUBSET_NONZERO_PATTERN);CHKERRQ(ierr);
1248     ierr  = MatDestroy(&Prol);CHKERRQ(ierr);
1249     Prol  = tMat;
1250 #if defined PETSC_GAMG_USE_LOG
1251     ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET9],0,0,0,0);CHKERRQ(ierr);
1252 #endif
1253   }
1254   ierr = PetscLogEventEnd(PC_GAMGOptProlongator_AGG,0,0,0,0);CHKERRQ(ierr);
1255   *a_P = Prol;
1256   PetscFunctionReturn(0);
1257 }
1258 
1259 /* -------------------------------------------------------------------------- */
1260 /*
1261    PCCreateGAMG_AGG
1262 
1263   Input Parameter:
1264    . pc -
1265 */
1266 #undef __FUNCT__
1267 #define __FUNCT__ "PCCreateGAMG_AGG"
1268 PetscErrorCode  PCCreateGAMG_AGG(PC pc)
1269 {
1270   PetscErrorCode ierr;
1271   PC_MG          *mg      = (PC_MG*)pc->data;
1272   PC_GAMG        *pc_gamg = (PC_GAMG*)mg->innerctx;
1273   PC_GAMG_AGG    *pc_gamg_agg;
1274 
1275   PetscFunctionBegin;
1276   /* create sub context for SA */
1277   ierr            = PetscNewLog(pc,&pc_gamg_agg);CHKERRQ(ierr);
1278   pc_gamg->subctx = pc_gamg_agg;
1279 
1280   pc_gamg->ops->setfromoptions = PCSetFromOptions_GAMG_AGG;
1281   pc_gamg->ops->destroy        = PCDestroy_GAMG_AGG;
1282   /* reset does not do anything; setup not virtual */
1283 
1284   /* set internal function pointers */
1285   pc_gamg->ops->graph             = PCGAMGGraph_AGG;
1286   pc_gamg->ops->coarsen           = PCGAMGCoarsen_AGG;
1287   pc_gamg->ops->prolongator       = PCGAMGProlongator_AGG;
1288   pc_gamg->ops->optprolongator    = PCGAMGOptProlongator_AGG;
1289   pc_gamg->ops->createdefaultdata = PCSetData_AGG;
1290   pc_gamg->ops->view              = PCView_GAMG_AGG;
1291 
1292   pc_gamg_agg->square_graph = 1;
1293   pc_gamg_agg->sym_graph    = PETSC_FALSE;
1294   pc_gamg_agg->nsmooths     = 1;
1295 
1296 
1297   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCGAMGSetNSmooths_C",PCGAMGSetNSmooths_AGG);CHKERRQ(ierr);
1298   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCGAMGSetSymGraph_C",PCGAMGSetSymGraph_AGG);CHKERRQ(ierr);
1299   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCGAMGSetSquareGraph_C",PCGAMGSetSquareGraph_AGG);CHKERRQ(ierr);
1300   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCSetCoordinates_C",PCSetCoordinates_AGG);CHKERRQ(ierr);
1301   PetscFunctionReturn(0);
1302 }
1303