xref: /petsc/src/mat/impls/adj/mpi/mpiadj.c (revision 0e36547b7d90d352a1c1f2d88179b3e4db2d71fb)
1 
2 /*
3     Defines the basic matrix operations for the ADJ adjacency list matrix data-structure.
4 */
5 #include <../src/mat/impls/adj/mpi/mpiadj.h>    /*I "petscmat.h" I*/
6 #include <petscsf.h>
7 
8 #undef __FUNCT__
9 #define __FUNCT__ "MatView_MPIAdj_ASCII"
10 PetscErrorCode MatView_MPIAdj_ASCII(Mat A,PetscViewer viewer)
11 {
12   Mat_MPIAdj        *a = (Mat_MPIAdj*)A->data;
13   PetscErrorCode    ierr;
14   PetscInt          i,j,m = A->rmap->n;
15   const char        *name;
16   PetscViewerFormat format;
17 
18   PetscFunctionBegin;
19   ierr = PetscObjectGetName((PetscObject)A,&name);CHKERRQ(ierr);
20   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
21   if (format == PETSC_VIEWER_ASCII_INFO) {
22     PetscFunctionReturn(0);
23   } else if (format == PETSC_VIEWER_ASCII_MATLAB) {
24     SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"MATLAB format not supported");
25   } else {
26     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
27     ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr);
28     for (i=0; i<m; i++) {
29       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"row %D:",i+A->rmap->rstart);CHKERRQ(ierr);
30       for (j=a->i[i]; j<a->i[i+1]; j++) {
31         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D ",a->j[j]);CHKERRQ(ierr);
32       }
33       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
34     }
35     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
36     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
37     ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr);
38   }
39   PetscFunctionReturn(0);
40 }
41 
42 #undef __FUNCT__
43 #define __FUNCT__ "MatView_MPIAdj"
44 PetscErrorCode MatView_MPIAdj(Mat A,PetscViewer viewer)
45 {
46   PetscErrorCode ierr;
47   PetscBool      iascii;
48 
49   PetscFunctionBegin;
50   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
51   if (iascii) {
52     ierr = MatView_MPIAdj_ASCII(A,viewer);CHKERRQ(ierr);
53   }
54   PetscFunctionReturn(0);
55 }
56 
57 #undef __FUNCT__
58 #define __FUNCT__ "MatDestroy_MPIAdj"
59 PetscErrorCode MatDestroy_MPIAdj(Mat mat)
60 {
61   Mat_MPIAdj     *a = (Mat_MPIAdj*)mat->data;
62   PetscErrorCode ierr;
63 
64   PetscFunctionBegin;
65 #if defined(PETSC_USE_LOG)
66   PetscLogObjectState((PetscObject)mat,"Rows=%D, Cols=%D, NZ=%D",mat->rmap->n,mat->cmap->n,a->nz);
67 #endif
68   ierr = PetscFree(a->diag);CHKERRQ(ierr);
69   if (a->freeaij) {
70     if (a->freeaijwithfree) {
71       if (a->i) free(a->i);
72       if (a->j) free(a->j);
73     } else {
74       ierr = PetscFree(a->i);CHKERRQ(ierr);
75       ierr = PetscFree(a->j);CHKERRQ(ierr);
76       ierr = PetscFree(a->values);CHKERRQ(ierr);
77     }
78   }
79   ierr = PetscFree(a->rowvalues);CHKERRQ(ierr);
80   ierr = PetscFree(mat->data);CHKERRQ(ierr);
81   ierr = PetscObjectChangeTypeName((PetscObject)mat,0);CHKERRQ(ierr);
82   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatMPIAdjSetPreallocation_C",NULL);CHKERRQ(ierr);
83   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatMPIAdjCreateNonemptySubcommMat_C",NULL);CHKERRQ(ierr);
84   PetscFunctionReturn(0);
85 }
86 
87 #undef __FUNCT__
88 #define __FUNCT__ "MatSetOption_MPIAdj"
89 PetscErrorCode MatSetOption_MPIAdj(Mat A,MatOption op,PetscBool flg)
90 {
91   Mat_MPIAdj     *a = (Mat_MPIAdj*)A->data;
92   PetscErrorCode ierr;
93 
94   PetscFunctionBegin;
95   switch (op) {
96   case MAT_SYMMETRIC:
97   case MAT_STRUCTURALLY_SYMMETRIC:
98   case MAT_HERMITIAN:
99     a->symmetric = flg;
100     break;
101   case MAT_SYMMETRY_ETERNAL:
102     break;
103   default:
104     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
105     break;
106   }
107   PetscFunctionReturn(0);
108 }
109 
110 
111 /*
112      Adds diagonal pointers to sparse matrix structure.
113 */
114 
115 #undef __FUNCT__
116 #define __FUNCT__ "MatMarkDiagonal_MPIAdj"
117 PetscErrorCode MatMarkDiagonal_MPIAdj(Mat A)
118 {
119   Mat_MPIAdj     *a = (Mat_MPIAdj*)A->data;
120   PetscErrorCode ierr;
121   PetscInt       i,j,m = A->rmap->n;
122 
123   PetscFunctionBegin;
124   ierr = PetscMalloc1(m,&a->diag);CHKERRQ(ierr);
125   ierr = PetscLogObjectMemory((PetscObject)A,m*sizeof(PetscInt));CHKERRQ(ierr);
126   for (i=0; i<A->rmap->n; i++) {
127     for (j=a->i[i]; j<a->i[i+1]; j++) {
128       if (a->j[j] == i) {
129         a->diag[i] = j;
130         break;
131       }
132     }
133   }
134   PetscFunctionReturn(0);
135 }
136 
137 #undef __FUNCT__
138 #define __FUNCT__ "MatGetRow_MPIAdj"
139 PetscErrorCode MatGetRow_MPIAdj(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
140 {
141   Mat_MPIAdj *a = (Mat_MPIAdj*)A->data;
142   PetscErrorCode ierr;
143 
144   PetscFunctionBegin;
145   row -= A->rmap->rstart;
146 
147   if (row < 0 || row >= A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row out of range");
148 
149   *nz = a->i[row+1] - a->i[row];
150   if (v) {
151     PetscInt j;
152     if (a->rowvalues_alloc < *nz) {
153       ierr = PetscFree(a->rowvalues);CHKERRQ(ierr);
154       a->rowvalues_alloc = PetscMax(a->rowvalues_alloc*2, *nz);
155       ierr = PetscMalloc1(a->rowvalues_alloc,&a->rowvalues);CHKERRQ(ierr);
156     }
157     for (j=0; j<*nz; j++) a->rowvalues[j] = a->values[a->i[row]+j];
158     *v = (*nz) ? a->rowvalues : NULL;
159   }
160   if (idx) *idx = (*nz) ? a->j + a->i[row] : NULL;
161   PetscFunctionReturn(0);
162 }
163 
164 #undef __FUNCT__
165 #define __FUNCT__ "MatRestoreRow_MPIAdj"
166 PetscErrorCode MatRestoreRow_MPIAdj(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
167 {
168   PetscFunctionBegin;
169   PetscFunctionReturn(0);
170 }
171 
172 #undef __FUNCT__
173 #define __FUNCT__ "MatEqual_MPIAdj"
174 PetscErrorCode MatEqual_MPIAdj(Mat A,Mat B,PetscBool * flg)
175 {
176   Mat_MPIAdj     *a = (Mat_MPIAdj*)A->data,*b = (Mat_MPIAdj*)B->data;
177   PetscErrorCode ierr;
178   PetscBool      flag;
179 
180   PetscFunctionBegin;
181   /* If the  matrix dimensions are not equal,or no of nonzeros */
182   if ((A->rmap->n != B->rmap->n) ||(a->nz != b->nz)) {
183     flag = PETSC_FALSE;
184   }
185 
186   /* if the a->i are the same */
187   ierr = PetscMemcmp(a->i,b->i,(A->rmap->n+1)*sizeof(PetscInt),&flag);CHKERRQ(ierr);
188 
189   /* if a->j are the same */
190   ierr = PetscMemcmp(a->j,b->j,(a->nz)*sizeof(PetscInt),&flag);CHKERRQ(ierr);
191 
192   ierr = MPI_Allreduce(&flag,flg,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
193   PetscFunctionReturn(0);
194 }
195 
196 #undef __FUNCT__
197 #define __FUNCT__ "MatGetRowIJ_MPIAdj"
198 PetscErrorCode MatGetRowIJ_MPIAdj(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool blockcompressed,PetscInt *m,const PetscInt *inia[],const PetscInt *inja[],PetscBool  *done)
199 {
200   PetscInt   i;
201   Mat_MPIAdj *a   = (Mat_MPIAdj*)A->data;
202   PetscInt   **ia = (PetscInt**)inia,**ja = (PetscInt**)inja;
203 
204   PetscFunctionBegin;
205   *m    = A->rmap->n;
206   *ia   = a->i;
207   *ja   = a->j;
208   *done = PETSC_TRUE;
209   if (oshift) {
210     for (i=0; i<(*ia)[*m]; i++) {
211       (*ja)[i]++;
212     }
213     for (i=0; i<=(*m); i++) (*ia)[i]++;
214   }
215   PetscFunctionReturn(0);
216 }
217 
218 #undef __FUNCT__
219 #define __FUNCT__ "MatRestoreRowIJ_MPIAdj"
220 PetscErrorCode MatRestoreRowIJ_MPIAdj(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool blockcompressed,PetscInt *m,const PetscInt *inia[],const PetscInt *inja[],PetscBool  *done)
221 {
222   PetscInt   i;
223   Mat_MPIAdj *a   = (Mat_MPIAdj*)A->data;
224   PetscInt   **ia = (PetscInt**)inia,**ja = (PetscInt**)inja;
225 
226   PetscFunctionBegin;
227   if (ia && a->i != *ia) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"ia passed back is not one obtained with MatGetRowIJ()");
228   if (ja && a->j != *ja) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"ja passed back is not one obtained with MatGetRowIJ()");
229   if (oshift) {
230     for (i=0; i<=(*m); i++) (*ia)[i]--;
231     for (i=0; i<(*ia)[*m]; i++) {
232       (*ja)[i]--;
233     }
234   }
235   PetscFunctionReturn(0);
236 }
237 
238 #undef __FUNCT__
239 #define __FUNCT__ "MatConvertFrom_MPIAdj"
240 PetscErrorCode  MatConvertFrom_MPIAdj(Mat A,MatType type,MatReuse reuse,Mat *newmat)
241 {
242   Mat               B;
243   PetscErrorCode    ierr;
244   PetscInt          i,m,N,nzeros = 0,*ia,*ja,len,rstart,cnt,j,*a;
245   const PetscInt    *rj;
246   const PetscScalar *ra;
247   MPI_Comm          comm;
248 
249   PetscFunctionBegin;
250   ierr = MatGetSize(A,NULL,&N);CHKERRQ(ierr);
251   ierr = MatGetLocalSize(A,&m,NULL);CHKERRQ(ierr);
252   ierr = MatGetOwnershipRange(A,&rstart,NULL);CHKERRQ(ierr);
253 
254   /* count the number of nonzeros per row */
255   for (i=0; i<m; i++) {
256     ierr = MatGetRow(A,i+rstart,&len,&rj,NULL);CHKERRQ(ierr);
257     for (j=0; j<len; j++) {
258       if (rj[j] == i+rstart) {len--; break;}    /* don't count diagonal */
259     }
260     nzeros += len;
261     ierr    = MatRestoreRow(A,i+rstart,&len,&rj,NULL);CHKERRQ(ierr);
262   }
263 
264   /* malloc space for nonzeros */
265   ierr = PetscMalloc1(nzeros+1,&a);CHKERRQ(ierr);
266   ierr = PetscMalloc1(N+1,&ia);CHKERRQ(ierr);
267   ierr = PetscMalloc1(nzeros+1,&ja);CHKERRQ(ierr);
268 
269   nzeros = 0;
270   ia[0]  = 0;
271   for (i=0; i<m; i++) {
272     ierr = MatGetRow(A,i+rstart,&len,&rj,&ra);CHKERRQ(ierr);
273     cnt  = 0;
274     for (j=0; j<len; j++) {
275       if (rj[j] != i+rstart) { /* if not diagonal */
276         a[nzeros+cnt]    = (PetscInt) PetscAbsScalar(ra[j]);
277         ja[nzeros+cnt++] = rj[j];
278       }
279     }
280     ierr    = MatRestoreRow(A,i+rstart,&len,&rj,&ra);CHKERRQ(ierr);
281     nzeros += cnt;
282     ia[i+1] = nzeros;
283   }
284 
285   ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
286   ierr = MatCreate(comm,&B);CHKERRQ(ierr);
287   ierr = MatSetSizes(B,m,PETSC_DETERMINE,PETSC_DETERMINE,N);CHKERRQ(ierr);
288   ierr = MatSetType(B,type);CHKERRQ(ierr);
289   ierr = MatMPIAdjSetPreallocation(B,ia,ja,a);CHKERRQ(ierr);
290 
291   if (reuse == MAT_REUSE_MATRIX) {
292     ierr = MatHeaderReplace(A,B);CHKERRQ(ierr);
293   } else {
294     *newmat = B;
295   }
296   PetscFunctionReturn(0);
297 }
298 
299 /* -------------------------------------------------------------------*/
300 static struct _MatOps MatOps_Values = {0,
301                                        MatGetRow_MPIAdj,
302                                        MatRestoreRow_MPIAdj,
303                                        0,
304                                 /* 4*/ 0,
305                                        0,
306                                        0,
307                                        0,
308                                        0,
309                                        0,
310                                 /*10*/ 0,
311                                        0,
312                                        0,
313                                        0,
314                                        0,
315                                 /*15*/ 0,
316                                        MatEqual_MPIAdj,
317                                        0,
318                                        0,
319                                        0,
320                                 /*20*/ 0,
321                                        0,
322                                        MatSetOption_MPIAdj,
323                                        0,
324                                 /*24*/ 0,
325                                        0,
326                                        0,
327                                        0,
328                                        0,
329                                 /*29*/ 0,
330                                        0,
331                                        0,
332                                        0,
333                                        0,
334                                 /*34*/ 0,
335                                        0,
336                                        0,
337                                        0,
338                                        0,
339                                 /*39*/ 0,
340                                        MatGetSubMatrices_MPIAdj,
341                                        0,
342                                        0,
343                                        0,
344                                 /*44*/ 0,
345                                        0,
346                                        MatShift_Basic,
347                                        0,
348                                        0,
349                                 /*49*/ 0,
350                                        MatGetRowIJ_MPIAdj,
351                                        MatRestoreRowIJ_MPIAdj,
352                                        0,
353                                        0,
354                                 /*54*/ 0,
355                                        0,
356                                        0,
357                                        0,
358                                        0,
359                                 /*59*/ 0,
360                                        MatDestroy_MPIAdj,
361                                        MatView_MPIAdj,
362                                        MatConvertFrom_MPIAdj,
363                                        0,
364                                 /*64*/ 0,
365                                        0,
366                                        0,
367                                        0,
368                                        0,
369                                 /*69*/ 0,
370                                        0,
371                                        0,
372                                        0,
373                                        0,
374                                 /*74*/ 0,
375                                        0,
376                                        0,
377                                        0,
378                                        0,
379                                 /*79*/ 0,
380                                        0,
381                                        0,
382                                        0,
383                                        0,
384                                 /*84*/ 0,
385                                        0,
386                                        0,
387                                        0,
388                                        0,
389                                 /*89*/ 0,
390                                        0,
391                                        0,
392                                        0,
393                                        0,
394                                 /*94*/ 0,
395                                        0,
396                                        0,
397                                        0,
398                                        0,
399                                 /*99*/ 0,
400                                        0,
401                                        0,
402                                        0,
403                                        0,
404                                /*104*/ 0,
405                                        0,
406                                        0,
407                                        0,
408                                        0,
409                                /*109*/ 0,
410                                        0,
411                                        0,
412                                        0,
413                                        0,
414                                /*114*/ 0,
415                                        0,
416                                        0,
417                                        0,
418                                        0,
419                                /*119*/ 0,
420                                        0,
421                                        0,
422                                        0,
423                                        0,
424                                /*124*/ 0,
425                                        0,
426                                        0,
427                                        0,
428                                        0,
429                                /*129*/ 0,
430                                        0,
431                                        0,
432                                        0,
433                                        0,
434                                /*134*/ 0,
435                                        0,
436                                        0,
437                                        0,
438                                        0,
439                                /*139*/ 0,
440                                        0,
441                                        0
442 };
443 
444 #undef __FUNCT__
445 #define __FUNCT__ "MatMPIAdjSetPreallocation_MPIAdj"
446 static PetscErrorCode  MatMPIAdjSetPreallocation_MPIAdj(Mat B,PetscInt *i,PetscInt *j,PetscInt *values)
447 {
448   Mat_MPIAdj     *b = (Mat_MPIAdj*)B->data;
449   PetscErrorCode ierr;
450 #if defined(PETSC_USE_DEBUG)
451   PetscInt ii;
452 #endif
453 
454   PetscFunctionBegin;
455   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
456   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
457 
458 #if defined(PETSC_USE_DEBUG)
459   if (i[0] != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"First i[] index must be zero, instead it is %D\n",i[0]);
460   for (ii=1; ii<B->rmap->n; ii++) {
461     if (i[ii] < 0 || i[ii] < i[ii-1]) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i[%D]=%D index is out of range: i[%D]=%D",ii,i[ii],ii-1,i[ii-1]);
462   }
463   for (ii=0; ii<i[B->rmap->n]; ii++) {
464     if (j[ii] < 0 || j[ii] >= B->cmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column index %D out of range %D\n",ii,j[ii]);
465   }
466 #endif
467   B->preallocated = PETSC_TRUE;
468 
469   b->j      = j;
470   b->i      = i;
471   b->values = values;
472 
473   b->nz        = i[B->rmap->n];
474   b->diag      = 0;
475   b->symmetric = PETSC_FALSE;
476   b->freeaij   = PETSC_TRUE;
477 
478   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
479   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
480   PetscFunctionReturn(0);
481 }
482 
483 static PetscErrorCode MatGetSubMatrix_MPIAdj_data(Mat adj,IS irows, IS icols, PetscInt **sadj_xadj,PetscInt **sadj_adjncy,PetscInt **sadj_values);
484 
485 #undef __FUNCT__
486 #define __FUNCT__ "MatGetSubMatrices_MPIAdj"
487 PetscErrorCode MatGetSubMatrices_MPIAdj(Mat mat,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *submat[])
488 {
489   PetscInt           i,irow_n,icol_n,*sxadj,*sadjncy,*svalues;
490   PetscInt          *indices,nindx,j,k,loc;
491   const PetscInt    *irow_indices,*icol_indices;
492   PetscErrorCode     ierr;
493 
494   PetscFunctionBegin;
495   nindx = 0;
496   for(i=0; i<n; i++){
497     ierr = ISGetLocalSize(irow[i],&irow_n);CHKERRQ(ierr);
498     ierr = ISGetLocalSize(icol[i],&icol_n);CHKERRQ(ierr);
499     nindx = nindx>(irow_n+icol_n)? nindx:(irow_n+icol_n);
500   }
501   ierr = PetscCalloc1(nindx,&indices);CHKERRQ(ierr);
502   for(i=0; i<n; i++){
503     ierr = MatGetSubMatrix_MPIAdj_data(mat,irow[i],icol[i],&sxadj,&sadjncy,&svalues);CHKERRQ(ierr);
504     ierr = ISGetLocalSize(irow[i],&irow_n);CHKERRQ(ierr);
505     ierr = ISGetLocalSize(icol[i],&icol_n);CHKERRQ(ierr);
506     ierr = ISGetIndices(irow[i],&irow_indices);CHKERRQ(ierr);
507     ierr = PetscMemcpy(indices,irow_indices,sizeof(PetscInt)*irow_n);CHKERRQ(ierr);
508     ierr = ISRestoreIndices(irow[i],&irow_indices);CHKERRQ(ierr);
509     ierr = ISGetIndices(icol[i],&icol_indices);CHKERRQ(ierr);
510     ierr = PetscMemcpy(indices+irow_n,icol_indices,sizeof(PetscInt)*icol_n);CHKERRQ(ierr);
511     ierr = ISRestoreIndices(icol[i],&icol_indices);CHKERRQ(ierr);
512     nindx = irow_n+icol_n;
513     ierr = PetscSortRemoveDupsInt(&nindx,indices);CHKERRQ(ierr);
514     for(j=0; j<irow_n; j++){
515       for(k=sxadj[j]; k<sxadj[j]; k++){
516     	ierr = PetscFindInt(sadjncy[k],nindx,indices,&loc);CHKERRQ(ierr);
517 #if PETSC_USE_DEBUG
518     	if(loc<0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"can not find col %d \n",sadjncy[k]);
519 #endif
520         sadjncy[k] = loc;
521       }
522     }
523     if(scall==MAT_INITIAL_MATRIX){
524       ierr = MatCreateMPIAdj(PETSC_COMM_SELF,irow_n,icol_n,sxadj,sadjncy,svalues,submat[i]);CHKERRQ(ierr);
525     }else{
526        Mat                sadj = *(submat[i]);
527        Mat_MPIAdj        *sa = (Mat_MPIAdj*)((sadj)->data);
528        ierr = PetscMemcpy(sa->i,sxadj,sizeof(PetscInt)*(irow_n+1));CHKERRQ(ierr);
529        ierr = PetscMemcpy(sa->j,sadjncy,sizeof(PetscInt)*sxadj[irow_n]);CHKERRQ(ierr);
530        if(svalues){ierr = PetscMemcpy(sa->values,svalues,sizeof(PetscInt)*sxadj[irow_n]);CHKERRQ(ierr);}
531        ierr = PetscFree(sxadj);CHKERRQ(ierr);
532        ierr = PetscFree(sadjncy);CHKERRQ(ierr);
533        if(svalues) {ierr = PetscFree(svalues);CHKERRQ(ierr);}
534     }
535   }
536   ierr = PetscFree(indices);CHKERRQ(ierr);
537   PetscFunctionReturn(0);
538 }
539 
540 
541 #undef __FUNCT__
542 #define __FUNCT__ "MatGetSubMatrix_MPIAdj_data"
543 /*
544  * The interface should be easy to use for both MatGetSubMatrix (parallel sub-matrix) and MatGetSubMatrices (sequential sub-matrices)
545  * */
546 static PetscErrorCode MatGetSubMatrix_MPIAdj_data(Mat adj,IS irows, IS icols, PetscInt **sadj_xadj,PetscInt **sadj_adjncy,PetscInt **sadj_values)
547 {
548   PetscInt        	 nlrows_is,icols_n,i,j,nroots,nleaves,owner,rlocalindex,*ncols_send,*ncols_recv;
549   PetscInt           nlrows_mat,*adjncy_recv,Ncols_recv,Ncols_send,*xadj_recv,*values_recv;
550   PetscInt          *ncols_recv_offsets,loc,rnclos,*sadjncy,*sxadj,*svalues,isvalue;
551   const PetscInt    *irows_indices,*icols_indices,*xadj, *adjncy;
552   Mat_MPIAdj        *a = (Mat_MPIAdj*)adj->data;
553   PetscLayout        rmap;
554   MPI_Comm           comm;
555   PetscSF            sf;
556   PetscSFNode       *iremote;
557   PetscBool          done;
558   PetscErrorCode     ierr;
559 
560   PetscFunctionBegin;
561   /* communicator */
562   ierr = PetscObjectGetComm((PetscObject)adj,&comm);CHKERRQ(ierr);
563   /* Layouts */
564   ierr = MatGetLayouts(adj,&rmap,PETSC_NULL);CHKERRQ(ierr);
565   /* get rows information */
566   ierr = ISGetLocalSize(irows,&nlrows_is);CHKERRQ(ierr);
567   ierr = ISGetIndices(irows,&irows_indices);CHKERRQ(ierr);
568   ierr = PetscCalloc1(nlrows_is,&iremote);CHKERRQ(ierr);
569   /* construct sf graph*/
570   nleaves = nlrows_is;
571   for(i=0; i<nlrows_is; i++){
572     ierr = PetscLayoutFindOwnerIndex(rmap,irows_indices[i],&owner,&rlocalindex);CHKERRQ(ierr);
573     iremote[i].rank  = owner;
574     iremote[i].index = rlocalindex;
575   }
576   ierr = MatGetRowIJ(adj,0,PETSC_FALSE,PETSC_FALSE,&nlrows_mat,&xadj,&adjncy,&done);CHKERRQ(ierr);
577   ierr = PetscCalloc4(nlrows_mat,&ncols_send,nlrows_is,&xadj_recv,nlrows_is+1,&ncols_recv_offsets,nlrows_is,&ncols_recv);CHKERRQ(ierr);
578   nroots = nlrows_mat;
579   for(i=0; i<nlrows_mat; i++){
580 	ncols_send[i] = xadj[i+1]-xadj[i];
581   }
582   ierr = PetscSFCreate(comm,&sf);CHKERRQ(ierr);
583   ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr);
584   ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
585   ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
586   ierr = PetscSFBcastBegin(sf,MPIU_INT,ncols_send,ncols_recv);CHKERRQ(ierr);
587   ierr = PetscSFBcastEnd(sf,MPIU_INT,ncols_send,ncols_recv);CHKERRQ(ierr);
588   ierr = PetscSFBcastBegin(sf,MPIU_INT,xadj,xadj_recv);CHKERRQ(ierr);
589   ierr = PetscSFBcastEnd(sf,MPIU_INT,xadj,xadj_recv);CHKERRQ(ierr);
590   ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
591   Ncols_recv =0;
592   for(i=0; i<nlrows_is; i++){
593 	 Ncols_recv             += ncols_recv[i];
594 	 ncols_recv_offsets[i+1] = ncols_recv[i]+ncols_recv_offsets[i];
595   }
596   Ncols_send = 0;
597   for(i=0; i<nlrows_mat; i++){
598 	Ncols_send += ncols_send[i];
599   }
600   ierr = PetscCalloc1(Ncols_recv,&iremote);CHKERRQ(ierr);
601   ierr = PetscCalloc1(Ncols_recv,&adjncy_recv);CHKERRQ(ierr);
602   nleaves = Ncols_recv;
603   Ncols_recv = 0;
604   for(i=0; i<nlrows_is; i++){
605     ierr = PetscLayoutFindOwner(rmap,irows_indices[i],&owner);CHKERRQ(ierr);
606     for(j=0; j<ncols_recv[i]; j++){
607       iremote[Ncols_recv].rank    = owner;
608       iremote[Ncols_recv++].index = xadj_recv[i]+j;
609     }
610   }
611   ierr = ISRestoreIndices(irows,&irows_indices);CHKERRQ(ierr);
612   /*if we need to deal with edge weights */
613   if(a->values){isvalue=1;}else{isvalue=0;}
614   /*involve a global communication */
615   ierr = MPI_Allreduce(&isvalue,&isvalue,1,MPIU_INT,MPIU_SUM,comm);CHKERRQ(ierr);
616   if(isvalue){ierr = PetscCalloc1(Ncols_recv,&values_recv);CHKERRQ(ierr);}
617   nroots = Ncols_send;
618   ierr = PetscSFCreate(comm,&sf);CHKERRQ(ierr);
619   ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr);
620   ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
621   ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
622   ierr = PetscSFBcastBegin(sf,MPIU_INT,adjncy,adjncy_recv);CHKERRQ(ierr);
623   ierr = PetscSFBcastEnd(sf,MPIU_INT,adjncy,adjncy_recv);CHKERRQ(ierr);
624   if(isvalue){
625 	ierr = PetscSFBcastBegin(sf,MPIU_INT,a->values,values_recv);CHKERRQ(ierr);
626 	ierr = PetscSFBcastEnd(sf,MPIU_INT,a->values,values_recv);CHKERRQ(ierr);
627   }
628   ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
629   ierr = MatRestoreRowIJ(adj,0,PETSC_FALSE,PETSC_FALSE,&nlrows_mat,&xadj,&adjncy,&done);CHKERRQ(ierr);
630   ierr = ISGetLocalSize(icols,&icols_n);CHKERRQ(ierr);
631   ierr = ISGetIndices(icols,&icols_indices);CHKERRQ(ierr);
632   rnclos = 0;
633   for(i=0; i<nlrows_is; i++){
634     for(j=ncols_recv_offsets[i]; j<ncols_recv_offsets[i+1]; j++){
635       ierr = PetscFindInt(adjncy_recv[j], icols_n, icols_indices, &loc);CHKERRQ(ierr);
636       if(loc<0){
637         adjncy_recv[j] = -1;
638         if(isvalue) values_recv[j] = -1;
639         ncols_recv[i]--;
640       }else{
641     	rnclos++;
642       }
643     }
644   }
645   ierr = ISRestoreIndices(icols,&icols_indices);CHKERRQ(ierr);
646   ierr = PetscCalloc1(rnclos,&sadjncy);CHKERRQ(ierr);
647   if(isvalue) {ierr = PetscCalloc1(rnclos,&svalues);CHKERRQ(ierr);}
648   ierr = PetscCalloc1(nlrows_is+1,&sxadj);CHKERRQ(ierr);
649   rnclos = 0;
650   for(i=0; i<nlrows_is; i++){
651 	for(j=ncols_recv_offsets[i]; j<ncols_recv_offsets[i+1]; j++){
652 	  if(adjncy_recv[j]<0) continue;
653 	  sadjncy[rnclos] = adjncy_recv[j];
654 	  if(isvalue) svalues[rnclos] = values_recv[j];
655 	  rnclos++;
656 	}
657   }
658   for(i=0; i<nlrows_is; i++){
659 	sxadj[i+1] = sxadj[i]+ncols_recv[i];
660   }
661   if(sadj_xadj)  { *sadj_xadj = sxadj;}else    { ierr = PetscFree(sxadj);CHKERRQ(ierr);}
662   if(sadj_adjncy){ *sadj_adjncy = sadjncy;}else{ ierr = PetscFree(sadjncy);CHKERRQ(ierr);}
663   if(sadj_values){
664 	if(isvalue) *sadj_values = svalues; else *sadj_values=0;
665   }else{
666 	if(isvalue) {ierr = PetscFree(svalues);CHKERRQ(ierr);}
667   }
668   ierr = PetscFree4(ncols_send,xadj_recv,ncols_recv_offsets,ncols_recv);CHKERRQ(ierr);
669   ierr = PetscFree(adjncy_recv);CHKERRQ(ierr);
670   if(isvalue) {ierr = PetscFree(values_recv);CHKERRQ(ierr);}
671   PetscFunctionReturn(0);
672 }
673 
674 
675 #undef __FUNCT__
676 #define __FUNCT__ "MatMPIAdjCreateNonemptySubcommMat_MPIAdj"
677 static PetscErrorCode MatMPIAdjCreateNonemptySubcommMat_MPIAdj(Mat A,Mat *B)
678 {
679   Mat_MPIAdj     *a = (Mat_MPIAdj*)A->data;
680   PetscErrorCode ierr;
681   const PetscInt *ranges;
682   MPI_Comm       acomm,bcomm;
683   MPI_Group      agroup,bgroup;
684   PetscMPIInt    i,rank,size,nranks,*ranks;
685 
686   PetscFunctionBegin;
687   *B    = NULL;
688   ierr  = PetscObjectGetComm((PetscObject)A,&acomm);CHKERRQ(ierr);
689   ierr  = MPI_Comm_size(acomm,&size);CHKERRQ(ierr);
690   ierr  = MPI_Comm_size(acomm,&rank);CHKERRQ(ierr);
691   ierr  = MatGetOwnershipRanges(A,&ranges);CHKERRQ(ierr);
692   for (i=0,nranks=0; i<size; i++) {
693     if (ranges[i+1] - ranges[i] > 0) nranks++;
694   }
695   if (nranks == size) {         /* All ranks have a positive number of rows, so we do not need to create a subcomm; */
696     ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
697     *B   = A;
698     PetscFunctionReturn(0);
699   }
700 
701   ierr = PetscMalloc1(nranks,&ranks);CHKERRQ(ierr);
702   for (i=0,nranks=0; i<size; i++) {
703     if (ranges[i+1] - ranges[i] > 0) ranks[nranks++] = i;
704   }
705   ierr = MPI_Comm_group(acomm,&agroup);CHKERRQ(ierr);
706   ierr = MPI_Group_incl(agroup,nranks,ranks,&bgroup);CHKERRQ(ierr);
707   ierr = PetscFree(ranks);CHKERRQ(ierr);
708   ierr = MPI_Comm_create(acomm,bgroup,&bcomm);CHKERRQ(ierr);
709   ierr = MPI_Group_free(&agroup);CHKERRQ(ierr);
710   ierr = MPI_Group_free(&bgroup);CHKERRQ(ierr);
711   if (bcomm != MPI_COMM_NULL) {
712     PetscInt   m,N;
713     Mat_MPIAdj *b;
714     ierr       = MatGetLocalSize(A,&m,NULL);CHKERRQ(ierr);
715     ierr       = MatGetSize(A,NULL,&N);CHKERRQ(ierr);
716     ierr       = MatCreateMPIAdj(bcomm,m,N,a->i,a->j,a->values,B);CHKERRQ(ierr);
717     b          = (Mat_MPIAdj*)(*B)->data;
718     b->freeaij = PETSC_FALSE;
719     ierr       = MPI_Comm_free(&bcomm);CHKERRQ(ierr);
720   }
721   PetscFunctionReturn(0);
722 }
723 
724 #undef __FUNCT__
725 #define __FUNCT__ "MatMPIAdjCreateNonemptySubcommMat"
726 /*@
727    MatMPIAdjCreateNonemptySubcommMat - create the same MPIAdj matrix on a subcommunicator containing only processes owning a positive number of rows
728 
729    Collective
730 
731    Input Arguments:
732 .  A - original MPIAdj matrix
733 
734    Output Arguments:
735 .  B - matrix on subcommunicator, NULL on ranks that owned zero rows of A
736 
737    Level: developer
738 
739    Note:
740    This function is mostly useful for internal use by mesh partitioning packages that require that every process owns at least one row.
741 
742    The matrix B should be destroyed with MatDestroy(). The arrays are not copied, so B should be destroyed before A is destroyed.
743 
744 .seealso: MatCreateMPIAdj()
745 @*/
746 PetscErrorCode MatMPIAdjCreateNonemptySubcommMat(Mat A,Mat *B)
747 {
748   PetscErrorCode ierr;
749 
750   PetscFunctionBegin;
751   PetscValidHeaderSpecific(A,MAT_CLASSID,1);
752   ierr = PetscUseMethod(A,"MatMPIAdjCreateNonemptySubcommMat_C",(Mat,Mat*),(A,B));CHKERRQ(ierr);
753   PetscFunctionReturn(0);
754 }
755 
756 /*MC
757    MATMPIADJ - MATMPIADJ = "mpiadj" - A matrix type to be used for distributed adjacency matrices,
758    intended for use constructing orderings and partitionings.
759 
760   Level: beginner
761 
762 .seealso: MatCreateMPIAdj
763 M*/
764 
765 #undef __FUNCT__
766 #define __FUNCT__ "MatCreate_MPIAdj"
767 PETSC_EXTERN PetscErrorCode MatCreate_MPIAdj(Mat B)
768 {
769   Mat_MPIAdj     *b;
770   PetscErrorCode ierr;
771 
772   PetscFunctionBegin;
773   ierr         = PetscNewLog(B,&b);CHKERRQ(ierr);
774   B->data      = (void*)b;
775   ierr         = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
776   B->assembled = PETSC_FALSE;
777 
778   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMPIAdjSetPreallocation_C",MatMPIAdjSetPreallocation_MPIAdj);CHKERRQ(ierr);
779   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMPIAdjCreateNonemptySubcommMat_C",MatMPIAdjCreateNonemptySubcommMat_MPIAdj);CHKERRQ(ierr);
780   ierr = PetscObjectChangeTypeName((PetscObject)B,MATMPIADJ);CHKERRQ(ierr);
781   PetscFunctionReturn(0);
782 }
783 
784 #undef __FUNCT__
785 #define __FUNCT__ "MatMPIAdjSetPreallocation"
786 /*@C
787    MatMPIAdjSetPreallocation - Sets the array used for storing the matrix elements
788 
789    Logically Collective on MPI_Comm
790 
791    Input Parameters:
792 +  A - the matrix
793 .  i - the indices into j for the start of each row
794 .  j - the column indices for each row (sorted for each row).
795        The indices in i and j start with zero (NOT with one).
796 -  values - [optional] edge weights
797 
798    Level: intermediate
799 
800 .seealso: MatCreate(), MatCreateMPIAdj(), MatSetValues()
801 @*/
802 PetscErrorCode  MatMPIAdjSetPreallocation(Mat B,PetscInt *i,PetscInt *j,PetscInt *values)
803 {
804   PetscErrorCode ierr;
805 
806   PetscFunctionBegin;
807   ierr = PetscTryMethod(B,"MatMPIAdjSetPreallocation_C",(Mat,PetscInt*,PetscInt*,PetscInt*),(B,i,j,values));CHKERRQ(ierr);
808   PetscFunctionReturn(0);
809 }
810 
811 #undef __FUNCT__
812 #define __FUNCT__ "MatCreateMPIAdj"
813 /*@C
814    MatCreateMPIAdj - Creates a sparse matrix representing an adjacency list.
815    The matrix does not have numerical values associated with it, but is
816    intended for ordering (to reduce bandwidth etc) and partitioning.
817 
818    Collective on MPI_Comm
819 
820    Input Parameters:
821 +  comm - MPI communicator
822 .  m - number of local rows
823 .  N - number of global columns
824 .  i - the indices into j for the start of each row
825 .  j - the column indices for each row (sorted for each row).
826        The indices in i and j start with zero (NOT with one).
827 -  values -[optional] edge weights
828 
829    Output Parameter:
830 .  A - the matrix
831 
832    Level: intermediate
833 
834    Notes: This matrix object does not support most matrix operations, include
835    MatSetValues().
836    You must NOT free the ii, values and jj arrays yourself. PETSc will free them
837    when the matrix is destroyed; you must allocate them with PetscMalloc(). If you
838     call from Fortran you need not create the arrays with PetscMalloc().
839    Should not include the matrix diagonals.
840 
841    If you already have a matrix, you can create its adjacency matrix by a call
842    to MatConvert, specifying a type of MATMPIADJ.
843 
844    Possible values for MatSetOption() - MAT_STRUCTURALLY_SYMMETRIC
845 
846 .seealso: MatCreate(), MatConvert(), MatGetOrdering()
847 @*/
848 PetscErrorCode  MatCreateMPIAdj(MPI_Comm comm,PetscInt m,PetscInt N,PetscInt *i,PetscInt *j,PetscInt *values,Mat *A)
849 {
850   PetscErrorCode ierr;
851 
852   PetscFunctionBegin;
853   ierr = MatCreate(comm,A);CHKERRQ(ierr);
854   ierr = MatSetSizes(*A,m,PETSC_DETERMINE,PETSC_DETERMINE,N);CHKERRQ(ierr);
855   ierr = MatSetType(*A,MATMPIADJ);CHKERRQ(ierr);
856   ierr = MatMPIAdjSetPreallocation(*A,i,j,values);CHKERRQ(ierr);
857   PetscFunctionReturn(0);
858 }
859 
860 
861 
862 
863 
864 
865 
866