xref: /petsc/src/mat/impls/aij/mpi/mpiaij.c (revision 2e92ee13a8395f820cc1e3fd74a7607ed52efa2a)
1 
2 #include <../src/mat/impls/aij/mpi/mpiaij.h>   /*I "petscmat.h" I*/
3 #include <petsc/private/vecimpl.h>
4 #include <petsc/private/isimpl.h>
5 #include <petscblaslapack.h>
6 #include <petscsf.h>
7 
8 /*MC
9    MATAIJ - MATAIJ = "aij" - A matrix type to be used for sparse matrices.
10 
11    This matrix type is identical to MATSEQAIJ when constructed with a single process communicator,
12    and MATMPIAIJ otherwise.  As a result, for single process communicators,
13   MatSeqAIJSetPreallocation is supported, and similarly MatMPIAIJSetPreallocation is supported
14   for communicators controlling multiple processes.  It is recommended that you call both of
15   the above preallocation routines for simplicity.
16 
17    Options Database Keys:
18 . -mat_type aij - sets the matrix type to "aij" during a call to MatSetFromOptions()
19 
20   Developer Notes: Subclasses include MATAIJCUSP, MATAIJCUSPARSE, MATAIJPERM, MATAIJCRL, and also automatically switches over to use inodes when
21    enough exist.
22 
23   Level: beginner
24 
25 .seealso: MatCreateAIJ(), MatCreateSeqAIJ(), MATSEQAIJ,MATMPIAIJ
26 M*/
27 
28 /*MC
29    MATAIJCRL - MATAIJCRL = "aijcrl" - A matrix type to be used for sparse matrices.
30 
31    This matrix type is identical to MATSEQAIJCRL when constructed with a single process communicator,
32    and MATMPIAIJCRL otherwise.  As a result, for single process communicators,
33    MatSeqAIJSetPreallocation() is supported, and similarly MatMPIAIJSetPreallocation() is supported
34   for communicators controlling multiple processes.  It is recommended that you call both of
35   the above preallocation routines for simplicity.
36 
37    Options Database Keys:
38 . -mat_type aijcrl - sets the matrix type to "aijcrl" during a call to MatSetFromOptions()
39 
40   Level: beginner
41 
42 .seealso: MatCreateMPIAIJCRL,MATSEQAIJCRL,MATMPIAIJCRL, MATSEQAIJCRL, MATMPIAIJCRL
43 M*/
44 
45 #undef __FUNCT__
46 #define __FUNCT__ "MatFindNonzeroRows_MPIAIJ"
47 PetscErrorCode MatFindNonzeroRows_MPIAIJ(Mat M,IS *keptrows)
48 {
49   PetscErrorCode  ierr;
50   Mat_MPIAIJ      *mat = (Mat_MPIAIJ*)M->data;
51   Mat_SeqAIJ      *a   = (Mat_SeqAIJ*)mat->A->data;
52   Mat_SeqAIJ      *b   = (Mat_SeqAIJ*)mat->B->data;
53   const PetscInt  *ia,*ib;
54   const MatScalar *aa,*bb;
55   PetscInt        na,nb,i,j,*rows,cnt=0,n0rows;
56   PetscInt        m = M->rmap->n,rstart = M->rmap->rstart;
57 
58   PetscFunctionBegin;
59   *keptrows = 0;
60   ia        = a->i;
61   ib        = b->i;
62   for (i=0; i<m; i++) {
63     na = ia[i+1] - ia[i];
64     nb = ib[i+1] - ib[i];
65     if (!na && !nb) {
66       cnt++;
67       goto ok1;
68     }
69     aa = a->a + ia[i];
70     for (j=0; j<na; j++) {
71       if (aa[j] != 0.0) goto ok1;
72     }
73     bb = b->a + ib[i];
74     for (j=0; j <nb; j++) {
75       if (bb[j] != 0.0) goto ok1;
76     }
77     cnt++;
78 ok1:;
79   }
80   ierr = MPIU_Allreduce(&cnt,&n0rows,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)M));CHKERRQ(ierr);
81   if (!n0rows) PetscFunctionReturn(0);
82   ierr = PetscMalloc1(M->rmap->n-cnt,&rows);CHKERRQ(ierr);
83   cnt  = 0;
84   for (i=0; i<m; i++) {
85     na = ia[i+1] - ia[i];
86     nb = ib[i+1] - ib[i];
87     if (!na && !nb) continue;
88     aa = a->a + ia[i];
89     for (j=0; j<na;j++) {
90       if (aa[j] != 0.0) {
91         rows[cnt++] = rstart + i;
92         goto ok2;
93       }
94     }
95     bb = b->a + ib[i];
96     for (j=0; j<nb; j++) {
97       if (bb[j] != 0.0) {
98         rows[cnt++] = rstart + i;
99         goto ok2;
100       }
101     }
102 ok2:;
103   }
104   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)M),cnt,rows,PETSC_OWN_POINTER,keptrows);CHKERRQ(ierr);
105   PetscFunctionReturn(0);
106 }
107 
108 #undef __FUNCT__
109 #define __FUNCT__ "MatDiagonalSet_MPIAIJ"
110 PetscErrorCode  MatDiagonalSet_MPIAIJ(Mat Y,Vec D,InsertMode is)
111 {
112   PetscErrorCode    ierr;
113   Mat_MPIAIJ        *aij = (Mat_MPIAIJ*) Y->data;
114 
115   PetscFunctionBegin;
116   if (Y->assembled && Y->rmap->rstart == Y->cmap->rstart && Y->rmap->rend == Y->cmap->rend) {
117     ierr = MatDiagonalSet(aij->A,D,is);CHKERRQ(ierr);
118   } else {
119     ierr = MatDiagonalSet_Default(Y,D,is);CHKERRQ(ierr);
120   }
121   PetscFunctionReturn(0);
122 }
123 
124 
125 #undef __FUNCT__
126 #define __FUNCT__ "MatFindZeroDiagonals_MPIAIJ"
127 PetscErrorCode MatFindZeroDiagonals_MPIAIJ(Mat M,IS *zrows)
128 {
129   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)M->data;
130   PetscErrorCode ierr;
131   PetscInt       i,rstart,nrows,*rows;
132 
133   PetscFunctionBegin;
134   *zrows = NULL;
135   ierr   = MatFindZeroDiagonals_SeqAIJ_Private(aij->A,&nrows,&rows);CHKERRQ(ierr);
136   ierr   = MatGetOwnershipRange(M,&rstart,NULL);CHKERRQ(ierr);
137   for (i=0; i<nrows; i++) rows[i] += rstart;
138   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)M),nrows,rows,PETSC_OWN_POINTER,zrows);CHKERRQ(ierr);
139   PetscFunctionReturn(0);
140 }
141 
142 #undef __FUNCT__
143 #define __FUNCT__ "MatGetColumnNorms_MPIAIJ"
144 PetscErrorCode MatGetColumnNorms_MPIAIJ(Mat A,NormType type,PetscReal *norms)
145 {
146   PetscErrorCode ierr;
147   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)A->data;
148   PetscInt       i,n,*garray = aij->garray;
149   Mat_SeqAIJ     *a_aij = (Mat_SeqAIJ*) aij->A->data;
150   Mat_SeqAIJ     *b_aij = (Mat_SeqAIJ*) aij->B->data;
151   PetscReal      *work;
152 
153   PetscFunctionBegin;
154   ierr = MatGetSize(A,NULL,&n);CHKERRQ(ierr);
155   ierr = PetscCalloc1(n,&work);CHKERRQ(ierr);
156   if (type == NORM_2) {
157     for (i=0; i<a_aij->i[aij->A->rmap->n]; i++) {
158       work[A->cmap->rstart + a_aij->j[i]] += PetscAbsScalar(a_aij->a[i]*a_aij->a[i]);
159     }
160     for (i=0; i<b_aij->i[aij->B->rmap->n]; i++) {
161       work[garray[b_aij->j[i]]] += PetscAbsScalar(b_aij->a[i]*b_aij->a[i]);
162     }
163   } else if (type == NORM_1) {
164     for (i=0; i<a_aij->i[aij->A->rmap->n]; i++) {
165       work[A->cmap->rstart + a_aij->j[i]] += PetscAbsScalar(a_aij->a[i]);
166     }
167     for (i=0; i<b_aij->i[aij->B->rmap->n]; i++) {
168       work[garray[b_aij->j[i]]] += PetscAbsScalar(b_aij->a[i]);
169     }
170   } else if (type == NORM_INFINITY) {
171     for (i=0; i<a_aij->i[aij->A->rmap->n]; i++) {
172       work[A->cmap->rstart + a_aij->j[i]] = PetscMax(PetscAbsScalar(a_aij->a[i]), work[A->cmap->rstart + a_aij->j[i]]);
173     }
174     for (i=0; i<b_aij->i[aij->B->rmap->n]; i++) {
175       work[garray[b_aij->j[i]]] = PetscMax(PetscAbsScalar(b_aij->a[i]),work[garray[b_aij->j[i]]]);
176     }
177 
178   } else SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Unknown NormType");
179   if (type == NORM_INFINITY) {
180     ierr = MPIU_Allreduce(work,norms,n,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
181   } else {
182     ierr = MPIU_Allreduce(work,norms,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
183   }
184   ierr = PetscFree(work);CHKERRQ(ierr);
185   if (type == NORM_2) {
186     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
187   }
188   PetscFunctionReturn(0);
189 }
190 
191 #undef __FUNCT__
192 #define __FUNCT__ "MatFindOffBlockDiagonalEntries_MPIAIJ"
193 PetscErrorCode MatFindOffBlockDiagonalEntries_MPIAIJ(Mat A,IS *is)
194 {
195   Mat_MPIAIJ      *a  = (Mat_MPIAIJ*)A->data;
196   IS              sis,gis;
197   PetscErrorCode  ierr;
198   const PetscInt  *isis,*igis;
199   PetscInt        n,*iis,nsis,ngis,rstart,i;
200 
201   PetscFunctionBegin;
202   ierr = MatFindOffBlockDiagonalEntries(a->A,&sis);CHKERRQ(ierr);
203   ierr = MatFindNonzeroRows(a->B,&gis);CHKERRQ(ierr);
204   ierr = ISGetSize(gis,&ngis);CHKERRQ(ierr);
205   ierr = ISGetSize(sis,&nsis);CHKERRQ(ierr);
206   ierr = ISGetIndices(sis,&isis);CHKERRQ(ierr);
207   ierr = ISGetIndices(gis,&igis);CHKERRQ(ierr);
208 
209   ierr = PetscMalloc1(ngis+nsis,&iis);CHKERRQ(ierr);
210   ierr = PetscMemcpy(iis,igis,ngis*sizeof(PetscInt));CHKERRQ(ierr);
211   ierr = PetscMemcpy(iis+ngis,isis,nsis*sizeof(PetscInt));CHKERRQ(ierr);
212   n    = ngis + nsis;
213   ierr = PetscSortRemoveDupsInt(&n,iis);CHKERRQ(ierr);
214   ierr = MatGetOwnershipRange(A,&rstart,NULL);CHKERRQ(ierr);
215   for (i=0; i<n; i++) iis[i] += rstart;
216   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)A),n,iis,PETSC_OWN_POINTER,is);CHKERRQ(ierr);
217 
218   ierr = ISRestoreIndices(sis,&isis);CHKERRQ(ierr);
219   ierr = ISRestoreIndices(gis,&igis);CHKERRQ(ierr);
220   ierr = ISDestroy(&sis);CHKERRQ(ierr);
221   ierr = ISDestroy(&gis);CHKERRQ(ierr);
222   PetscFunctionReturn(0);
223 }
224 
225 #undef __FUNCT__
226 #define __FUNCT__ "MatDistribute_MPIAIJ"
227 /*
228     Distributes a SeqAIJ matrix across a set of processes. Code stolen from
229     MatLoad_MPIAIJ(). Horrible lack of reuse. Should be a routine for each matrix type.
230 
231     Only for square matrices
232 
233     Used by a preconditioner, hence PETSC_EXTERN
234 */
235 PETSC_EXTERN PetscErrorCode MatDistribute_MPIAIJ(MPI_Comm comm,Mat gmat,PetscInt m,MatReuse reuse,Mat *inmat)
236 {
237   PetscMPIInt    rank,size;
238   PetscInt       *rowners,*dlens,*olens,i,rstart,rend,j,jj,nz = 0,*gmataj,cnt,row,*ld,bses[2];
239   PetscErrorCode ierr;
240   Mat            mat;
241   Mat_SeqAIJ     *gmata;
242   PetscMPIInt    tag;
243   MPI_Status     status;
244   PetscBool      aij;
245   MatScalar      *gmataa,*ao,*ad,*gmataarestore=0;
246 
247   PetscFunctionBegin;
248   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
249   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
250   if (!rank) {
251     ierr = PetscObjectTypeCompare((PetscObject)gmat,MATSEQAIJ,&aij);CHKERRQ(ierr);
252     if (!aij) SETERRQ1(PetscObjectComm((PetscObject)gmat),PETSC_ERR_SUP,"Currently no support for input matrix of type %s\n",((PetscObject)gmat)->type_name);
253   }
254   if (reuse == MAT_INITIAL_MATRIX) {
255     ierr = MatCreate(comm,&mat);CHKERRQ(ierr);
256     ierr = MatSetSizes(mat,m,m,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
257     ierr = MatGetBlockSizes(gmat,&bses[0],&bses[1]);CHKERRQ(ierr);
258     ierr = MPI_Bcast(bses,2,MPIU_INT,0,comm);CHKERRQ(ierr);
259     ierr = MatSetBlockSizes(mat,bses[0],bses[1]);CHKERRQ(ierr);
260     ierr = MatSetType(mat,MATAIJ);CHKERRQ(ierr);
261     ierr = PetscMalloc1(size+1,&rowners);CHKERRQ(ierr);
262     ierr = PetscMalloc2(m,&dlens,m,&olens);CHKERRQ(ierr);
263     ierr = MPI_Allgather(&m,1,MPIU_INT,rowners+1,1,MPIU_INT,comm);CHKERRQ(ierr);
264 
265     rowners[0] = 0;
266     for (i=2; i<=size; i++) rowners[i] += rowners[i-1];
267     rstart = rowners[rank];
268     rend   = rowners[rank+1];
269     ierr   = PetscObjectGetNewTag((PetscObject)mat,&tag);CHKERRQ(ierr);
270     if (!rank) {
271       gmata = (Mat_SeqAIJ*) gmat->data;
272       /* send row lengths to all processors */
273       for (i=0; i<m; i++) dlens[i] = gmata->ilen[i];
274       for (i=1; i<size; i++) {
275         ierr = MPI_Send(gmata->ilen + rowners[i],rowners[i+1]-rowners[i],MPIU_INT,i,tag,comm);CHKERRQ(ierr);
276       }
277       /* determine number diagonal and off-diagonal counts */
278       ierr = PetscMemzero(olens,m*sizeof(PetscInt));CHKERRQ(ierr);
279       ierr = PetscCalloc1(m,&ld);CHKERRQ(ierr);
280       jj   = 0;
281       for (i=0; i<m; i++) {
282         for (j=0; j<dlens[i]; j++) {
283           if (gmata->j[jj] < rstart) ld[i]++;
284           if (gmata->j[jj] < rstart || gmata->j[jj] >= rend) olens[i]++;
285           jj++;
286         }
287       }
288       /* send column indices to other processes */
289       for (i=1; i<size; i++) {
290         nz   = gmata->i[rowners[i+1]]-gmata->i[rowners[i]];
291         ierr = MPI_Send(&nz,1,MPIU_INT,i,tag,comm);CHKERRQ(ierr);
292         ierr = MPI_Send(gmata->j + gmata->i[rowners[i]],nz,MPIU_INT,i,tag,comm);CHKERRQ(ierr);
293       }
294 
295       /* send numerical values to other processes */
296       for (i=1; i<size; i++) {
297         nz   = gmata->i[rowners[i+1]]-gmata->i[rowners[i]];
298         ierr = MPI_Send(gmata->a + gmata->i[rowners[i]],nz,MPIU_SCALAR,i,tag,comm);CHKERRQ(ierr);
299       }
300       gmataa = gmata->a;
301       gmataj = gmata->j;
302 
303     } else {
304       /* receive row lengths */
305       ierr = MPI_Recv(dlens,m,MPIU_INT,0,tag,comm,&status);CHKERRQ(ierr);
306       /* receive column indices */
307       ierr = MPI_Recv(&nz,1,MPIU_INT,0,tag,comm,&status);CHKERRQ(ierr);
308       ierr = PetscMalloc2(nz,&gmataa,nz,&gmataj);CHKERRQ(ierr);
309       ierr = MPI_Recv(gmataj,nz,MPIU_INT,0,tag,comm,&status);CHKERRQ(ierr);
310       /* determine number diagonal and off-diagonal counts */
311       ierr = PetscMemzero(olens,m*sizeof(PetscInt));CHKERRQ(ierr);
312       ierr = PetscCalloc1(m,&ld);CHKERRQ(ierr);
313       jj   = 0;
314       for (i=0; i<m; i++) {
315         for (j=0; j<dlens[i]; j++) {
316           if (gmataj[jj] < rstart) ld[i]++;
317           if (gmataj[jj] < rstart || gmataj[jj] >= rend) olens[i]++;
318           jj++;
319         }
320       }
321       /* receive numerical values */
322       ierr = PetscMemzero(gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr);
323       ierr = MPI_Recv(gmataa,nz,MPIU_SCALAR,0,tag,comm,&status);CHKERRQ(ierr);
324     }
325     /* set preallocation */
326     for (i=0; i<m; i++) {
327       dlens[i] -= olens[i];
328     }
329     ierr = MatSeqAIJSetPreallocation(mat,0,dlens);CHKERRQ(ierr);
330     ierr = MatMPIAIJSetPreallocation(mat,0,dlens,0,olens);CHKERRQ(ierr);
331 
332     for (i=0; i<m; i++) {
333       dlens[i] += olens[i];
334     }
335     cnt = 0;
336     for (i=0; i<m; i++) {
337       row  = rstart + i;
338       ierr = MatSetValues(mat,1,&row,dlens[i],gmataj+cnt,gmataa+cnt,INSERT_VALUES);CHKERRQ(ierr);
339       cnt += dlens[i];
340     }
341     if (rank) {
342       ierr = PetscFree2(gmataa,gmataj);CHKERRQ(ierr);
343     }
344     ierr = PetscFree2(dlens,olens);CHKERRQ(ierr);
345     ierr = PetscFree(rowners);CHKERRQ(ierr);
346 
347     ((Mat_MPIAIJ*)(mat->data))->ld = ld;
348 
349     *inmat = mat;
350   } else {   /* column indices are already set; only need to move over numerical values from process 0 */
351     Mat_SeqAIJ *Ad = (Mat_SeqAIJ*)((Mat_MPIAIJ*)((*inmat)->data))->A->data;
352     Mat_SeqAIJ *Ao = (Mat_SeqAIJ*)((Mat_MPIAIJ*)((*inmat)->data))->B->data;
353     mat  = *inmat;
354     ierr = PetscObjectGetNewTag((PetscObject)mat,&tag);CHKERRQ(ierr);
355     if (!rank) {
356       /* send numerical values to other processes */
357       gmata  = (Mat_SeqAIJ*) gmat->data;
358       ierr   = MatGetOwnershipRanges(mat,(const PetscInt**)&rowners);CHKERRQ(ierr);
359       gmataa = gmata->a;
360       for (i=1; i<size; i++) {
361         nz   = gmata->i[rowners[i+1]]-gmata->i[rowners[i]];
362         ierr = MPI_Send(gmataa + gmata->i[rowners[i]],nz,MPIU_SCALAR,i,tag,comm);CHKERRQ(ierr);
363       }
364       nz = gmata->i[rowners[1]]-gmata->i[rowners[0]];
365     } else {
366       /* receive numerical values from process 0*/
367       nz   = Ad->nz + Ao->nz;
368       ierr = PetscMalloc1(nz,&gmataa);CHKERRQ(ierr); gmataarestore = gmataa;
369       ierr = MPI_Recv(gmataa,nz,MPIU_SCALAR,0,tag,comm,&status);CHKERRQ(ierr);
370     }
371     /* transfer numerical values into the diagonal A and off diagonal B parts of mat */
372     ld = ((Mat_MPIAIJ*)(mat->data))->ld;
373     ad = Ad->a;
374     ao = Ao->a;
375     if (mat->rmap->n) {
376       i  = 0;
377       nz = ld[i];                                   ierr = PetscMemcpy(ao,gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr); ao += nz; gmataa += nz;
378       nz = Ad->i[i+1] - Ad->i[i];                   ierr = PetscMemcpy(ad,gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr); ad += nz; gmataa += nz;
379     }
380     for (i=1; i<mat->rmap->n; i++) {
381       nz = Ao->i[i] - Ao->i[i-1] - ld[i-1] + ld[i]; ierr = PetscMemcpy(ao,gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr); ao += nz; gmataa += nz;
382       nz = Ad->i[i+1] - Ad->i[i];                   ierr = PetscMemcpy(ad,gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr); ad += nz; gmataa += nz;
383     }
384     i--;
385     if (mat->rmap->n) {
386       nz = Ao->i[i+1] - Ao->i[i] - ld[i];           ierr = PetscMemcpy(ao,gmataa,nz*sizeof(PetscScalar));CHKERRQ(ierr);
387     }
388     if (rank) {
389       ierr = PetscFree(gmataarestore);CHKERRQ(ierr);
390     }
391   }
392   ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
393   ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
394   PetscFunctionReturn(0);
395 }
396 
397 /*
398   Local utility routine that creates a mapping from the global column
399 number to the local number in the off-diagonal part of the local
400 storage of the matrix.  When PETSC_USE_CTABLE is used this is scalable at
401 a slightly higher hash table cost; without it it is not scalable (each processor
402 has an order N integer array but is fast to acess.
403 */
404 #undef __FUNCT__
405 #define __FUNCT__ "MatCreateColmap_MPIAIJ_Private"
406 PetscErrorCode MatCreateColmap_MPIAIJ_Private(Mat mat)
407 {
408   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
409   PetscErrorCode ierr;
410   PetscInt       n = aij->B->cmap->n,i;
411 
412   PetscFunctionBegin;
413   if (!aij->garray) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"MPIAIJ Matrix was assembled but is missing garray");
414 #if defined(PETSC_USE_CTABLE)
415   ierr = PetscTableCreate(n,mat->cmap->N+1,&aij->colmap);CHKERRQ(ierr);
416   for (i=0; i<n; i++) {
417     ierr = PetscTableAdd(aij->colmap,aij->garray[i]+1,i+1,INSERT_VALUES);CHKERRQ(ierr);
418   }
419 #else
420   ierr = PetscCalloc1(mat->cmap->N+1,&aij->colmap);CHKERRQ(ierr);
421   ierr = PetscLogObjectMemory((PetscObject)mat,(mat->cmap->N+1)*sizeof(PetscInt));CHKERRQ(ierr);
422   for (i=0; i<n; i++) aij->colmap[aij->garray[i]] = i+1;
423 #endif
424   PetscFunctionReturn(0);
425 }
426 
427 #define MatSetValues_SeqAIJ_A_Private(row,col,value,addv,orow,ocol)     \
428 { \
429     if (col <= lastcol1)  low1 = 0;     \
430     else                 high1 = nrow1; \
431     lastcol1 = col;\
432     while (high1-low1 > 5) { \
433       t = (low1+high1)/2; \
434       if (rp1[t] > col) high1 = t; \
435       else              low1  = t; \
436     } \
437       for (_i=low1; _i<high1; _i++) { \
438         if (rp1[_i] > col) break; \
439         if (rp1[_i] == col) { \
440           if (addv == ADD_VALUES) ap1[_i] += value;   \
441           else                    ap1[_i] = value; \
442           goto a_noinsert; \
443         } \
444       }  \
445       if (value == 0.0 && ignorezeroentries) {low1 = 0; high1 = nrow1;goto a_noinsert;} \
446       if (nonew == 1) {low1 = 0; high1 = nrow1; goto a_noinsert;}                \
447       if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero at global row/column (%D, %D) into matrix", orow, ocol); \
448       MatSeqXAIJReallocateAIJ(A,am,1,nrow1,row,col,rmax1,aa,ai,aj,rp1,ap1,aimax,nonew,MatScalar); \
449       N = nrow1++ - 1; a->nz++; high1++; \
450       /* shift up all the later entries in this row */ \
451       for (ii=N; ii>=_i; ii--) { \
452         rp1[ii+1] = rp1[ii]; \
453         ap1[ii+1] = ap1[ii]; \
454       } \
455       rp1[_i] = col;  \
456       ap1[_i] = value;  \
457       A->nonzerostate++;\
458       a_noinsert: ; \
459       ailen[row] = nrow1; \
460 }
461 
462 
463 #define MatSetValues_SeqAIJ_B_Private(row,col,value,addv,orow,ocol) \
464   { \
465     if (col <= lastcol2) low2 = 0;                        \
466     else high2 = nrow2;                                   \
467     lastcol2 = col;                                       \
468     while (high2-low2 > 5) {                              \
469       t = (low2+high2)/2;                                 \
470       if (rp2[t] > col) high2 = t;                        \
471       else             low2  = t;                         \
472     }                                                     \
473     for (_i=low2; _i<high2; _i++) {                       \
474       if (rp2[_i] > col) break;                           \
475       if (rp2[_i] == col) {                               \
476         if (addv == ADD_VALUES) ap2[_i] += value;         \
477         else                    ap2[_i] = value;          \
478         goto b_noinsert;                                  \
479       }                                                   \
480     }                                                     \
481     if (value == 0.0 && ignorezeroentries) {low2 = 0; high2 = nrow2; goto b_noinsert;} \
482     if (nonew == 1) {low2 = 0; high2 = nrow2; goto b_noinsert;}                        \
483     if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero at global row/column (%D, %D) into matrix", orow, ocol); \
484     MatSeqXAIJReallocateAIJ(B,bm,1,nrow2,row,col,rmax2,ba,bi,bj,rp2,ap2,bimax,nonew,MatScalar); \
485     N = nrow2++ - 1; b->nz++; high2++;                    \
486     /* shift up all the later entries in this row */      \
487     for (ii=N; ii>=_i; ii--) {                            \
488       rp2[ii+1] = rp2[ii];                                \
489       ap2[ii+1] = ap2[ii];                                \
490     }                                                     \
491     rp2[_i] = col;                                        \
492     ap2[_i] = value;                                      \
493     B->nonzerostate++;                                    \
494     b_noinsert: ;                                         \
495     bilen[row] = nrow2;                                   \
496   }
497 
498 #undef __FUNCT__
499 #define __FUNCT__ "MatSetValuesRow_MPIAIJ"
500 PetscErrorCode MatSetValuesRow_MPIAIJ(Mat A,PetscInt row,const PetscScalar v[])
501 {
502   Mat_MPIAIJ     *mat = (Mat_MPIAIJ*)A->data;
503   Mat_SeqAIJ     *a   = (Mat_SeqAIJ*)mat->A->data,*b = (Mat_SeqAIJ*)mat->B->data;
504   PetscErrorCode ierr;
505   PetscInt       l,*garray = mat->garray,diag;
506 
507   PetscFunctionBegin;
508   /* code only works for square matrices A */
509 
510   /* find size of row to the left of the diagonal part */
511   ierr = MatGetOwnershipRange(A,&diag,0);CHKERRQ(ierr);
512   row  = row - diag;
513   for (l=0; l<b->i[row+1]-b->i[row]; l++) {
514     if (garray[b->j[b->i[row]+l]] > diag) break;
515   }
516   ierr = PetscMemcpy(b->a+b->i[row],v,l*sizeof(PetscScalar));CHKERRQ(ierr);
517 
518   /* diagonal part */
519   ierr = PetscMemcpy(a->a+a->i[row],v+l,(a->i[row+1]-a->i[row])*sizeof(PetscScalar));CHKERRQ(ierr);
520 
521   /* right of diagonal part */
522   ierr = PetscMemcpy(b->a+b->i[row]+l,v+l+a->i[row+1]-a->i[row],(b->i[row+1]-b->i[row]-l)*sizeof(PetscScalar));CHKERRQ(ierr);
523   PetscFunctionReturn(0);
524 }
525 
526 #undef __FUNCT__
527 #define __FUNCT__ "MatSetValues_MPIAIJ"
528 PetscErrorCode MatSetValues_MPIAIJ(Mat mat,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],const PetscScalar v[],InsertMode addv)
529 {
530   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
531   PetscScalar    value;
532   PetscErrorCode ierr;
533   PetscInt       i,j,rstart  = mat->rmap->rstart,rend = mat->rmap->rend;
534   PetscInt       cstart      = mat->cmap->rstart,cend = mat->cmap->rend,row,col;
535   PetscBool      roworiented = aij->roworiented;
536 
537   /* Some Variables required in the macro */
538   Mat        A                 = aij->A;
539   Mat_SeqAIJ *a                = (Mat_SeqAIJ*)A->data;
540   PetscInt   *aimax            = a->imax,*ai = a->i,*ailen = a->ilen,*aj = a->j;
541   MatScalar  *aa               = a->a;
542   PetscBool  ignorezeroentries = a->ignorezeroentries;
543   Mat        B                 = aij->B;
544   Mat_SeqAIJ *b                = (Mat_SeqAIJ*)B->data;
545   PetscInt   *bimax            = b->imax,*bi = b->i,*bilen = b->ilen,*bj = b->j,bm = aij->B->rmap->n,am = aij->A->rmap->n;
546   MatScalar  *ba               = b->a;
547 
548   PetscInt  *rp1,*rp2,ii,nrow1,nrow2,_i,rmax1,rmax2,N,low1,high1,low2,high2,t,lastcol1,lastcol2;
549   PetscInt  nonew;
550   MatScalar *ap1,*ap2;
551 
552   PetscFunctionBegin;
553   for (i=0; i<m; i++) {
554     if (im[i] < 0) continue;
555 #if defined(PETSC_USE_DEBUG)
556     if (im[i] >= mat->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",im[i],mat->rmap->N-1);
557 #endif
558     if (im[i] >= rstart && im[i] < rend) {
559       row      = im[i] - rstart;
560       lastcol1 = -1;
561       rp1      = aj + ai[row];
562       ap1      = aa + ai[row];
563       rmax1    = aimax[row];
564       nrow1    = ailen[row];
565       low1     = 0;
566       high1    = nrow1;
567       lastcol2 = -1;
568       rp2      = bj + bi[row];
569       ap2      = ba + bi[row];
570       rmax2    = bimax[row];
571       nrow2    = bilen[row];
572       low2     = 0;
573       high2    = nrow2;
574 
575       for (j=0; j<n; j++) {
576         if (roworiented) value = v[i*n+j];
577         else             value = v[i+j*m];
578         if (ignorezeroentries && value == 0.0 && (addv == ADD_VALUES)) continue;
579         if (in[j] >= cstart && in[j] < cend) {
580           col   = in[j] - cstart;
581           nonew = a->nonew;
582           MatSetValues_SeqAIJ_A_Private(row,col,value,addv,im[i],in[j]);
583         } else if (in[j] < 0) continue;
584 #if defined(PETSC_USE_DEBUG)
585         else if (in[j] >= mat->cmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[j],mat->cmap->N-1);
586 #endif
587         else {
588           if (mat->was_assembled) {
589             if (!aij->colmap) {
590               ierr = MatCreateColmap_MPIAIJ_Private(mat);CHKERRQ(ierr);
591             }
592 #if defined(PETSC_USE_CTABLE)
593             ierr = PetscTableFind(aij->colmap,in[j]+1,&col);CHKERRQ(ierr);
594             col--;
595 #else
596             col = aij->colmap[in[j]] - 1;
597 #endif
598             if (col < 0 && !((Mat_SeqAIJ*)(aij->B->data))->nonew) {
599               ierr = MatDisAssemble_MPIAIJ(mat);CHKERRQ(ierr);
600               col  =  in[j];
601               /* Reinitialize the variables required by MatSetValues_SeqAIJ_B_Private() */
602               B     = aij->B;
603               b     = (Mat_SeqAIJ*)B->data;
604               bimax = b->imax; bi = b->i; bilen = b->ilen; bj = b->j; ba = b->a;
605               rp2   = bj + bi[row];
606               ap2   = ba + bi[row];
607               rmax2 = bimax[row];
608               nrow2 = bilen[row];
609               low2  = 0;
610               high2 = nrow2;
611               bm    = aij->B->rmap->n;
612               ba    = b->a;
613             } else if (col < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero at global row/column (%D, %D) into matrix", im[i], in[j]);
614           } else col = in[j];
615           nonew = b->nonew;
616           MatSetValues_SeqAIJ_B_Private(row,col,value,addv,im[i],in[j]);
617         }
618       }
619     } else {
620       if (mat->nooffprocentries) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Setting off process row %D even though MatSetOption(,MAT_NO_OFF_PROC_ENTRIES,PETSC_TRUE) was set",im[i]);
621       if (!aij->donotstash) {
622         mat->assembled = PETSC_FALSE;
623         if (roworiented) {
624           ierr = MatStashValuesRow_Private(&mat->stash,im[i],n,in,v+i*n,(PetscBool)(ignorezeroentries && (addv == ADD_VALUES)));CHKERRQ(ierr);
625         } else {
626           ierr = MatStashValuesCol_Private(&mat->stash,im[i],n,in,v+i,m,(PetscBool)(ignorezeroentries && (addv == ADD_VALUES)));CHKERRQ(ierr);
627         }
628       }
629     }
630   }
631   PetscFunctionReturn(0);
632 }
633 
634 #undef __FUNCT__
635 #define __FUNCT__ "MatGetValues_MPIAIJ"
636 PetscErrorCode MatGetValues_MPIAIJ(Mat mat,PetscInt m,const PetscInt idxm[],PetscInt n,const PetscInt idxn[],PetscScalar v[])
637 {
638   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
639   PetscErrorCode ierr;
640   PetscInt       i,j,rstart = mat->rmap->rstart,rend = mat->rmap->rend;
641   PetscInt       cstart = mat->cmap->rstart,cend = mat->cmap->rend,row,col;
642 
643   PetscFunctionBegin;
644   for (i=0; i<m; i++) {
645     if (idxm[i] < 0) continue; /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row: %D",idxm[i]);*/
646     if (idxm[i] >= mat->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",idxm[i],mat->rmap->N-1);
647     if (idxm[i] >= rstart && idxm[i] < rend) {
648       row = idxm[i] - rstart;
649       for (j=0; j<n; j++) {
650         if (idxn[j] < 0) continue; /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column: %D",idxn[j]); */
651         if (idxn[j] >= mat->cmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",idxn[j],mat->cmap->N-1);
652         if (idxn[j] >= cstart && idxn[j] < cend) {
653           col  = idxn[j] - cstart;
654           ierr = MatGetValues(aij->A,1,&row,1,&col,v+i*n+j);CHKERRQ(ierr);
655         } else {
656           if (!aij->colmap) {
657             ierr = MatCreateColmap_MPIAIJ_Private(mat);CHKERRQ(ierr);
658           }
659 #if defined(PETSC_USE_CTABLE)
660           ierr = PetscTableFind(aij->colmap,idxn[j]+1,&col);CHKERRQ(ierr);
661           col--;
662 #else
663           col = aij->colmap[idxn[j]] - 1;
664 #endif
665           if ((col < 0) || (aij->garray[col] != idxn[j])) *(v+i*n+j) = 0.0;
666           else {
667             ierr = MatGetValues(aij->B,1,&row,1,&col,v+i*n+j);CHKERRQ(ierr);
668           }
669         }
670       }
671     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only local values currently supported");
672   }
673   PetscFunctionReturn(0);
674 }
675 
676 extern PetscErrorCode MatMultDiagonalBlock_MPIAIJ(Mat,Vec,Vec);
677 
678 #undef __FUNCT__
679 #define __FUNCT__ "MatAssemblyBegin_MPIAIJ"
680 PetscErrorCode MatAssemblyBegin_MPIAIJ(Mat mat,MatAssemblyType mode)
681 {
682   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
683   PetscErrorCode ierr;
684   PetscInt       nstash,reallocs;
685 
686   PetscFunctionBegin;
687   if (aij->donotstash || mat->nooffprocentries) PetscFunctionReturn(0);
688 
689   ierr = MatStashScatterBegin_Private(mat,&mat->stash,mat->rmap->range);CHKERRQ(ierr);
690   ierr = MatStashGetInfo_Private(&mat->stash,&nstash,&reallocs);CHKERRQ(ierr);
691   ierr = PetscInfo2(aij->A,"Stash has %D entries, uses %D mallocs.\n",nstash,reallocs);CHKERRQ(ierr);
692   PetscFunctionReturn(0);
693 }
694 
695 #undef __FUNCT__
696 #define __FUNCT__ "MatAssemblyEnd_MPIAIJ"
697 PetscErrorCode MatAssemblyEnd_MPIAIJ(Mat mat,MatAssemblyType mode)
698 {
699   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
700   Mat_SeqAIJ     *a   = (Mat_SeqAIJ*)aij->A->data;
701   PetscErrorCode ierr;
702   PetscMPIInt    n;
703   PetscInt       i,j,rstart,ncols,flg;
704   PetscInt       *row,*col;
705   PetscBool      other_disassembled;
706   PetscScalar    *val;
707 
708   /* do not use 'b = (Mat_SeqAIJ*)aij->B->data' as B can be reset in disassembly */
709 
710   PetscFunctionBegin;
711   if (!aij->donotstash && !mat->nooffprocentries) {
712     while (1) {
713       ierr = MatStashScatterGetMesg_Private(&mat->stash,&n,&row,&col,&val,&flg);CHKERRQ(ierr);
714       if (!flg) break;
715 
716       for (i=0; i<n; ) {
717         /* Now identify the consecutive vals belonging to the same row */
718         for (j=i,rstart=row[j]; j<n; j++) {
719           if (row[j] != rstart) break;
720         }
721         if (j < n) ncols = j-i;
722         else       ncols = n-i;
723         /* Now assemble all these values with a single function call */
724         ierr = MatSetValues_MPIAIJ(mat,1,row+i,ncols,col+i,val+i,mat->insertmode);CHKERRQ(ierr);
725 
726         i = j;
727       }
728     }
729     ierr = MatStashScatterEnd_Private(&mat->stash);CHKERRQ(ierr);
730   }
731   ierr = MatAssemblyBegin(aij->A,mode);CHKERRQ(ierr);
732   ierr = MatAssemblyEnd(aij->A,mode);CHKERRQ(ierr);
733 
734   /* determine if any processor has disassembled, if so we must
735      also disassemble ourselfs, in order that we may reassemble. */
736   /*
737      if nonzero structure of submatrix B cannot change then we know that
738      no processor disassembled thus we can skip this stuff
739   */
740   if (!((Mat_SeqAIJ*)aij->B->data)->nonew) {
741     ierr = MPIU_Allreduce(&mat->was_assembled,&other_disassembled,1,MPIU_BOOL,MPI_PROD,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
742     if (mat->was_assembled && !other_disassembled) {
743       ierr = MatDisAssemble_MPIAIJ(mat);CHKERRQ(ierr);
744     }
745   }
746   if (!mat->was_assembled && mode == MAT_FINAL_ASSEMBLY) {
747     ierr = MatSetUpMultiply_MPIAIJ(mat);CHKERRQ(ierr);
748   }
749   ierr = MatSetOption(aij->B,MAT_USE_INODES,PETSC_FALSE);CHKERRQ(ierr);
750   ierr = MatAssemblyBegin(aij->B,mode);CHKERRQ(ierr);
751   ierr = MatAssemblyEnd(aij->B,mode);CHKERRQ(ierr);
752 
753   ierr = PetscFree2(aij->rowvalues,aij->rowindices);CHKERRQ(ierr);
754 
755   aij->rowvalues = 0;
756 
757   ierr = VecDestroy(&aij->diag);CHKERRQ(ierr);
758   if (a->inode.size) mat->ops->multdiagonalblock = MatMultDiagonalBlock_MPIAIJ;
759 
760   /* if no new nonzero locations are allowed in matrix then only set the matrix state the first time through */
761   if ((!mat->was_assembled && mode == MAT_FINAL_ASSEMBLY) || !((Mat_SeqAIJ*)(aij->A->data))->nonew) {
762     PetscObjectState state = aij->A->nonzerostate + aij->B->nonzerostate;
763     ierr = MPIU_Allreduce(&state,&mat->nonzerostate,1,MPIU_INT64,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
764   }
765   PetscFunctionReturn(0);
766 }
767 
768 #undef __FUNCT__
769 #define __FUNCT__ "MatZeroEntries_MPIAIJ"
770 PetscErrorCode MatZeroEntries_MPIAIJ(Mat A)
771 {
772   Mat_MPIAIJ     *l = (Mat_MPIAIJ*)A->data;
773   PetscErrorCode ierr;
774 
775   PetscFunctionBegin;
776   ierr = MatZeroEntries(l->A);CHKERRQ(ierr);
777   ierr = MatZeroEntries(l->B);CHKERRQ(ierr);
778   PetscFunctionReturn(0);
779 }
780 
781 #undef __FUNCT__
782 #define __FUNCT__ "MatZeroRows_MPIAIJ"
783 PetscErrorCode MatZeroRows_MPIAIJ(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
784 {
785   Mat_MPIAIJ    *mat    = (Mat_MPIAIJ *) A->data;
786   PetscInt      *owners = A->rmap->range;
787   PetscInt       n      = A->rmap->n;
788   PetscSF        sf;
789   PetscInt      *lrows;
790   PetscSFNode   *rrows;
791   PetscInt       r, p = 0, len = 0;
792   PetscErrorCode ierr;
793 
794   PetscFunctionBegin;
795   /* Create SF where leaves are input rows and roots are owned rows */
796   ierr = PetscMalloc1(n, &lrows);CHKERRQ(ierr);
797   for (r = 0; r < n; ++r) lrows[r] = -1;
798   if (!A->nooffproczerorows) {ierr = PetscMalloc1(N, &rrows);CHKERRQ(ierr);}
799   for (r = 0; r < N; ++r) {
800     const PetscInt idx   = rows[r];
801     if (idx < 0 || A->rmap->N <= idx) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D out of range [0,%D)",idx,A->rmap->N);
802     if (idx < owners[p] || owners[p+1] <= idx) { /* short-circuit the search if the last p owns this row too */
803       ierr = PetscLayoutFindOwner(A->rmap,idx,&p);CHKERRQ(ierr);
804     }
805     if (A->nooffproczerorows) {
806       if (p != mat->rank) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"MAT_NO_OFF_PROC_ZERO_ROWS set, but row %D is not owned by rank %d",idx,mat->rank);
807       lrows[len++] = idx - owners[p];
808     } else {
809       rrows[r].rank = p;
810       rrows[r].index = rows[r] - owners[p];
811     }
812   }
813   if (!A->nooffproczerorows) {
814     ierr = PetscSFCreate(PetscObjectComm((PetscObject) A), &sf);CHKERRQ(ierr);
815     ierr = PetscSFSetGraph(sf, n, N, NULL, PETSC_OWN_POINTER, rrows, PETSC_OWN_POINTER);CHKERRQ(ierr);
816     /* Collect flags for rows to be zeroed */
817     ierr = PetscSFReduceBegin(sf, MPIU_INT, (PetscInt*)rows, lrows, MPI_LOR);CHKERRQ(ierr);
818     ierr = PetscSFReduceEnd(sf, MPIU_INT, (PetscInt*)rows, lrows, MPI_LOR);CHKERRQ(ierr);
819     ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
820     /* Compress and put in row numbers */
821     for (r = 0; r < n; ++r) if (lrows[r] >= 0) lrows[len++] = r;
822   }
823   /* fix right hand side if needed */
824   if (x && b) {
825     const PetscScalar *xx;
826     PetscScalar       *bb;
827 
828     ierr = VecGetArrayRead(x, &xx);CHKERRQ(ierr);
829     ierr = VecGetArray(b, &bb);CHKERRQ(ierr);
830     for (r = 0; r < len; ++r) bb[lrows[r]] = diag*xx[lrows[r]];
831     ierr = VecRestoreArrayRead(x, &xx);CHKERRQ(ierr);
832     ierr = VecRestoreArray(b, &bb);CHKERRQ(ierr);
833   }
834   /* Must zero l->B before l->A because the (diag) case below may put values into l->B*/
835   ierr = MatZeroRows(mat->B, len, lrows, 0.0, NULL, NULL);CHKERRQ(ierr);
836   if ((diag != 0.0) && (mat->A->rmap->N == mat->A->cmap->N)) {
837     ierr = MatZeroRows(mat->A, len, lrows, diag, NULL, NULL);CHKERRQ(ierr);
838   } else if (diag != 0.0) {
839     ierr = MatZeroRows(mat->A, len, lrows, 0.0, NULL, NULL);CHKERRQ(ierr);
840     if (((Mat_SeqAIJ *) mat->A->data)->nonew) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "MatZeroRows() on rectangular matrices cannot be used with the Mat options\nMAT_NEW_NONZERO_LOCATIONS,MAT_NEW_NONZERO_LOCATION_ERR,MAT_NEW_NONZERO_ALLOCATION_ERR");
841     for (r = 0; r < len; ++r) {
842       const PetscInt row = lrows[r] + A->rmap->rstart;
843       ierr = MatSetValues(A, 1, &row, 1, &row, &diag, INSERT_VALUES);CHKERRQ(ierr);
844     }
845     ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
846     ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
847   } else {
848     ierr = MatZeroRows(mat->A, len, lrows, 0.0, NULL, NULL);CHKERRQ(ierr);
849   }
850   ierr = PetscFree(lrows);CHKERRQ(ierr);
851 
852   /* only change matrix nonzero state if pattern was allowed to be changed */
853   if (!((Mat_SeqAIJ*)(mat->A->data))->keepnonzeropattern) {
854     PetscObjectState state = mat->A->nonzerostate + mat->B->nonzerostate;
855     ierr = MPIU_Allreduce(&state,&A->nonzerostate,1,MPIU_INT64,MPI_SUM,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
856   }
857   PetscFunctionReturn(0);
858 }
859 
860 #undef __FUNCT__
861 #define __FUNCT__ "MatZeroRowsColumns_MPIAIJ"
862 PetscErrorCode MatZeroRowsColumns_MPIAIJ(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
863 {
864   Mat_MPIAIJ        *l = (Mat_MPIAIJ*)A->data;
865   PetscErrorCode    ierr;
866   PetscMPIInt       n = A->rmap->n;
867   PetscInt          i,j,r,m,p = 0,len = 0;
868   PetscInt          *lrows,*owners = A->rmap->range;
869   PetscSFNode       *rrows;
870   PetscSF           sf;
871   const PetscScalar *xx;
872   PetscScalar       *bb,*mask;
873   Vec               xmask,lmask;
874   Mat_SeqAIJ        *aij = (Mat_SeqAIJ*)l->B->data;
875   const PetscInt    *aj, *ii,*ridx;
876   PetscScalar       *aa;
877 
878   PetscFunctionBegin;
879   /* Create SF where leaves are input rows and roots are owned rows */
880   ierr = PetscMalloc1(n, &lrows);CHKERRQ(ierr);
881   for (r = 0; r < n; ++r) lrows[r] = -1;
882   ierr = PetscMalloc1(N, &rrows);CHKERRQ(ierr);
883   for (r = 0; r < N; ++r) {
884     const PetscInt idx   = rows[r];
885     if (idx < 0 || A->rmap->N <= idx) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D out of range [0,%D)",idx,A->rmap->N);
886     if (idx < owners[p] || owners[p+1] <= idx) { /* short-circuit the search if the last p owns this row too */
887       ierr = PetscLayoutFindOwner(A->rmap,idx,&p);CHKERRQ(ierr);
888     }
889     rrows[r].rank  = p;
890     rrows[r].index = rows[r] - owners[p];
891   }
892   ierr = PetscSFCreate(PetscObjectComm((PetscObject) A), &sf);CHKERRQ(ierr);
893   ierr = PetscSFSetGraph(sf, n, N, NULL, PETSC_OWN_POINTER, rrows, PETSC_OWN_POINTER);CHKERRQ(ierr);
894   /* Collect flags for rows to be zeroed */
895   ierr = PetscSFReduceBegin(sf, MPIU_INT, (PetscInt *) rows, lrows, MPI_LOR);CHKERRQ(ierr);
896   ierr = PetscSFReduceEnd(sf, MPIU_INT, (PetscInt *) rows, lrows, MPI_LOR);CHKERRQ(ierr);
897   ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
898   /* Compress and put in row numbers */
899   for (r = 0; r < n; ++r) if (lrows[r] >= 0) lrows[len++] = r;
900   /* zero diagonal part of matrix */
901   ierr = MatZeroRowsColumns(l->A,len,lrows,diag,x,b);CHKERRQ(ierr);
902   /* handle off diagonal part of matrix */
903   ierr = MatCreateVecs(A,&xmask,NULL);CHKERRQ(ierr);
904   ierr = VecDuplicate(l->lvec,&lmask);CHKERRQ(ierr);
905   ierr = VecGetArray(xmask,&bb);CHKERRQ(ierr);
906   for (i=0; i<len; i++) bb[lrows[i]] = 1;
907   ierr = VecRestoreArray(xmask,&bb);CHKERRQ(ierr);
908   ierr = VecScatterBegin(l->Mvctx,xmask,lmask,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
909   ierr = VecScatterEnd(l->Mvctx,xmask,lmask,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
910   ierr = VecDestroy(&xmask);CHKERRQ(ierr);
911   if (x) {
912     ierr = VecScatterBegin(l->Mvctx,x,l->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
913     ierr = VecScatterEnd(l->Mvctx,x,l->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
914     ierr = VecGetArrayRead(l->lvec,&xx);CHKERRQ(ierr);
915     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
916   }
917   ierr = VecGetArray(lmask,&mask);CHKERRQ(ierr);
918   /* remove zeroed rows of off diagonal matrix */
919   ii = aij->i;
920   for (i=0; i<len; i++) {
921     ierr = PetscMemzero(aij->a + ii[lrows[i]],(ii[lrows[i]+1] - ii[lrows[i]])*sizeof(PetscScalar));CHKERRQ(ierr);
922   }
923   /* loop over all elements of off process part of matrix zeroing removed columns*/
924   if (aij->compressedrow.use) {
925     m    = aij->compressedrow.nrows;
926     ii   = aij->compressedrow.i;
927     ridx = aij->compressedrow.rindex;
928     for (i=0; i<m; i++) {
929       n  = ii[i+1] - ii[i];
930       aj = aij->j + ii[i];
931       aa = aij->a + ii[i];
932 
933       for (j=0; j<n; j++) {
934         if (PetscAbsScalar(mask[*aj])) {
935           if (b) bb[*ridx] -= *aa*xx[*aj];
936           *aa = 0.0;
937         }
938         aa++;
939         aj++;
940       }
941       ridx++;
942     }
943   } else { /* do not use compressed row format */
944     m = l->B->rmap->n;
945     for (i=0; i<m; i++) {
946       n  = ii[i+1] - ii[i];
947       aj = aij->j + ii[i];
948       aa = aij->a + ii[i];
949       for (j=0; j<n; j++) {
950         if (PetscAbsScalar(mask[*aj])) {
951           if (b) bb[i] -= *aa*xx[*aj];
952           *aa = 0.0;
953         }
954         aa++;
955         aj++;
956       }
957     }
958   }
959   if (x) {
960     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
961     ierr = VecRestoreArrayRead(l->lvec,&xx);CHKERRQ(ierr);
962   }
963   ierr = VecRestoreArray(lmask,&mask);CHKERRQ(ierr);
964   ierr = VecDestroy(&lmask);CHKERRQ(ierr);
965   ierr = PetscFree(lrows);CHKERRQ(ierr);
966 
967   /* only change matrix nonzero state if pattern was allowed to be changed */
968   if (!((Mat_SeqAIJ*)(l->A->data))->keepnonzeropattern) {
969     PetscObjectState state = l->A->nonzerostate + l->B->nonzerostate;
970     ierr = MPIU_Allreduce(&state,&A->nonzerostate,1,MPIU_INT64,MPI_SUM,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
971   }
972   PetscFunctionReturn(0);
973 }
974 
975 #undef __FUNCT__
976 #define __FUNCT__ "MatMult_MPIAIJ"
977 PetscErrorCode MatMult_MPIAIJ(Mat A,Vec xx,Vec yy)
978 {
979   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
980   PetscErrorCode ierr;
981   PetscInt       nt;
982 
983   PetscFunctionBegin;
984   ierr = VecGetLocalSize(xx,&nt);CHKERRQ(ierr);
985   if (nt != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Incompatible partition of A (%D) and xx (%D)",A->cmap->n,nt);
986   ierr = VecScatterBegin(a->Mvctx,xx,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
987   ierr = (*a->A->ops->mult)(a->A,xx,yy);CHKERRQ(ierr);
988   ierr = VecScatterEnd(a->Mvctx,xx,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
989   ierr = (*a->B->ops->multadd)(a->B,a->lvec,yy,yy);CHKERRQ(ierr);
990   PetscFunctionReturn(0);
991 }
992 
993 #undef __FUNCT__
994 #define __FUNCT__ "MatMultDiagonalBlock_MPIAIJ"
995 PetscErrorCode MatMultDiagonalBlock_MPIAIJ(Mat A,Vec bb,Vec xx)
996 {
997   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
998   PetscErrorCode ierr;
999 
1000   PetscFunctionBegin;
1001   ierr = MatMultDiagonalBlock(a->A,bb,xx);CHKERRQ(ierr);
1002   PetscFunctionReturn(0);
1003 }
1004 
1005 #undef __FUNCT__
1006 #define __FUNCT__ "MatMultAdd_MPIAIJ"
1007 PetscErrorCode MatMultAdd_MPIAIJ(Mat A,Vec xx,Vec yy,Vec zz)
1008 {
1009   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1010   PetscErrorCode ierr;
1011 
1012   PetscFunctionBegin;
1013   ierr = VecScatterBegin(a->Mvctx,xx,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1014   ierr = (*a->A->ops->multadd)(a->A,xx,yy,zz);CHKERRQ(ierr);
1015   ierr = VecScatterEnd(a->Mvctx,xx,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1016   ierr = (*a->B->ops->multadd)(a->B,a->lvec,zz,zz);CHKERRQ(ierr);
1017   PetscFunctionReturn(0);
1018 }
1019 
1020 #undef __FUNCT__
1021 #define __FUNCT__ "MatMultTranspose_MPIAIJ"
1022 PetscErrorCode MatMultTranspose_MPIAIJ(Mat A,Vec xx,Vec yy)
1023 {
1024   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1025   PetscErrorCode ierr;
1026   PetscBool      merged;
1027 
1028   PetscFunctionBegin;
1029   ierr = VecScatterGetMerged(a->Mvctx,&merged);CHKERRQ(ierr);
1030   /* do nondiagonal part */
1031   ierr = (*a->B->ops->multtranspose)(a->B,xx,a->lvec);CHKERRQ(ierr);
1032   if (!merged) {
1033     /* send it on its way */
1034     ierr = VecScatterBegin(a->Mvctx,a->lvec,yy,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1035     /* do local part */
1036     ierr = (*a->A->ops->multtranspose)(a->A,xx,yy);CHKERRQ(ierr);
1037     /* receive remote parts: note this assumes the values are not actually */
1038     /* added in yy until the next line, */
1039     ierr = VecScatterEnd(a->Mvctx,a->lvec,yy,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1040   } else {
1041     /* do local part */
1042     ierr = (*a->A->ops->multtranspose)(a->A,xx,yy);CHKERRQ(ierr);
1043     /* send it on its way */
1044     ierr = VecScatterBegin(a->Mvctx,a->lvec,yy,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1045     /* values actually were received in the Begin() but we need to call this nop */
1046     ierr = VecScatterEnd(a->Mvctx,a->lvec,yy,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1047   }
1048   PetscFunctionReturn(0);
1049 }
1050 
1051 #undef __FUNCT__
1052 #define __FUNCT__ "MatIsTranspose_MPIAIJ"
1053 PetscErrorCode  MatIsTranspose_MPIAIJ(Mat Amat,Mat Bmat,PetscReal tol,PetscBool  *f)
1054 {
1055   MPI_Comm       comm;
1056   Mat_MPIAIJ     *Aij = (Mat_MPIAIJ*) Amat->data, *Bij;
1057   Mat            Adia = Aij->A, Bdia, Aoff,Boff,*Aoffs,*Boffs;
1058   IS             Me,Notme;
1059   PetscErrorCode ierr;
1060   PetscInt       M,N,first,last,*notme,i;
1061   PetscMPIInt    size;
1062 
1063   PetscFunctionBegin;
1064   /* Easy test: symmetric diagonal block */
1065   Bij  = (Mat_MPIAIJ*) Bmat->data; Bdia = Bij->A;
1066   ierr = MatIsTranspose(Adia,Bdia,tol,f);CHKERRQ(ierr);
1067   if (!*f) PetscFunctionReturn(0);
1068   ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
1069   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
1070   if (size == 1) PetscFunctionReturn(0);
1071 
1072   /* Hard test: off-diagonal block. This takes a MatGetSubMatrix. */
1073   ierr = MatGetSize(Amat,&M,&N);CHKERRQ(ierr);
1074   ierr = MatGetOwnershipRange(Amat,&first,&last);CHKERRQ(ierr);
1075   ierr = PetscMalloc1(N-last+first,&notme);CHKERRQ(ierr);
1076   for (i=0; i<first; i++) notme[i] = i;
1077   for (i=last; i<M; i++) notme[i-last+first] = i;
1078   ierr = ISCreateGeneral(MPI_COMM_SELF,N-last+first,notme,PETSC_COPY_VALUES,&Notme);CHKERRQ(ierr);
1079   ierr = ISCreateStride(MPI_COMM_SELF,last-first,first,1,&Me);CHKERRQ(ierr);
1080   ierr = MatGetSubMatrices(Amat,1,&Me,&Notme,MAT_INITIAL_MATRIX,&Aoffs);CHKERRQ(ierr);
1081   Aoff = Aoffs[0];
1082   ierr = MatGetSubMatrices(Bmat,1,&Notme,&Me,MAT_INITIAL_MATRIX,&Boffs);CHKERRQ(ierr);
1083   Boff = Boffs[0];
1084   ierr = MatIsTranspose(Aoff,Boff,tol,f);CHKERRQ(ierr);
1085   ierr = MatDestroyMatrices(1,&Aoffs);CHKERRQ(ierr);
1086   ierr = MatDestroyMatrices(1,&Boffs);CHKERRQ(ierr);
1087   ierr = ISDestroy(&Me);CHKERRQ(ierr);
1088   ierr = ISDestroy(&Notme);CHKERRQ(ierr);
1089   ierr = PetscFree(notme);CHKERRQ(ierr);
1090   PetscFunctionReturn(0);
1091 }
1092 
1093 #undef __FUNCT__
1094 #define __FUNCT__ "MatMultTransposeAdd_MPIAIJ"
1095 PetscErrorCode MatMultTransposeAdd_MPIAIJ(Mat A,Vec xx,Vec yy,Vec zz)
1096 {
1097   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1098   PetscErrorCode ierr;
1099 
1100   PetscFunctionBegin;
1101   /* do nondiagonal part */
1102   ierr = (*a->B->ops->multtranspose)(a->B,xx,a->lvec);CHKERRQ(ierr);
1103   /* send it on its way */
1104   ierr = VecScatterBegin(a->Mvctx,a->lvec,zz,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1105   /* do local part */
1106   ierr = (*a->A->ops->multtransposeadd)(a->A,xx,yy,zz);CHKERRQ(ierr);
1107   /* receive remote parts */
1108   ierr = VecScatterEnd(a->Mvctx,a->lvec,zz,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1109   PetscFunctionReturn(0);
1110 }
1111 
1112 /*
1113   This only works correctly for square matrices where the subblock A->A is the
1114    diagonal block
1115 */
1116 #undef __FUNCT__
1117 #define __FUNCT__ "MatGetDiagonal_MPIAIJ"
1118 PetscErrorCode MatGetDiagonal_MPIAIJ(Mat A,Vec v)
1119 {
1120   PetscErrorCode ierr;
1121   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1122 
1123   PetscFunctionBegin;
1124   if (A->rmap->N != A->cmap->N) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Supports only square matrix where A->A is diag block");
1125   if (A->rmap->rstart != A->cmap->rstart || A->rmap->rend != A->cmap->rend) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"row partition must equal col partition");
1126   ierr = MatGetDiagonal(a->A,v);CHKERRQ(ierr);
1127   PetscFunctionReturn(0);
1128 }
1129 
1130 #undef __FUNCT__
1131 #define __FUNCT__ "MatScale_MPIAIJ"
1132 PetscErrorCode MatScale_MPIAIJ(Mat A,PetscScalar aa)
1133 {
1134   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1135   PetscErrorCode ierr;
1136 
1137   PetscFunctionBegin;
1138   ierr = MatScale(a->A,aa);CHKERRQ(ierr);
1139   ierr = MatScale(a->B,aa);CHKERRQ(ierr);
1140   PetscFunctionReturn(0);
1141 }
1142 
1143 #undef __FUNCT__
1144 #define __FUNCT__ "MatDestroy_MPIAIJ"
1145 PetscErrorCode MatDestroy_MPIAIJ(Mat mat)
1146 {
1147   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
1148   PetscErrorCode ierr;
1149 
1150   PetscFunctionBegin;
1151 #if defined(PETSC_USE_LOG)
1152   PetscLogObjectState((PetscObject)mat,"Rows=%D, Cols=%D",mat->rmap->N,mat->cmap->N);
1153 #endif
1154   ierr = MatStashDestroy_Private(&mat->stash);CHKERRQ(ierr);
1155   ierr = VecDestroy(&aij->diag);CHKERRQ(ierr);
1156   ierr = MatDestroy(&aij->A);CHKERRQ(ierr);
1157   ierr = MatDestroy(&aij->B);CHKERRQ(ierr);
1158 #if defined(PETSC_USE_CTABLE)
1159   ierr = PetscTableDestroy(&aij->colmap);CHKERRQ(ierr);
1160 #else
1161   ierr = PetscFree(aij->colmap);CHKERRQ(ierr);
1162 #endif
1163   ierr = PetscFree(aij->garray);CHKERRQ(ierr);
1164   ierr = VecDestroy(&aij->lvec);CHKERRQ(ierr);
1165   ierr = VecScatterDestroy(&aij->Mvctx);CHKERRQ(ierr);
1166   ierr = PetscFree2(aij->rowvalues,aij->rowindices);CHKERRQ(ierr);
1167   ierr = PetscFree(aij->ld);CHKERRQ(ierr);
1168   ierr = PetscFree(mat->data);CHKERRQ(ierr);
1169 
1170   ierr = PetscObjectChangeTypeName((PetscObject)mat,0);CHKERRQ(ierr);
1171   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatStoreValues_C",NULL);CHKERRQ(ierr);
1172   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatRetrieveValues_C",NULL);CHKERRQ(ierr);
1173   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatGetDiagonalBlock_C",NULL);CHKERRQ(ierr);
1174   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatIsTranspose_C",NULL);CHKERRQ(ierr);
1175   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatMPIAIJSetPreallocation_C",NULL);CHKERRQ(ierr);
1176   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatMPIAIJSetPreallocationCSR_C",NULL);CHKERRQ(ierr);
1177   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatDiagonalScaleLocal_C",NULL);CHKERRQ(ierr);
1178   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatConvert_mpiaij_mpisbaij_C",NULL);CHKERRQ(ierr);
1179 #if defined(PETSC_HAVE_ELEMENTAL)
1180   ierr = PetscObjectComposeFunction((PetscObject)mat,"MatConvert_mpiaij_elemental_C",NULL);CHKERRQ(ierr);
1181 #endif
1182   PetscFunctionReturn(0);
1183 }
1184 
1185 #undef __FUNCT__
1186 #define __FUNCT__ "MatView_MPIAIJ_Binary"
1187 PetscErrorCode MatView_MPIAIJ_Binary(Mat mat,PetscViewer viewer)
1188 {
1189   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
1190   Mat_SeqAIJ     *A   = (Mat_SeqAIJ*)aij->A->data;
1191   Mat_SeqAIJ     *B   = (Mat_SeqAIJ*)aij->B->data;
1192   PetscErrorCode ierr;
1193   PetscMPIInt    rank,size,tag = ((PetscObject)viewer)->tag;
1194   int            fd;
1195   PetscInt       nz,header[4],*row_lengths,*range=0,rlen,i;
1196   PetscInt       nzmax,*column_indices,j,k,col,*garray = aij->garray,cnt,cstart = mat->cmap->rstart,rnz = 0;
1197   PetscScalar    *column_values;
1198   PetscInt       message_count,flowcontrolcount;
1199   FILE           *file;
1200 
1201   PetscFunctionBegin;
1202   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
1203   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
1204   nz   = A->nz + B->nz;
1205   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
1206   if (!rank) {
1207     header[0] = MAT_FILE_CLASSID;
1208     header[1] = mat->rmap->N;
1209     header[2] = mat->cmap->N;
1210 
1211     ierr = MPI_Reduce(&nz,&header[3],1,MPIU_INT,MPI_SUM,0,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1212     ierr = PetscBinaryWrite(fd,header,4,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1213     /* get largest number of rows any processor has */
1214     rlen  = mat->rmap->n;
1215     range = mat->rmap->range;
1216     for (i=1; i<size; i++) rlen = PetscMax(rlen,range[i+1] - range[i]);
1217   } else {
1218     ierr = MPI_Reduce(&nz,0,1,MPIU_INT,MPI_SUM,0,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1219     rlen = mat->rmap->n;
1220   }
1221 
1222   /* load up the local row counts */
1223   ierr = PetscMalloc1(rlen+1,&row_lengths);CHKERRQ(ierr);
1224   for (i=0; i<mat->rmap->n; i++) row_lengths[i] = A->i[i+1] - A->i[i] + B->i[i+1] - B->i[i];
1225 
1226   /* store the row lengths to the file */
1227   ierr = PetscViewerFlowControlStart(viewer,&message_count,&flowcontrolcount);CHKERRQ(ierr);
1228   if (!rank) {
1229     ierr = PetscBinaryWrite(fd,row_lengths,mat->rmap->n,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1230     for (i=1; i<size; i++) {
1231       ierr = PetscViewerFlowControlStepMaster(viewer,i,&message_count,flowcontrolcount);CHKERRQ(ierr);
1232       rlen = range[i+1] - range[i];
1233       ierr = MPIULong_Recv(row_lengths,rlen,MPIU_INT,i,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1234       ierr = PetscBinaryWrite(fd,row_lengths,rlen,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1235     }
1236     ierr = PetscViewerFlowControlEndMaster(viewer,&message_count);CHKERRQ(ierr);
1237   } else {
1238     ierr = PetscViewerFlowControlStepWorker(viewer,rank,&message_count);CHKERRQ(ierr);
1239     ierr = MPIULong_Send(row_lengths,mat->rmap->n,MPIU_INT,0,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1240     ierr = PetscViewerFlowControlEndWorker(viewer,&message_count);CHKERRQ(ierr);
1241   }
1242   ierr = PetscFree(row_lengths);CHKERRQ(ierr);
1243 
1244   /* load up the local column indices */
1245   nzmax = nz; /* th processor needs space a largest processor needs */
1246   ierr  = MPI_Reduce(&nz,&nzmax,1,MPIU_INT,MPI_MAX,0,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1247   ierr  = PetscMalloc1(nzmax+1,&column_indices);CHKERRQ(ierr);
1248   cnt   = 0;
1249   for (i=0; i<mat->rmap->n; i++) {
1250     for (j=B->i[i]; j<B->i[i+1]; j++) {
1251       if ((col = garray[B->j[j]]) > cstart) break;
1252       column_indices[cnt++] = col;
1253     }
1254     for (k=A->i[i]; k<A->i[i+1]; k++) column_indices[cnt++] = A->j[k] + cstart;
1255     for (; j<B->i[i+1]; j++) column_indices[cnt++] = garray[B->j[j]];
1256   }
1257   if (cnt != A->nz + B->nz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Internal PETSc error: cnt = %D nz = %D",cnt,A->nz+B->nz);
1258 
1259   /* store the column indices to the file */
1260   ierr = PetscViewerFlowControlStart(viewer,&message_count,&flowcontrolcount);CHKERRQ(ierr);
1261   if (!rank) {
1262     MPI_Status status;
1263     ierr = PetscBinaryWrite(fd,column_indices,nz,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1264     for (i=1; i<size; i++) {
1265       ierr = PetscViewerFlowControlStepMaster(viewer,i,&message_count,flowcontrolcount);CHKERRQ(ierr);
1266       ierr = MPI_Recv(&rnz,1,MPIU_INT,i,tag,PetscObjectComm((PetscObject)mat),&status);CHKERRQ(ierr);
1267       if (rnz > nzmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Internal PETSc error: nz = %D nzmax = %D",nz,nzmax);
1268       ierr = MPIULong_Recv(column_indices,rnz,MPIU_INT,i,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1269       ierr = PetscBinaryWrite(fd,column_indices,rnz,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1270     }
1271     ierr = PetscViewerFlowControlEndMaster(viewer,&message_count);CHKERRQ(ierr);
1272   } else {
1273     ierr = PetscViewerFlowControlStepWorker(viewer,rank,&message_count);CHKERRQ(ierr);
1274     ierr = MPI_Send(&nz,1,MPIU_INT,0,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1275     ierr = MPIULong_Send(column_indices,nz,MPIU_INT,0,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1276     ierr = PetscViewerFlowControlEndWorker(viewer,&message_count);CHKERRQ(ierr);
1277   }
1278   ierr = PetscFree(column_indices);CHKERRQ(ierr);
1279 
1280   /* load up the local column values */
1281   ierr = PetscMalloc1(nzmax+1,&column_values);CHKERRQ(ierr);
1282   cnt  = 0;
1283   for (i=0; i<mat->rmap->n; i++) {
1284     for (j=B->i[i]; j<B->i[i+1]; j++) {
1285       if (garray[B->j[j]] > cstart) break;
1286       column_values[cnt++] = B->a[j];
1287     }
1288     for (k=A->i[i]; k<A->i[i+1]; k++) column_values[cnt++] = A->a[k];
1289     for (; j<B->i[i+1]; j++) column_values[cnt++] = B->a[j];
1290   }
1291   if (cnt != A->nz + B->nz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Internal PETSc error: cnt = %D nz = %D",cnt,A->nz+B->nz);
1292 
1293   /* store the column values to the file */
1294   ierr = PetscViewerFlowControlStart(viewer,&message_count,&flowcontrolcount);CHKERRQ(ierr);
1295   if (!rank) {
1296     MPI_Status status;
1297     ierr = PetscBinaryWrite(fd,column_values,nz,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr);
1298     for (i=1; i<size; i++) {
1299       ierr = PetscViewerFlowControlStepMaster(viewer,i,&message_count,flowcontrolcount);CHKERRQ(ierr);
1300       ierr = MPI_Recv(&rnz,1,MPIU_INT,i,tag,PetscObjectComm((PetscObject)mat),&status);CHKERRQ(ierr);
1301       if (rnz > nzmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Internal PETSc error: nz = %D nzmax = %D",nz,nzmax);
1302       ierr = MPIULong_Recv(column_values,rnz,MPIU_SCALAR,i,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1303       ierr = PetscBinaryWrite(fd,column_values,rnz,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr);
1304     }
1305     ierr = PetscViewerFlowControlEndMaster(viewer,&message_count);CHKERRQ(ierr);
1306   } else {
1307     ierr = PetscViewerFlowControlStepWorker(viewer,rank,&message_count);CHKERRQ(ierr);
1308     ierr = MPI_Send(&nz,1,MPIU_INT,0,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1309     ierr = MPIULong_Send(column_values,nz,MPIU_SCALAR,0,tag,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1310     ierr = PetscViewerFlowControlEndWorker(viewer,&message_count);CHKERRQ(ierr);
1311   }
1312   ierr = PetscFree(column_values);CHKERRQ(ierr);
1313 
1314   ierr = PetscViewerBinaryGetInfoPointer(viewer,&file);CHKERRQ(ierr);
1315   if (file) fprintf(file,"-matload_block_size %d\n",(int)PetscAbs(mat->rmap->bs));
1316   PetscFunctionReturn(0);
1317 }
1318 
1319 #include <petscdraw.h>
1320 #undef __FUNCT__
1321 #define __FUNCT__ "MatView_MPIAIJ_ASCIIorDraworSocket"
1322 PetscErrorCode MatView_MPIAIJ_ASCIIorDraworSocket(Mat mat,PetscViewer viewer)
1323 {
1324   Mat_MPIAIJ        *aij = (Mat_MPIAIJ*)mat->data;
1325   PetscErrorCode    ierr;
1326   PetscMPIInt       rank = aij->rank,size = aij->size;
1327   PetscBool         isdraw,iascii,isbinary;
1328   PetscViewer       sviewer;
1329   PetscViewerFormat format;
1330 
1331   PetscFunctionBegin;
1332   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
1333   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1334   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1335   if (iascii) {
1336     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
1337     if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1338       MatInfo   info;
1339       PetscBool inodes;
1340 
1341       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
1342       ierr = MatGetInfo(mat,MAT_LOCAL,&info);CHKERRQ(ierr);
1343       ierr = MatInodeGetInodeSizes(aij->A,NULL,(PetscInt**)&inodes,NULL);CHKERRQ(ierr);
1344       ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
1345       if (!inodes) {
1346         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] Local rows %D nz %D nz alloced %D mem %D, not using I-node routines\n",
1347                                                   rank,mat->rmap->n,(PetscInt)info.nz_used,(PetscInt)info.nz_allocated,(PetscInt)info.memory);CHKERRQ(ierr);
1348       } else {
1349         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] Local rows %D nz %D nz alloced %D mem %D, using I-node routines\n",
1350                                                   rank,mat->rmap->n,(PetscInt)info.nz_used,(PetscInt)info.nz_allocated,(PetscInt)info.memory);CHKERRQ(ierr);
1351       }
1352       ierr = MatGetInfo(aij->A,MAT_LOCAL,&info);CHKERRQ(ierr);
1353       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] on-diagonal part: nz %D \n",rank,(PetscInt)info.nz_used);CHKERRQ(ierr);
1354       ierr = MatGetInfo(aij->B,MAT_LOCAL,&info);CHKERRQ(ierr);
1355       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] off-diagonal part: nz %D \n",rank,(PetscInt)info.nz_used);CHKERRQ(ierr);
1356       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1357       ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
1358       ierr = PetscViewerASCIIPrintf(viewer,"Information on VecScatter used in matrix-vector product: \n");CHKERRQ(ierr);
1359       ierr = VecScatterView(aij->Mvctx,viewer);CHKERRQ(ierr);
1360       PetscFunctionReturn(0);
1361     } else if (format == PETSC_VIEWER_ASCII_INFO) {
1362       PetscInt inodecount,inodelimit,*inodes;
1363       ierr = MatInodeGetInodeSizes(aij->A,&inodecount,&inodes,&inodelimit);CHKERRQ(ierr);
1364       if (inodes) {
1365         ierr = PetscViewerASCIIPrintf(viewer,"using I-node (on process 0) routines: found %D nodes, limit used is %D\n",inodecount,inodelimit);CHKERRQ(ierr);
1366       } else {
1367         ierr = PetscViewerASCIIPrintf(viewer,"not using I-node (on process 0) routines\n");CHKERRQ(ierr);
1368       }
1369       PetscFunctionReturn(0);
1370     } else if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) {
1371       PetscFunctionReturn(0);
1372     }
1373   } else if (isbinary) {
1374     if (size == 1) {
1375       ierr = PetscObjectSetName((PetscObject)aij->A,((PetscObject)mat)->name);CHKERRQ(ierr);
1376       ierr = MatView(aij->A,viewer);CHKERRQ(ierr);
1377     } else {
1378       ierr = MatView_MPIAIJ_Binary(mat,viewer);CHKERRQ(ierr);
1379     }
1380     PetscFunctionReturn(0);
1381   } else if (isdraw) {
1382     PetscDraw draw;
1383     PetscBool isnull;
1384     ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
1385     ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0);
1386   }
1387 
1388   {
1389     /* assemble the entire matrix onto first processor. */
1390     Mat        A;
1391     Mat_SeqAIJ *Aloc;
1392     PetscInt   M = mat->rmap->N,N = mat->cmap->N,m,*ai,*aj,row,*cols,i,*ct;
1393     MatScalar  *a;
1394 
1395     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&A);CHKERRQ(ierr);
1396     if (!rank) {
1397       ierr = MatSetSizes(A,M,N,M,N);CHKERRQ(ierr);
1398     } else {
1399       ierr = MatSetSizes(A,0,0,M,N);CHKERRQ(ierr);
1400     }
1401     /* This is just a temporary matrix, so explicitly using MATMPIAIJ is probably best */
1402     ierr = MatSetType(A,MATMPIAIJ);CHKERRQ(ierr);
1403     ierr = MatMPIAIJSetPreallocation(A,0,NULL,0,NULL);CHKERRQ(ierr);
1404     ierr = MatSetOption(A,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1405     ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)A);CHKERRQ(ierr);
1406 
1407     /* copy over the A part */
1408     Aloc = (Mat_SeqAIJ*)aij->A->data;
1409     m    = aij->A->rmap->n; ai = Aloc->i; aj = Aloc->j; a = Aloc->a;
1410     row  = mat->rmap->rstart;
1411     for (i=0; i<ai[m]; i++) aj[i] += mat->cmap->rstart;
1412     for (i=0; i<m; i++) {
1413       ierr = MatSetValues(A,1,&row,ai[i+1]-ai[i],aj,a,INSERT_VALUES);CHKERRQ(ierr);
1414       row++;
1415       a += ai[i+1]-ai[i]; aj += ai[i+1]-ai[i];
1416     }
1417     aj = Aloc->j;
1418     for (i=0; i<ai[m]; i++) aj[i] -= mat->cmap->rstart;
1419 
1420     /* copy over the B part */
1421     Aloc = (Mat_SeqAIJ*)aij->B->data;
1422     m    = aij->B->rmap->n;  ai = Aloc->i; aj = Aloc->j; a = Aloc->a;
1423     row  = mat->rmap->rstart;
1424     ierr = PetscMalloc1(ai[m]+1,&cols);CHKERRQ(ierr);
1425     ct   = cols;
1426     for (i=0; i<ai[m]; i++) cols[i] = aij->garray[aj[i]];
1427     for (i=0; i<m; i++) {
1428       ierr = MatSetValues(A,1,&row,ai[i+1]-ai[i],cols,a,INSERT_VALUES);CHKERRQ(ierr);
1429       row++;
1430       a += ai[i+1]-ai[i]; cols += ai[i+1]-ai[i];
1431     }
1432     ierr = PetscFree(ct);CHKERRQ(ierr);
1433     ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1434     ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1435     /*
1436        Everyone has to call to draw the matrix since the graphics waits are
1437        synchronized across all processors that share the PetscDraw object
1438     */
1439     ierr = PetscViewerGetSubViewer(viewer,PETSC_COMM_SELF,&sviewer);CHKERRQ(ierr);
1440     if (!rank) {
1441       ierr = PetscObjectSetName((PetscObject)((Mat_MPIAIJ*)(A->data))->A,((PetscObject)mat)->name);CHKERRQ(ierr);
1442       ierr = MatView_SeqAIJ(((Mat_MPIAIJ*)(A->data))->A,sviewer);CHKERRQ(ierr);
1443     }
1444     ierr = PetscViewerRestoreSubViewer(viewer,PETSC_COMM_SELF,&sviewer);CHKERRQ(ierr);
1445     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1446     ierr = MatDestroy(&A);CHKERRQ(ierr);
1447   }
1448   PetscFunctionReturn(0);
1449 }
1450 
1451 #undef __FUNCT__
1452 #define __FUNCT__ "MatView_MPIAIJ"
1453 PetscErrorCode MatView_MPIAIJ(Mat mat,PetscViewer viewer)
1454 {
1455   PetscErrorCode ierr;
1456   PetscBool      iascii,isdraw,issocket,isbinary;
1457 
1458   PetscFunctionBegin;
1459   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1460   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
1461   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1462   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERSOCKET,&issocket);CHKERRQ(ierr);
1463   if (iascii || isdraw || isbinary || issocket) {
1464     ierr = MatView_MPIAIJ_ASCIIorDraworSocket(mat,viewer);CHKERRQ(ierr);
1465   }
1466   PetscFunctionReturn(0);
1467 }
1468 
1469 #undef __FUNCT__
1470 #define __FUNCT__ "MatSOR_MPIAIJ"
1471 PetscErrorCode MatSOR_MPIAIJ(Mat matin,Vec bb,PetscReal omega,MatSORType flag,PetscReal fshift,PetscInt its,PetscInt lits,Vec xx)
1472 {
1473   Mat_MPIAIJ     *mat = (Mat_MPIAIJ*)matin->data;
1474   PetscErrorCode ierr;
1475   Vec            bb1 = 0;
1476   PetscBool      hasop;
1477 
1478   PetscFunctionBegin;
1479   if (flag == SOR_APPLY_UPPER) {
1480     ierr = (*mat->A->ops->sor)(mat->A,bb,omega,flag,fshift,lits,1,xx);CHKERRQ(ierr);
1481     PetscFunctionReturn(0);
1482   }
1483 
1484   if (its > 1 || ~flag & SOR_ZERO_INITIAL_GUESS || flag & SOR_EISENSTAT) {
1485     ierr = VecDuplicate(bb,&bb1);CHKERRQ(ierr);
1486   }
1487 
1488   if ((flag & SOR_LOCAL_SYMMETRIC_SWEEP) == SOR_LOCAL_SYMMETRIC_SWEEP) {
1489     if (flag & SOR_ZERO_INITIAL_GUESS) {
1490       ierr = (*mat->A->ops->sor)(mat->A,bb,omega,flag,fshift,lits,1,xx);CHKERRQ(ierr);
1491       its--;
1492     }
1493 
1494     while (its--) {
1495       ierr = VecScatterBegin(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1496       ierr = VecScatterEnd(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1497 
1498       /* update rhs: bb1 = bb - B*x */
1499       ierr = VecScale(mat->lvec,-1.0);CHKERRQ(ierr);
1500       ierr = (*mat->B->ops->multadd)(mat->B,mat->lvec,bb,bb1);CHKERRQ(ierr);
1501 
1502       /* local sweep */
1503       ierr = (*mat->A->ops->sor)(mat->A,bb1,omega,SOR_SYMMETRIC_SWEEP,fshift,lits,1,xx);CHKERRQ(ierr);
1504     }
1505   } else if (flag & SOR_LOCAL_FORWARD_SWEEP) {
1506     if (flag & SOR_ZERO_INITIAL_GUESS) {
1507       ierr = (*mat->A->ops->sor)(mat->A,bb,omega,flag,fshift,lits,1,xx);CHKERRQ(ierr);
1508       its--;
1509     }
1510     while (its--) {
1511       ierr = VecScatterBegin(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1512       ierr = VecScatterEnd(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1513 
1514       /* update rhs: bb1 = bb - B*x */
1515       ierr = VecScale(mat->lvec,-1.0);CHKERRQ(ierr);
1516       ierr = (*mat->B->ops->multadd)(mat->B,mat->lvec,bb,bb1);CHKERRQ(ierr);
1517 
1518       /* local sweep */
1519       ierr = (*mat->A->ops->sor)(mat->A,bb1,omega,SOR_FORWARD_SWEEP,fshift,lits,1,xx);CHKERRQ(ierr);
1520     }
1521   } else if (flag & SOR_LOCAL_BACKWARD_SWEEP) {
1522     if (flag & SOR_ZERO_INITIAL_GUESS) {
1523       ierr = (*mat->A->ops->sor)(mat->A,bb,omega,flag,fshift,lits,1,xx);CHKERRQ(ierr);
1524       its--;
1525     }
1526     while (its--) {
1527       ierr = VecScatterBegin(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1528       ierr = VecScatterEnd(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1529 
1530       /* update rhs: bb1 = bb - B*x */
1531       ierr = VecScale(mat->lvec,-1.0);CHKERRQ(ierr);
1532       ierr = (*mat->B->ops->multadd)(mat->B,mat->lvec,bb,bb1);CHKERRQ(ierr);
1533 
1534       /* local sweep */
1535       ierr = (*mat->A->ops->sor)(mat->A,bb1,omega,SOR_BACKWARD_SWEEP,fshift,lits,1,xx);CHKERRQ(ierr);
1536     }
1537   } else if (flag & SOR_EISENSTAT) {
1538     Vec xx1;
1539 
1540     ierr = VecDuplicate(bb,&xx1);CHKERRQ(ierr);
1541     ierr = (*mat->A->ops->sor)(mat->A,bb,omega,(MatSORType)(SOR_ZERO_INITIAL_GUESS | SOR_LOCAL_BACKWARD_SWEEP),fshift,lits,1,xx);CHKERRQ(ierr);
1542 
1543     ierr = VecScatterBegin(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1544     ierr = VecScatterEnd(mat->Mvctx,xx,mat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1545     if (!mat->diag) {
1546       ierr = MatCreateVecs(matin,&mat->diag,NULL);CHKERRQ(ierr);
1547       ierr = MatGetDiagonal(matin,mat->diag);CHKERRQ(ierr);
1548     }
1549     ierr = MatHasOperation(matin,MATOP_MULT_DIAGONAL_BLOCK,&hasop);CHKERRQ(ierr);
1550     if (hasop) {
1551       ierr = MatMultDiagonalBlock(matin,xx,bb1);CHKERRQ(ierr);
1552     } else {
1553       ierr = VecPointwiseMult(bb1,mat->diag,xx);CHKERRQ(ierr);
1554     }
1555     ierr = VecAYPX(bb1,(omega-2.0)/omega,bb);CHKERRQ(ierr);
1556 
1557     ierr = MatMultAdd(mat->B,mat->lvec,bb1,bb1);CHKERRQ(ierr);
1558 
1559     /* local sweep */
1560     ierr = (*mat->A->ops->sor)(mat->A,bb1,omega,(MatSORType)(SOR_ZERO_INITIAL_GUESS | SOR_LOCAL_FORWARD_SWEEP),fshift,lits,1,xx1);CHKERRQ(ierr);
1561     ierr = VecAXPY(xx,1.0,xx1);CHKERRQ(ierr);
1562     ierr = VecDestroy(&xx1);CHKERRQ(ierr);
1563   } else SETERRQ(PetscObjectComm((PetscObject)matin),PETSC_ERR_SUP,"Parallel SOR not supported");
1564 
1565   ierr = VecDestroy(&bb1);CHKERRQ(ierr);
1566 
1567   matin->errortype = mat->A->errortype;
1568   PetscFunctionReturn(0);
1569 }
1570 
1571 #undef __FUNCT__
1572 #define __FUNCT__ "MatPermute_MPIAIJ"
1573 PetscErrorCode MatPermute_MPIAIJ(Mat A,IS rowp,IS colp,Mat *B)
1574 {
1575   Mat            aA,aB,Aperm;
1576   const PetscInt *rwant,*cwant,*gcols,*ai,*bi,*aj,*bj;
1577   PetscScalar    *aa,*ba;
1578   PetscInt       i,j,m,n,ng,anz,bnz,*dnnz,*onnz,*tdnnz,*tonnz,*rdest,*cdest,*work,*gcdest;
1579   PetscSF        rowsf,sf;
1580   IS             parcolp = NULL;
1581   PetscBool      done;
1582   PetscErrorCode ierr;
1583 
1584   PetscFunctionBegin;
1585   ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
1586   ierr = ISGetIndices(rowp,&rwant);CHKERRQ(ierr);
1587   ierr = ISGetIndices(colp,&cwant);CHKERRQ(ierr);
1588   ierr = PetscMalloc3(PetscMax(m,n),&work,m,&rdest,n,&cdest);CHKERRQ(ierr);
1589 
1590   /* Invert row permutation to find out where my rows should go */
1591   ierr = PetscSFCreate(PetscObjectComm((PetscObject)A),&rowsf);CHKERRQ(ierr);
1592   ierr = PetscSFSetGraphLayout(rowsf,A->rmap,A->rmap->n,NULL,PETSC_OWN_POINTER,rwant);CHKERRQ(ierr);
1593   ierr = PetscSFSetFromOptions(rowsf);CHKERRQ(ierr);
1594   for (i=0; i<m; i++) work[i] = A->rmap->rstart + i;
1595   ierr = PetscSFReduceBegin(rowsf,MPIU_INT,work,rdest,MPIU_REPLACE);CHKERRQ(ierr);
1596   ierr = PetscSFReduceEnd(rowsf,MPIU_INT,work,rdest,MPIU_REPLACE);CHKERRQ(ierr);
1597 
1598   /* Invert column permutation to find out where my columns should go */
1599   ierr = PetscSFCreate(PetscObjectComm((PetscObject)A),&sf);CHKERRQ(ierr);
1600   ierr = PetscSFSetGraphLayout(sf,A->cmap,A->cmap->n,NULL,PETSC_OWN_POINTER,cwant);CHKERRQ(ierr);
1601   ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
1602   for (i=0; i<n; i++) work[i] = A->cmap->rstart + i;
1603   ierr = PetscSFReduceBegin(sf,MPIU_INT,work,cdest,MPIU_REPLACE);CHKERRQ(ierr);
1604   ierr = PetscSFReduceEnd(sf,MPIU_INT,work,cdest,MPIU_REPLACE);CHKERRQ(ierr);
1605   ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1606 
1607   ierr = ISRestoreIndices(rowp,&rwant);CHKERRQ(ierr);
1608   ierr = ISRestoreIndices(colp,&cwant);CHKERRQ(ierr);
1609   ierr = MatMPIAIJGetSeqAIJ(A,&aA,&aB,&gcols);CHKERRQ(ierr);
1610 
1611   /* Find out where my gcols should go */
1612   ierr = MatGetSize(aB,NULL,&ng);CHKERRQ(ierr);
1613   ierr = PetscMalloc1(ng,&gcdest);CHKERRQ(ierr);
1614   ierr = PetscSFCreate(PetscObjectComm((PetscObject)A),&sf);CHKERRQ(ierr);
1615   ierr = PetscSFSetGraphLayout(sf,A->cmap,ng,NULL,PETSC_OWN_POINTER,gcols);CHKERRQ(ierr);
1616   ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
1617   ierr = PetscSFBcastBegin(sf,MPIU_INT,cdest,gcdest);CHKERRQ(ierr);
1618   ierr = PetscSFBcastEnd(sf,MPIU_INT,cdest,gcdest);CHKERRQ(ierr);
1619   ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1620 
1621   ierr = PetscCalloc4(m,&dnnz,m,&onnz,m,&tdnnz,m,&tonnz);CHKERRQ(ierr);
1622   ierr = MatGetRowIJ(aA,0,PETSC_FALSE,PETSC_FALSE,&anz,&ai,&aj,&done);CHKERRQ(ierr);
1623   ierr = MatGetRowIJ(aB,0,PETSC_FALSE,PETSC_FALSE,&bnz,&bi,&bj,&done);CHKERRQ(ierr);
1624   for (i=0; i<m; i++) {
1625     PetscInt row = rdest[i],rowner;
1626     ierr = PetscLayoutFindOwner(A->rmap,row,&rowner);CHKERRQ(ierr);
1627     for (j=ai[i]; j<ai[i+1]; j++) {
1628       PetscInt cowner,col = cdest[aj[j]];
1629       ierr = PetscLayoutFindOwner(A->cmap,col,&cowner);CHKERRQ(ierr); /* Could build an index for the columns to eliminate this search */
1630       if (rowner == cowner) dnnz[i]++;
1631       else onnz[i]++;
1632     }
1633     for (j=bi[i]; j<bi[i+1]; j++) {
1634       PetscInt cowner,col = gcdest[bj[j]];
1635       ierr = PetscLayoutFindOwner(A->cmap,col,&cowner);CHKERRQ(ierr);
1636       if (rowner == cowner) dnnz[i]++;
1637       else onnz[i]++;
1638     }
1639   }
1640   ierr = PetscSFBcastBegin(rowsf,MPIU_INT,dnnz,tdnnz);CHKERRQ(ierr);
1641   ierr = PetscSFBcastEnd(rowsf,MPIU_INT,dnnz,tdnnz);CHKERRQ(ierr);
1642   ierr = PetscSFBcastBegin(rowsf,MPIU_INT,onnz,tonnz);CHKERRQ(ierr);
1643   ierr = PetscSFBcastEnd(rowsf,MPIU_INT,onnz,tonnz);CHKERRQ(ierr);
1644   ierr = PetscSFDestroy(&rowsf);CHKERRQ(ierr);
1645 
1646   ierr = MatCreateAIJ(PetscObjectComm((PetscObject)A),A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N,0,tdnnz,0,tonnz,&Aperm);CHKERRQ(ierr);
1647   ierr = MatSeqAIJGetArray(aA,&aa);CHKERRQ(ierr);
1648   ierr = MatSeqAIJGetArray(aB,&ba);CHKERRQ(ierr);
1649   for (i=0; i<m; i++) {
1650     PetscInt *acols = dnnz,*bcols = onnz; /* Repurpose now-unneeded arrays */
1651     PetscInt j0,rowlen;
1652     rowlen = ai[i+1] - ai[i];
1653     for (j0=j=0; j<rowlen; j0=j) { /* rowlen could be larger than number of rows m, so sum in batches */
1654       for ( ; j<PetscMin(rowlen,j0+m); j++) acols[j-j0] = cdest[aj[ai[i]+j]];
1655       ierr = MatSetValues(Aperm,1,&rdest[i],j-j0,acols,aa+ai[i]+j0,INSERT_VALUES);CHKERRQ(ierr);
1656     }
1657     rowlen = bi[i+1] - bi[i];
1658     for (j0=j=0; j<rowlen; j0=j) {
1659       for ( ; j<PetscMin(rowlen,j0+m); j++) bcols[j-j0] = gcdest[bj[bi[i]+j]];
1660       ierr = MatSetValues(Aperm,1,&rdest[i],j-j0,bcols,ba+bi[i]+j0,INSERT_VALUES);CHKERRQ(ierr);
1661     }
1662   }
1663   ierr = MatAssemblyBegin(Aperm,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1664   ierr = MatAssemblyEnd(Aperm,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1665   ierr = MatRestoreRowIJ(aA,0,PETSC_FALSE,PETSC_FALSE,&anz,&ai,&aj,&done);CHKERRQ(ierr);
1666   ierr = MatRestoreRowIJ(aB,0,PETSC_FALSE,PETSC_FALSE,&bnz,&bi,&bj,&done);CHKERRQ(ierr);
1667   ierr = MatSeqAIJRestoreArray(aA,&aa);CHKERRQ(ierr);
1668   ierr = MatSeqAIJRestoreArray(aB,&ba);CHKERRQ(ierr);
1669   ierr = PetscFree4(dnnz,onnz,tdnnz,tonnz);CHKERRQ(ierr);
1670   ierr = PetscFree3(work,rdest,cdest);CHKERRQ(ierr);
1671   ierr = PetscFree(gcdest);CHKERRQ(ierr);
1672   if (parcolp) {ierr = ISDestroy(&colp);CHKERRQ(ierr);}
1673   *B = Aperm;
1674   PetscFunctionReturn(0);
1675 }
1676 
1677 #undef __FUNCT__
1678 #define __FUNCT__ "MatGetGhosts_MPIAIJ"
1679 PetscErrorCode  MatGetGhosts_MPIAIJ(Mat mat,PetscInt *nghosts,const PetscInt *ghosts[])
1680 {
1681   Mat_MPIAIJ *aij = (Mat_MPIAIJ*)mat->data;
1682   PetscErrorCode ierr;
1683 
1684   PetscFunctionBegin;
1685   ierr = MatGetSize(aij->B,NULL,nghosts);CHKERRQ(ierr);
1686   if (ghosts) *ghosts = aij->garray;
1687   PetscFunctionReturn(0);
1688 }
1689 
1690 #undef __FUNCT__
1691 #define __FUNCT__ "MatGetInfo_MPIAIJ"
1692 PetscErrorCode MatGetInfo_MPIAIJ(Mat matin,MatInfoType flag,MatInfo *info)
1693 {
1694   Mat_MPIAIJ     *mat = (Mat_MPIAIJ*)matin->data;
1695   Mat            A    = mat->A,B = mat->B;
1696   PetscErrorCode ierr;
1697   PetscReal      isend[5],irecv[5];
1698 
1699   PetscFunctionBegin;
1700   info->block_size = 1.0;
1701   ierr             = MatGetInfo(A,MAT_LOCAL,info);CHKERRQ(ierr);
1702 
1703   isend[0] = info->nz_used; isend[1] = info->nz_allocated; isend[2] = info->nz_unneeded;
1704   isend[3] = info->memory;  isend[4] = info->mallocs;
1705 
1706   ierr = MatGetInfo(B,MAT_LOCAL,info);CHKERRQ(ierr);
1707 
1708   isend[0] += info->nz_used; isend[1] += info->nz_allocated; isend[2] += info->nz_unneeded;
1709   isend[3] += info->memory;  isend[4] += info->mallocs;
1710   if (flag == MAT_LOCAL) {
1711     info->nz_used      = isend[0];
1712     info->nz_allocated = isend[1];
1713     info->nz_unneeded  = isend[2];
1714     info->memory       = isend[3];
1715     info->mallocs      = isend[4];
1716   } else if (flag == MAT_GLOBAL_MAX) {
1717     ierr = MPIU_Allreduce(isend,irecv,5,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)matin));CHKERRQ(ierr);
1718 
1719     info->nz_used      = irecv[0];
1720     info->nz_allocated = irecv[1];
1721     info->nz_unneeded  = irecv[2];
1722     info->memory       = irecv[3];
1723     info->mallocs      = irecv[4];
1724   } else if (flag == MAT_GLOBAL_SUM) {
1725     ierr = MPIU_Allreduce(isend,irecv,5,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)matin));CHKERRQ(ierr);
1726 
1727     info->nz_used      = irecv[0];
1728     info->nz_allocated = irecv[1];
1729     info->nz_unneeded  = irecv[2];
1730     info->memory       = irecv[3];
1731     info->mallocs      = irecv[4];
1732   }
1733   info->fill_ratio_given  = 0; /* no parallel LU/ILU/Cholesky */
1734   info->fill_ratio_needed = 0;
1735   info->factor_mallocs    = 0;
1736   PetscFunctionReturn(0);
1737 }
1738 
1739 #undef __FUNCT__
1740 #define __FUNCT__ "MatSetOption_MPIAIJ"
1741 PetscErrorCode MatSetOption_MPIAIJ(Mat A,MatOption op,PetscBool flg)
1742 {
1743   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
1744   PetscErrorCode ierr;
1745 
1746   PetscFunctionBegin;
1747   switch (op) {
1748   case MAT_NEW_NONZERO_LOCATIONS:
1749   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1750   case MAT_UNUSED_NONZERO_LOCATION_ERR:
1751   case MAT_KEEP_NONZERO_PATTERN:
1752   case MAT_NEW_NONZERO_LOCATION_ERR:
1753   case MAT_USE_INODES:
1754   case MAT_IGNORE_ZERO_ENTRIES:
1755     MatCheckPreallocated(A,1);
1756     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1757     ierr = MatSetOption(a->B,op,flg);CHKERRQ(ierr);
1758     break;
1759   case MAT_ROW_ORIENTED:
1760     a->roworiented = flg;
1761 
1762     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1763     ierr = MatSetOption(a->B,op,flg);CHKERRQ(ierr);
1764     break;
1765   case MAT_NEW_DIAGONALS:
1766     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
1767     break;
1768   case MAT_IGNORE_OFF_PROC_ENTRIES:
1769     a->donotstash = flg;
1770     break;
1771   case MAT_SPD:
1772     A->spd_set = PETSC_TRUE;
1773     A->spd     = flg;
1774     if (flg) {
1775       A->symmetric                  = PETSC_TRUE;
1776       A->structurally_symmetric     = PETSC_TRUE;
1777       A->symmetric_set              = PETSC_TRUE;
1778       A->structurally_symmetric_set = PETSC_TRUE;
1779     }
1780     break;
1781   case MAT_SYMMETRIC:
1782     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1783     break;
1784   case MAT_STRUCTURALLY_SYMMETRIC:
1785     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1786     break;
1787   case MAT_HERMITIAN:
1788     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1789     break;
1790   case MAT_SYMMETRY_ETERNAL:
1791     ierr = MatSetOption(a->A,op,flg);CHKERRQ(ierr);
1792     break;
1793   default:
1794     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %d",op);
1795   }
1796   PetscFunctionReturn(0);
1797 }
1798 
1799 #undef __FUNCT__
1800 #define __FUNCT__ "MatGetRow_MPIAIJ"
1801 PetscErrorCode MatGetRow_MPIAIJ(Mat matin,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
1802 {
1803   Mat_MPIAIJ     *mat = (Mat_MPIAIJ*)matin->data;
1804   PetscScalar    *vworkA,*vworkB,**pvA,**pvB,*v_p;
1805   PetscErrorCode ierr;
1806   PetscInt       i,*cworkA,*cworkB,**pcA,**pcB,cstart = matin->cmap->rstart;
1807   PetscInt       nztot,nzA,nzB,lrow,rstart = matin->rmap->rstart,rend = matin->rmap->rend;
1808   PetscInt       *cmap,*idx_p;
1809 
1810   PetscFunctionBegin;
1811   if (mat->getrowactive) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Already active");
1812   mat->getrowactive = PETSC_TRUE;
1813 
1814   if (!mat->rowvalues && (idx || v)) {
1815     /*
1816         allocate enough space to hold information from the longest row.
1817     */
1818     Mat_SeqAIJ *Aa = (Mat_SeqAIJ*)mat->A->data,*Ba = (Mat_SeqAIJ*)mat->B->data;
1819     PetscInt   max = 1,tmp;
1820     for (i=0; i<matin->rmap->n; i++) {
1821       tmp = Aa->i[i+1] - Aa->i[i] + Ba->i[i+1] - Ba->i[i];
1822       if (max < tmp) max = tmp;
1823     }
1824     ierr = PetscMalloc2(max,&mat->rowvalues,max,&mat->rowindices);CHKERRQ(ierr);
1825   }
1826 
1827   if (row < rstart || row >= rend) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Only local rows");
1828   lrow = row - rstart;
1829 
1830   pvA = &vworkA; pcA = &cworkA; pvB = &vworkB; pcB = &cworkB;
1831   if (!v)   {pvA = 0; pvB = 0;}
1832   if (!idx) {pcA = 0; if (!v) pcB = 0;}
1833   ierr  = (*mat->A->ops->getrow)(mat->A,lrow,&nzA,pcA,pvA);CHKERRQ(ierr);
1834   ierr  = (*mat->B->ops->getrow)(mat->B,lrow,&nzB,pcB,pvB);CHKERRQ(ierr);
1835   nztot = nzA + nzB;
1836 
1837   cmap = mat->garray;
1838   if (v  || idx) {
1839     if (nztot) {
1840       /* Sort by increasing column numbers, assuming A and B already sorted */
1841       PetscInt imark = -1;
1842       if (v) {
1843         *v = v_p = mat->rowvalues;
1844         for (i=0; i<nzB; i++) {
1845           if (cmap[cworkB[i]] < cstart) v_p[i] = vworkB[i];
1846           else break;
1847         }
1848         imark = i;
1849         for (i=0; i<nzA; i++)     v_p[imark+i] = vworkA[i];
1850         for (i=imark; i<nzB; i++) v_p[nzA+i]   = vworkB[i];
1851       }
1852       if (idx) {
1853         *idx = idx_p = mat->rowindices;
1854         if (imark > -1) {
1855           for (i=0; i<imark; i++) {
1856             idx_p[i] = cmap[cworkB[i]];
1857           }
1858         } else {
1859           for (i=0; i<nzB; i++) {
1860             if (cmap[cworkB[i]] < cstart) idx_p[i] = cmap[cworkB[i]];
1861             else break;
1862           }
1863           imark = i;
1864         }
1865         for (i=0; i<nzA; i++)     idx_p[imark+i] = cstart + cworkA[i];
1866         for (i=imark; i<nzB; i++) idx_p[nzA+i]   = cmap[cworkB[i]];
1867       }
1868     } else {
1869       if (idx) *idx = 0;
1870       if (v)   *v   = 0;
1871     }
1872   }
1873   *nz  = nztot;
1874   ierr = (*mat->A->ops->restorerow)(mat->A,lrow,&nzA,pcA,pvA);CHKERRQ(ierr);
1875   ierr = (*mat->B->ops->restorerow)(mat->B,lrow,&nzB,pcB,pvB);CHKERRQ(ierr);
1876   PetscFunctionReturn(0);
1877 }
1878 
1879 #undef __FUNCT__
1880 #define __FUNCT__ "MatRestoreRow_MPIAIJ"
1881 PetscErrorCode MatRestoreRow_MPIAIJ(Mat mat,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
1882 {
1883   Mat_MPIAIJ *aij = (Mat_MPIAIJ*)mat->data;
1884 
1885   PetscFunctionBegin;
1886   if (!aij->getrowactive) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"MatGetRow() must be called first");
1887   aij->getrowactive = PETSC_FALSE;
1888   PetscFunctionReturn(0);
1889 }
1890 
1891 #undef __FUNCT__
1892 #define __FUNCT__ "MatNorm_MPIAIJ"
1893 PetscErrorCode MatNorm_MPIAIJ(Mat mat,NormType type,PetscReal *norm)
1894 {
1895   Mat_MPIAIJ     *aij  = (Mat_MPIAIJ*)mat->data;
1896   Mat_SeqAIJ     *amat = (Mat_SeqAIJ*)aij->A->data,*bmat = (Mat_SeqAIJ*)aij->B->data;
1897   PetscErrorCode ierr;
1898   PetscInt       i,j,cstart = mat->cmap->rstart;
1899   PetscReal      sum = 0.0;
1900   MatScalar      *v;
1901 
1902   PetscFunctionBegin;
1903   if (aij->size == 1) {
1904     ierr =  MatNorm(aij->A,type,norm);CHKERRQ(ierr);
1905   } else {
1906     if (type == NORM_FROBENIUS) {
1907       v = amat->a;
1908       for (i=0; i<amat->nz; i++) {
1909         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1910       }
1911       v = bmat->a;
1912       for (i=0; i<bmat->nz; i++) {
1913         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1914       }
1915       ierr  = MPIU_Allreduce(&sum,norm,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1916       *norm = PetscSqrtReal(*norm);
1917     } else if (type == NORM_1) { /* max column norm */
1918       PetscReal *tmp,*tmp2;
1919       PetscInt  *jj,*garray = aij->garray;
1920       ierr  = PetscCalloc1(mat->cmap->N+1,&tmp);CHKERRQ(ierr);
1921       ierr  = PetscMalloc1(mat->cmap->N+1,&tmp2);CHKERRQ(ierr);
1922       *norm = 0.0;
1923       v     = amat->a; jj = amat->j;
1924       for (j=0; j<amat->nz; j++) {
1925         tmp[cstart + *jj++] += PetscAbsScalar(*v);  v++;
1926       }
1927       v = bmat->a; jj = bmat->j;
1928       for (j=0; j<bmat->nz; j++) {
1929         tmp[garray[*jj++]] += PetscAbsScalar(*v); v++;
1930       }
1931       ierr = MPIU_Allreduce(tmp,tmp2,mat->cmap->N,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1932       for (j=0; j<mat->cmap->N; j++) {
1933         if (tmp2[j] > *norm) *norm = tmp2[j];
1934       }
1935       ierr = PetscFree(tmp);CHKERRQ(ierr);
1936       ierr = PetscFree(tmp2);CHKERRQ(ierr);
1937     } else if (type == NORM_INFINITY) { /* max row norm */
1938       PetscReal ntemp = 0.0;
1939       for (j=0; j<aij->A->rmap->n; j++) {
1940         v   = amat->a + amat->i[j];
1941         sum = 0.0;
1942         for (i=0; i<amat->i[j+1]-amat->i[j]; i++) {
1943           sum += PetscAbsScalar(*v); v++;
1944         }
1945         v = bmat->a + bmat->i[j];
1946         for (i=0; i<bmat->i[j+1]-bmat->i[j]; i++) {
1947           sum += PetscAbsScalar(*v); v++;
1948         }
1949         if (sum > ntemp) ntemp = sum;
1950       }
1951       ierr = MPIU_Allreduce(&ntemp,norm,1,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
1952     } else SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"No support for two norm");
1953   }
1954   PetscFunctionReturn(0);
1955 }
1956 
1957 #undef __FUNCT__
1958 #define __FUNCT__ "MatTranspose_MPIAIJ"
1959 PetscErrorCode MatTranspose_MPIAIJ(Mat A,MatReuse reuse,Mat *matout)
1960 {
1961   Mat_MPIAIJ     *a   = (Mat_MPIAIJ*)A->data;
1962   Mat_SeqAIJ     *Aloc=(Mat_SeqAIJ*)a->A->data,*Bloc=(Mat_SeqAIJ*)a->B->data;
1963   PetscErrorCode ierr;
1964   PetscInt       M      = A->rmap->N,N = A->cmap->N,ma,na,mb,nb,*ai,*aj,*bi,*bj,row,*cols,*cols_tmp,i;
1965   PetscInt       cstart = A->cmap->rstart,ncol;
1966   Mat            B;
1967   MatScalar      *array;
1968 
1969   PetscFunctionBegin;
1970   if (reuse == MAT_REUSE_MATRIX && A == *matout && M != N) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_SIZ,"Square matrix only for in-place");
1971 
1972   ma = A->rmap->n; na = A->cmap->n; mb = a->B->rmap->n; nb = a->B->cmap->n;
1973   ai = Aloc->i; aj = Aloc->j;
1974   bi = Bloc->i; bj = Bloc->j;
1975   if (reuse == MAT_INITIAL_MATRIX || *matout == A) {
1976     PetscInt             *d_nnz,*g_nnz,*o_nnz;
1977     PetscSFNode          *oloc;
1978     PETSC_UNUSED PetscSF sf;
1979 
1980     ierr = PetscMalloc4(na,&d_nnz,na,&o_nnz,nb,&g_nnz,nb,&oloc);CHKERRQ(ierr);
1981     /* compute d_nnz for preallocation */
1982     ierr = PetscMemzero(d_nnz,na*sizeof(PetscInt));CHKERRQ(ierr);
1983     for (i=0; i<ai[ma]; i++) {
1984       d_nnz[aj[i]]++;
1985       aj[i] += cstart; /* global col index to be used by MatSetValues() */
1986     }
1987     /* compute local off-diagonal contributions */
1988     ierr = PetscMemzero(g_nnz,nb*sizeof(PetscInt));CHKERRQ(ierr);
1989     for (i=0; i<bi[ma]; i++) g_nnz[bj[i]]++;
1990     /* map those to global */
1991     ierr = PetscSFCreate(PetscObjectComm((PetscObject)A),&sf);CHKERRQ(ierr);
1992     ierr = PetscSFSetGraphLayout(sf,A->cmap,nb,NULL,PETSC_USE_POINTER,a->garray);CHKERRQ(ierr);
1993     ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
1994     ierr = PetscMemzero(o_nnz,na*sizeof(PetscInt));CHKERRQ(ierr);
1995     ierr = PetscSFReduceBegin(sf,MPIU_INT,g_nnz,o_nnz,MPIU_SUM);CHKERRQ(ierr);
1996     ierr = PetscSFReduceEnd(sf,MPIU_INT,g_nnz,o_nnz,MPIU_SUM);CHKERRQ(ierr);
1997     ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1998 
1999     ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr);
2000     ierr = MatSetSizes(B,A->cmap->n,A->rmap->n,N,M);CHKERRQ(ierr);
2001     ierr = MatSetBlockSizes(B,PetscAbs(A->cmap->bs),PetscAbs(A->rmap->bs));CHKERRQ(ierr);
2002     ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
2003     ierr = MatMPIAIJSetPreallocation(B,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
2004     ierr = PetscFree4(d_nnz,o_nnz,g_nnz,oloc);CHKERRQ(ierr);
2005   } else {
2006     B    = *matout;
2007     ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2008     for (i=0; i<ai[ma]; i++) aj[i] += cstart; /* global col index to be used by MatSetValues() */
2009   }
2010 
2011   /* copy over the A part */
2012   array = Aloc->a;
2013   row   = A->rmap->rstart;
2014   for (i=0; i<ma; i++) {
2015     ncol = ai[i+1]-ai[i];
2016     ierr = MatSetValues(B,ncol,aj,1,&row,array,INSERT_VALUES);CHKERRQ(ierr);
2017     row++;
2018     array += ncol; aj += ncol;
2019   }
2020   aj = Aloc->j;
2021   for (i=0; i<ai[ma]; i++) aj[i] -= cstart; /* resume local col index */
2022 
2023   /* copy over the B part */
2024   ierr  = PetscCalloc1(bi[mb],&cols);CHKERRQ(ierr);
2025   array = Bloc->a;
2026   row   = A->rmap->rstart;
2027   for (i=0; i<bi[mb]; i++) cols[i] = a->garray[bj[i]];
2028   cols_tmp = cols;
2029   for (i=0; i<mb; i++) {
2030     ncol = bi[i+1]-bi[i];
2031     ierr = MatSetValues(B,ncol,cols_tmp,1,&row,array,INSERT_VALUES);CHKERRQ(ierr);
2032     row++;
2033     array += ncol; cols_tmp += ncol;
2034   }
2035   ierr = PetscFree(cols);CHKERRQ(ierr);
2036 
2037   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2038   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2039   if (reuse == MAT_INITIAL_MATRIX || *matout != A) {
2040     *matout = B;
2041   } else {
2042     ierr = MatHeaderMerge(A,&B);CHKERRQ(ierr);
2043   }
2044   PetscFunctionReturn(0);
2045 }
2046 
2047 #undef __FUNCT__
2048 #define __FUNCT__ "MatDiagonalScale_MPIAIJ"
2049 PetscErrorCode MatDiagonalScale_MPIAIJ(Mat mat,Vec ll,Vec rr)
2050 {
2051   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
2052   Mat            a    = aij->A,b = aij->B;
2053   PetscErrorCode ierr;
2054   PetscInt       s1,s2,s3;
2055 
2056   PetscFunctionBegin;
2057   ierr = MatGetLocalSize(mat,&s2,&s3);CHKERRQ(ierr);
2058   if (rr) {
2059     ierr = VecGetLocalSize(rr,&s1);CHKERRQ(ierr);
2060     if (s1!=s3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"right vector non-conforming local size");
2061     /* Overlap communication with computation. */
2062     ierr = VecScatterBegin(aij->Mvctx,rr,aij->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2063   }
2064   if (ll) {
2065     ierr = VecGetLocalSize(ll,&s1);CHKERRQ(ierr);
2066     if (s1!=s2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"left vector non-conforming local size");
2067     ierr = (*b->ops->diagonalscale)(b,ll,0);CHKERRQ(ierr);
2068   }
2069   /* scale  the diagonal block */
2070   ierr = (*a->ops->diagonalscale)(a,ll,rr);CHKERRQ(ierr);
2071 
2072   if (rr) {
2073     /* Do a scatter end and then right scale the off-diagonal block */
2074     ierr = VecScatterEnd(aij->Mvctx,rr,aij->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2075     ierr = (*b->ops->diagonalscale)(b,0,aij->lvec);CHKERRQ(ierr);
2076   }
2077   PetscFunctionReturn(0);
2078 }
2079 
2080 #undef __FUNCT__
2081 #define __FUNCT__ "MatSetUnfactored_MPIAIJ"
2082 PetscErrorCode MatSetUnfactored_MPIAIJ(Mat A)
2083 {
2084   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2085   PetscErrorCode ierr;
2086 
2087   PetscFunctionBegin;
2088   ierr = MatSetUnfactored(a->A);CHKERRQ(ierr);
2089   PetscFunctionReturn(0);
2090 }
2091 
2092 #undef __FUNCT__
2093 #define __FUNCT__ "MatEqual_MPIAIJ"
2094 PetscErrorCode MatEqual_MPIAIJ(Mat A,Mat B,PetscBool  *flag)
2095 {
2096   Mat_MPIAIJ     *matB = (Mat_MPIAIJ*)B->data,*matA = (Mat_MPIAIJ*)A->data;
2097   Mat            a,b,c,d;
2098   PetscBool      flg;
2099   PetscErrorCode ierr;
2100 
2101   PetscFunctionBegin;
2102   a = matA->A; b = matA->B;
2103   c = matB->A; d = matB->B;
2104 
2105   ierr = MatEqual(a,c,&flg);CHKERRQ(ierr);
2106   if (flg) {
2107     ierr = MatEqual(b,d,&flg);CHKERRQ(ierr);
2108   }
2109   ierr = MPIU_Allreduce(&flg,flag,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
2110   PetscFunctionReturn(0);
2111 }
2112 
2113 #undef __FUNCT__
2114 #define __FUNCT__ "MatCopy_MPIAIJ"
2115 PetscErrorCode MatCopy_MPIAIJ(Mat A,Mat B,MatStructure str)
2116 {
2117   PetscErrorCode ierr;
2118   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2119   Mat_MPIAIJ     *b = (Mat_MPIAIJ*)B->data;
2120 
2121   PetscFunctionBegin;
2122   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
2123   if ((str != SAME_NONZERO_PATTERN) || (A->ops->copy != B->ops->copy)) {
2124     /* because of the column compression in the off-processor part of the matrix a->B,
2125        the number of columns in a->B and b->B may be different, hence we cannot call
2126        the MatCopy() directly on the two parts. If need be, we can provide a more
2127        efficient copy than the MatCopy_Basic() by first uncompressing the a->B matrices
2128        then copying the submatrices */
2129     ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr);
2130   } else {
2131     ierr = MatCopy(a->A,b->A,str);CHKERRQ(ierr);
2132     ierr = MatCopy(a->B,b->B,str);CHKERRQ(ierr);
2133   }
2134   PetscFunctionReturn(0);
2135 }
2136 
2137 #undef __FUNCT__
2138 #define __FUNCT__ "MatSetUp_MPIAIJ"
2139 PetscErrorCode MatSetUp_MPIAIJ(Mat A)
2140 {
2141   PetscErrorCode ierr;
2142 
2143   PetscFunctionBegin;
2144   ierr =  MatMPIAIJSetPreallocation(A,PETSC_DEFAULT,0,PETSC_DEFAULT,0);CHKERRQ(ierr);
2145   PetscFunctionReturn(0);
2146 }
2147 
2148 /*
2149    Computes the number of nonzeros per row needed for preallocation when X and Y
2150    have different nonzero structure.
2151 */
2152 #undef __FUNCT__
2153 #define __FUNCT__ "MatAXPYGetPreallocation_MPIX_private"
2154 PetscErrorCode MatAXPYGetPreallocation_MPIX_private(PetscInt m,const PetscInt *xi,const PetscInt *xj,const PetscInt *xltog,const PetscInt *yi,const PetscInt *yj,const PetscInt *yltog,PetscInt *nnz)
2155 {
2156   PetscInt       i,j,k,nzx,nzy;
2157 
2158   PetscFunctionBegin;
2159   /* Set the number of nonzeros in the new matrix */
2160   for (i=0; i<m; i++) {
2161     const PetscInt *xjj = xj+xi[i],*yjj = yj+yi[i];
2162     nzx = xi[i+1] - xi[i];
2163     nzy = yi[i+1] - yi[i];
2164     nnz[i] = 0;
2165     for (j=0,k=0; j<nzx; j++) {                   /* Point in X */
2166       for (; k<nzy && yltog[yjj[k]]<xltog[xjj[j]]; k++) nnz[i]++; /* Catch up to X */
2167       if (k<nzy && yltog[yjj[k]]==xltog[xjj[j]]) k++;             /* Skip duplicate */
2168       nnz[i]++;
2169     }
2170     for (; k<nzy; k++) nnz[i]++;
2171   }
2172   PetscFunctionReturn(0);
2173 }
2174 
2175 /* This is the same as MatAXPYGetPreallocation_SeqAIJ, except that the local-to-global map is provided */
2176 #undef __FUNCT__
2177 #define __FUNCT__ "MatAXPYGetPreallocation_MPIAIJ"
2178 static PetscErrorCode MatAXPYGetPreallocation_MPIAIJ(Mat Y,const PetscInt *yltog,Mat X,const PetscInt *xltog,PetscInt *nnz)
2179 {
2180   PetscErrorCode ierr;
2181   PetscInt       m = Y->rmap->N;
2182   Mat_SeqAIJ     *x = (Mat_SeqAIJ*)X->data;
2183   Mat_SeqAIJ     *y = (Mat_SeqAIJ*)Y->data;
2184 
2185   PetscFunctionBegin;
2186   ierr = MatAXPYGetPreallocation_MPIX_private(m,x->i,x->j,xltog,y->i,y->j,yltog,nnz);CHKERRQ(ierr);
2187   PetscFunctionReturn(0);
2188 }
2189 
2190 #undef __FUNCT__
2191 #define __FUNCT__ "MatAXPY_MPIAIJ"
2192 PetscErrorCode MatAXPY_MPIAIJ(Mat Y,PetscScalar a,Mat X,MatStructure str)
2193 {
2194   PetscErrorCode ierr;
2195   Mat_MPIAIJ     *xx = (Mat_MPIAIJ*)X->data,*yy = (Mat_MPIAIJ*)Y->data;
2196   PetscBLASInt   bnz,one=1;
2197   Mat_SeqAIJ     *x,*y;
2198 
2199   PetscFunctionBegin;
2200   if (str == SAME_NONZERO_PATTERN) {
2201     PetscScalar alpha = a;
2202     x    = (Mat_SeqAIJ*)xx->A->data;
2203     ierr = PetscBLASIntCast(x->nz,&bnz);CHKERRQ(ierr);
2204     y    = (Mat_SeqAIJ*)yy->A->data;
2205     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&bnz,&alpha,x->a,&one,y->a,&one));
2206     x    = (Mat_SeqAIJ*)xx->B->data;
2207     y    = (Mat_SeqAIJ*)yy->B->data;
2208     ierr = PetscBLASIntCast(x->nz,&bnz);CHKERRQ(ierr);
2209     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&bnz,&alpha,x->a,&one,y->a,&one));
2210     ierr = PetscObjectStateIncrease((PetscObject)Y);CHKERRQ(ierr);
2211   } else if (str == SUBSET_NONZERO_PATTERN) { /* nonzeros of X is a subset of Y's */
2212     ierr = MatAXPY_Basic(Y,a,X,str);CHKERRQ(ierr);
2213   } else {
2214     Mat      B;
2215     PetscInt *nnz_d,*nnz_o;
2216     ierr = PetscMalloc1(yy->A->rmap->N,&nnz_d);CHKERRQ(ierr);
2217     ierr = PetscMalloc1(yy->B->rmap->N,&nnz_o);CHKERRQ(ierr);
2218     ierr = MatCreate(PetscObjectComm((PetscObject)Y),&B);CHKERRQ(ierr);
2219     ierr = PetscObjectSetName((PetscObject)B,((PetscObject)Y)->name);CHKERRQ(ierr);
2220     ierr = MatSetSizes(B,Y->rmap->n,Y->cmap->n,Y->rmap->N,Y->cmap->N);CHKERRQ(ierr);
2221     ierr = MatSetBlockSizesFromMats(B,Y,Y);CHKERRQ(ierr);
2222     ierr = MatSetType(B,MATMPIAIJ);CHKERRQ(ierr);
2223     ierr = MatAXPYGetPreallocation_SeqAIJ(yy->A,xx->A,nnz_d);CHKERRQ(ierr);
2224     ierr = MatAXPYGetPreallocation_MPIAIJ(yy->B,yy->garray,xx->B,xx->garray,nnz_o);CHKERRQ(ierr);
2225     ierr = MatMPIAIJSetPreallocation(B,0,nnz_d,0,nnz_o);CHKERRQ(ierr);
2226     ierr = MatAXPY_BasicWithPreallocation(B,Y,a,X,str);CHKERRQ(ierr);
2227     ierr = MatHeaderReplace(Y,&B);CHKERRQ(ierr);
2228     ierr = PetscFree(nnz_d);CHKERRQ(ierr);
2229     ierr = PetscFree(nnz_o);CHKERRQ(ierr);
2230   }
2231   PetscFunctionReturn(0);
2232 }
2233 
2234 extern PetscErrorCode  MatConjugate_SeqAIJ(Mat);
2235 
2236 #undef __FUNCT__
2237 #define __FUNCT__ "MatConjugate_MPIAIJ"
2238 PetscErrorCode  MatConjugate_MPIAIJ(Mat mat)
2239 {
2240 #if defined(PETSC_USE_COMPLEX)
2241   PetscErrorCode ierr;
2242   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
2243 
2244   PetscFunctionBegin;
2245   ierr = MatConjugate_SeqAIJ(aij->A);CHKERRQ(ierr);
2246   ierr = MatConjugate_SeqAIJ(aij->B);CHKERRQ(ierr);
2247 #else
2248   PetscFunctionBegin;
2249 #endif
2250   PetscFunctionReturn(0);
2251 }
2252 
2253 #undef __FUNCT__
2254 #define __FUNCT__ "MatRealPart_MPIAIJ"
2255 PetscErrorCode MatRealPart_MPIAIJ(Mat A)
2256 {
2257   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2258   PetscErrorCode ierr;
2259 
2260   PetscFunctionBegin;
2261   ierr = MatRealPart(a->A);CHKERRQ(ierr);
2262   ierr = MatRealPart(a->B);CHKERRQ(ierr);
2263   PetscFunctionReturn(0);
2264 }
2265 
2266 #undef __FUNCT__
2267 #define __FUNCT__ "MatImaginaryPart_MPIAIJ"
2268 PetscErrorCode MatImaginaryPart_MPIAIJ(Mat A)
2269 {
2270   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2271   PetscErrorCode ierr;
2272 
2273   PetscFunctionBegin;
2274   ierr = MatImaginaryPart(a->A);CHKERRQ(ierr);
2275   ierr = MatImaginaryPart(a->B);CHKERRQ(ierr);
2276   PetscFunctionReturn(0);
2277 }
2278 
2279 #undef __FUNCT__
2280 #define __FUNCT__ "MatGetRowMaxAbs_MPIAIJ"
2281 PetscErrorCode MatGetRowMaxAbs_MPIAIJ(Mat A, Vec v, PetscInt idx[])
2282 {
2283   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2284   PetscErrorCode ierr;
2285   PetscInt       i,*idxb = 0;
2286   PetscScalar    *va,*vb;
2287   Vec            vtmp;
2288 
2289   PetscFunctionBegin;
2290   ierr = MatGetRowMaxAbs(a->A,v,idx);CHKERRQ(ierr);
2291   ierr = VecGetArray(v,&va);CHKERRQ(ierr);
2292   if (idx) {
2293     for (i=0; i<A->rmap->n; i++) {
2294       if (PetscAbsScalar(va[i])) idx[i] += A->cmap->rstart;
2295     }
2296   }
2297 
2298   ierr = VecCreateSeq(PETSC_COMM_SELF,A->rmap->n,&vtmp);CHKERRQ(ierr);
2299   if (idx) {
2300     ierr = PetscMalloc1(A->rmap->n,&idxb);CHKERRQ(ierr);
2301   }
2302   ierr = MatGetRowMaxAbs(a->B,vtmp,idxb);CHKERRQ(ierr);
2303   ierr = VecGetArray(vtmp,&vb);CHKERRQ(ierr);
2304 
2305   for (i=0; i<A->rmap->n; i++) {
2306     if (PetscAbsScalar(va[i]) < PetscAbsScalar(vb[i])) {
2307       va[i] = vb[i];
2308       if (idx) idx[i] = a->garray[idxb[i]];
2309     }
2310   }
2311 
2312   ierr = VecRestoreArray(v,&va);CHKERRQ(ierr);
2313   ierr = VecRestoreArray(vtmp,&vb);CHKERRQ(ierr);
2314   ierr = PetscFree(idxb);CHKERRQ(ierr);
2315   ierr = VecDestroy(&vtmp);CHKERRQ(ierr);
2316   PetscFunctionReturn(0);
2317 }
2318 
2319 #undef __FUNCT__
2320 #define __FUNCT__ "MatGetRowMinAbs_MPIAIJ"
2321 PetscErrorCode MatGetRowMinAbs_MPIAIJ(Mat A, Vec v, PetscInt idx[])
2322 {
2323   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2324   PetscErrorCode ierr;
2325   PetscInt       i,*idxb = 0;
2326   PetscScalar    *va,*vb;
2327   Vec            vtmp;
2328 
2329   PetscFunctionBegin;
2330   ierr = MatGetRowMinAbs(a->A,v,idx);CHKERRQ(ierr);
2331   ierr = VecGetArray(v,&va);CHKERRQ(ierr);
2332   if (idx) {
2333     for (i=0; i<A->cmap->n; i++) {
2334       if (PetscAbsScalar(va[i])) idx[i] += A->cmap->rstart;
2335     }
2336   }
2337 
2338   ierr = VecCreateSeq(PETSC_COMM_SELF,A->rmap->n,&vtmp);CHKERRQ(ierr);
2339   if (idx) {
2340     ierr = PetscMalloc1(A->rmap->n,&idxb);CHKERRQ(ierr);
2341   }
2342   ierr = MatGetRowMinAbs(a->B,vtmp,idxb);CHKERRQ(ierr);
2343   ierr = VecGetArray(vtmp,&vb);CHKERRQ(ierr);
2344 
2345   for (i=0; i<A->rmap->n; i++) {
2346     if (PetscAbsScalar(va[i]) > PetscAbsScalar(vb[i])) {
2347       va[i] = vb[i];
2348       if (idx) idx[i] = a->garray[idxb[i]];
2349     }
2350   }
2351 
2352   ierr = VecRestoreArray(v,&va);CHKERRQ(ierr);
2353   ierr = VecRestoreArray(vtmp,&vb);CHKERRQ(ierr);
2354   ierr = PetscFree(idxb);CHKERRQ(ierr);
2355   ierr = VecDestroy(&vtmp);CHKERRQ(ierr);
2356   PetscFunctionReturn(0);
2357 }
2358 
2359 #undef __FUNCT__
2360 #define __FUNCT__ "MatGetRowMin_MPIAIJ"
2361 PetscErrorCode MatGetRowMin_MPIAIJ(Mat A, Vec v, PetscInt idx[])
2362 {
2363   Mat_MPIAIJ     *mat   = (Mat_MPIAIJ*) A->data;
2364   PetscInt       n      = A->rmap->n;
2365   PetscInt       cstart = A->cmap->rstart;
2366   PetscInt       *cmap  = mat->garray;
2367   PetscInt       *diagIdx, *offdiagIdx;
2368   Vec            diagV, offdiagV;
2369   PetscScalar    *a, *diagA, *offdiagA;
2370   PetscInt       r;
2371   PetscErrorCode ierr;
2372 
2373   PetscFunctionBegin;
2374   ierr = PetscMalloc2(n,&diagIdx,n,&offdiagIdx);CHKERRQ(ierr);
2375   ierr = VecCreateSeq(PetscObjectComm((PetscObject)A), n, &diagV);CHKERRQ(ierr);
2376   ierr = VecCreateSeq(PetscObjectComm((PetscObject)A), n, &offdiagV);CHKERRQ(ierr);
2377   ierr = MatGetRowMin(mat->A, diagV,    diagIdx);CHKERRQ(ierr);
2378   ierr = MatGetRowMin(mat->B, offdiagV, offdiagIdx);CHKERRQ(ierr);
2379   ierr = VecGetArray(v,        &a);CHKERRQ(ierr);
2380   ierr = VecGetArray(diagV,    &diagA);CHKERRQ(ierr);
2381   ierr = VecGetArray(offdiagV, &offdiagA);CHKERRQ(ierr);
2382   for (r = 0; r < n; ++r) {
2383     if (PetscAbsScalar(diagA[r]) <= PetscAbsScalar(offdiagA[r])) {
2384       a[r]   = diagA[r];
2385       idx[r] = cstart + diagIdx[r];
2386     } else {
2387       a[r]   = offdiagA[r];
2388       idx[r] = cmap[offdiagIdx[r]];
2389     }
2390   }
2391   ierr = VecRestoreArray(v,        &a);CHKERRQ(ierr);
2392   ierr = VecRestoreArray(diagV,    &diagA);CHKERRQ(ierr);
2393   ierr = VecRestoreArray(offdiagV, &offdiagA);CHKERRQ(ierr);
2394   ierr = VecDestroy(&diagV);CHKERRQ(ierr);
2395   ierr = VecDestroy(&offdiagV);CHKERRQ(ierr);
2396   ierr = PetscFree2(diagIdx, offdiagIdx);CHKERRQ(ierr);
2397   PetscFunctionReturn(0);
2398 }
2399 
2400 #undef __FUNCT__
2401 #define __FUNCT__ "MatGetRowMax_MPIAIJ"
2402 PetscErrorCode MatGetRowMax_MPIAIJ(Mat A, Vec v, PetscInt idx[])
2403 {
2404   Mat_MPIAIJ     *mat   = (Mat_MPIAIJ*) A->data;
2405   PetscInt       n      = A->rmap->n;
2406   PetscInt       cstart = A->cmap->rstart;
2407   PetscInt       *cmap  = mat->garray;
2408   PetscInt       *diagIdx, *offdiagIdx;
2409   Vec            diagV, offdiagV;
2410   PetscScalar    *a, *diagA, *offdiagA;
2411   PetscInt       r;
2412   PetscErrorCode ierr;
2413 
2414   PetscFunctionBegin;
2415   ierr = PetscMalloc2(n,&diagIdx,n,&offdiagIdx);CHKERRQ(ierr);
2416   ierr = VecCreateSeq(PETSC_COMM_SELF, n, &diagV);CHKERRQ(ierr);
2417   ierr = VecCreateSeq(PETSC_COMM_SELF, n, &offdiagV);CHKERRQ(ierr);
2418   ierr = MatGetRowMax(mat->A, diagV,    diagIdx);CHKERRQ(ierr);
2419   ierr = MatGetRowMax(mat->B, offdiagV, offdiagIdx);CHKERRQ(ierr);
2420   ierr = VecGetArray(v,        &a);CHKERRQ(ierr);
2421   ierr = VecGetArray(diagV,    &diagA);CHKERRQ(ierr);
2422   ierr = VecGetArray(offdiagV, &offdiagA);CHKERRQ(ierr);
2423   for (r = 0; r < n; ++r) {
2424     if (PetscAbsScalar(diagA[r]) >= PetscAbsScalar(offdiagA[r])) {
2425       a[r]   = diagA[r];
2426       idx[r] = cstart + diagIdx[r];
2427     } else {
2428       a[r]   = offdiagA[r];
2429       idx[r] = cmap[offdiagIdx[r]];
2430     }
2431   }
2432   ierr = VecRestoreArray(v,        &a);CHKERRQ(ierr);
2433   ierr = VecRestoreArray(diagV,    &diagA);CHKERRQ(ierr);
2434   ierr = VecRestoreArray(offdiagV, &offdiagA);CHKERRQ(ierr);
2435   ierr = VecDestroy(&diagV);CHKERRQ(ierr);
2436   ierr = VecDestroy(&offdiagV);CHKERRQ(ierr);
2437   ierr = PetscFree2(diagIdx, offdiagIdx);CHKERRQ(ierr);
2438   PetscFunctionReturn(0);
2439 }
2440 
2441 #undef __FUNCT__
2442 #define __FUNCT__ "MatGetSeqNonzeroStructure_MPIAIJ"
2443 PetscErrorCode MatGetSeqNonzeroStructure_MPIAIJ(Mat mat,Mat *newmat)
2444 {
2445   PetscErrorCode ierr;
2446   Mat            *dummy;
2447 
2448   PetscFunctionBegin;
2449   ierr    = MatGetSubMatrix_MPIAIJ_All(mat,MAT_DO_NOT_GET_VALUES,MAT_INITIAL_MATRIX,&dummy);CHKERRQ(ierr);
2450   *newmat = *dummy;
2451   ierr    = PetscFree(dummy);CHKERRQ(ierr);
2452   PetscFunctionReturn(0);
2453 }
2454 
2455 #undef __FUNCT__
2456 #define __FUNCT__ "MatInvertBlockDiagonal_MPIAIJ"
2457 PetscErrorCode  MatInvertBlockDiagonal_MPIAIJ(Mat A,const PetscScalar **values)
2458 {
2459   Mat_MPIAIJ     *a = (Mat_MPIAIJ*) A->data;
2460   PetscErrorCode ierr;
2461 
2462   PetscFunctionBegin;
2463   ierr = MatInvertBlockDiagonal(a->A,values);CHKERRQ(ierr);
2464   A->errortype = a->A->errortype;
2465   PetscFunctionReturn(0);
2466 }
2467 
2468 #undef __FUNCT__
2469 #define __FUNCT__ "MatSetRandom_MPIAIJ"
2470 static PetscErrorCode  MatSetRandom_MPIAIJ(Mat x,PetscRandom rctx)
2471 {
2472   PetscErrorCode ierr;
2473   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)x->data;
2474 
2475   PetscFunctionBegin;
2476   ierr = MatSetRandom(aij->A,rctx);CHKERRQ(ierr);
2477   ierr = MatSetRandom(aij->B,rctx);CHKERRQ(ierr);
2478   ierr = MatAssemblyBegin(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2479   ierr = MatAssemblyEnd(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2480   PetscFunctionReturn(0);
2481 }
2482 
2483 #undef __FUNCT__
2484 #define __FUNCT__ "MatMPIAIJSetUseScalableIncreaseOverlap_MPIAIJ"
2485 PetscErrorCode MatMPIAIJSetUseScalableIncreaseOverlap_MPIAIJ(Mat A,PetscBool sc)
2486 {
2487   PetscFunctionBegin;
2488   if (sc) A->ops->increaseoverlap = MatIncreaseOverlap_MPIAIJ_Scalable;
2489   else A->ops->increaseoverlap    = MatIncreaseOverlap_MPIAIJ;
2490   PetscFunctionReturn(0);
2491 }
2492 
2493 #undef __FUNCT__
2494 #define __FUNCT__ "MatMPIAIJSetUseScalableIncreaseOverlap"
2495 /*@
2496    MatMPIAIJSetUseScalableIncreaseOverlap - Determine if the matrix uses a scalable algorithm to compute the overlap
2497 
2498    Collective on Mat
2499 
2500    Input Parameters:
2501 +    A - the matrix
2502 -    sc - PETSC_TRUE indicates use the scalable algorithm (default is not to use the scalable algorithm)
2503 
2504 @*/
2505 PetscErrorCode MatMPIAIJSetUseScalableIncreaseOverlap(Mat A,PetscBool sc)
2506 {
2507   PetscErrorCode       ierr;
2508 
2509   PetscFunctionBegin;
2510   ierr = PetscTryMethod(A,"MatMPIAIJSetUseScalableIncreaseOverlap_C",(Mat,PetscBool),(A,sc));CHKERRQ(ierr);
2511   PetscFunctionReturn(0);
2512 }
2513 
2514 #undef __FUNCT__
2515 #define __FUNCT__ "MatSetFromOptions_MPIAIJ"
2516 PetscErrorCode MatSetFromOptions_MPIAIJ(PetscOptionItems *PetscOptionsObject,Mat A)
2517 {
2518   PetscErrorCode       ierr;
2519   PetscBool            sc = PETSC_FALSE,flg;
2520 
2521   PetscFunctionBegin;
2522   ierr = PetscOptionsHead(PetscOptionsObject,"MPIAIJ options");CHKERRQ(ierr);
2523   ierr = PetscObjectOptionsBegin((PetscObject)A);
2524     if (A->ops->increaseoverlap == MatIncreaseOverlap_MPIAIJ_Scalable) sc = PETSC_TRUE;
2525     ierr = PetscOptionsBool("-mat_increase_overlap_scalable","Use a scalable algorithm to compute the overlap","MatIncreaseOverlap",sc,&sc,&flg);CHKERRQ(ierr);
2526     if (flg) {
2527       ierr = MatMPIAIJSetUseScalableIncreaseOverlap(A,sc);CHKERRQ(ierr);
2528     }
2529   ierr = PetscOptionsEnd();CHKERRQ(ierr);
2530   PetscFunctionReturn(0);
2531 }
2532 
2533 #undef __FUNCT__
2534 #define __FUNCT__ "MatShift_MPIAIJ"
2535 PetscErrorCode MatShift_MPIAIJ(Mat Y,PetscScalar a)
2536 {
2537   PetscErrorCode ierr;
2538   Mat_MPIAIJ     *maij = (Mat_MPIAIJ*)Y->data;
2539   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)maij->A->data;
2540 
2541   PetscFunctionBegin;
2542   if (!Y->preallocated) {
2543     ierr = MatMPIAIJSetPreallocation(Y,1,NULL,0,NULL);CHKERRQ(ierr);
2544   } else if (!aij->nz) {
2545     PetscInt nonew = aij->nonew;
2546     ierr = MatSeqAIJSetPreallocation(maij->A,1,NULL);CHKERRQ(ierr);
2547     aij->nonew = nonew;
2548   }
2549   ierr = MatShift_Basic(Y,a);CHKERRQ(ierr);
2550   PetscFunctionReturn(0);
2551 }
2552 
2553 #undef __FUNCT__
2554 #define __FUNCT__ "MatMissingDiagonal_MPIAIJ"
2555 PetscErrorCode MatMissingDiagonal_MPIAIJ(Mat A,PetscBool  *missing,PetscInt *d)
2556 {
2557   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
2558   PetscErrorCode ierr;
2559 
2560   PetscFunctionBegin;
2561   if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only works for square matrices");
2562   ierr = MatMissingDiagonal(a->A,missing,d);CHKERRQ(ierr);
2563   if (d) {
2564     PetscInt rstart;
2565     ierr = MatGetOwnershipRange(A,&rstart,NULL);CHKERRQ(ierr);
2566     *d += rstart;
2567 
2568   }
2569   PetscFunctionReturn(0);
2570 }
2571 
2572 
2573 /* -------------------------------------------------------------------*/
2574 static struct _MatOps MatOps_Values = {MatSetValues_MPIAIJ,
2575                                        MatGetRow_MPIAIJ,
2576                                        MatRestoreRow_MPIAIJ,
2577                                        MatMult_MPIAIJ,
2578                                 /* 4*/ MatMultAdd_MPIAIJ,
2579                                        MatMultTranspose_MPIAIJ,
2580                                        MatMultTransposeAdd_MPIAIJ,
2581                                        0,
2582                                        0,
2583                                        0,
2584                                 /*10*/ 0,
2585                                        0,
2586                                        0,
2587                                        MatSOR_MPIAIJ,
2588                                        MatTranspose_MPIAIJ,
2589                                 /*15*/ MatGetInfo_MPIAIJ,
2590                                        MatEqual_MPIAIJ,
2591                                        MatGetDiagonal_MPIAIJ,
2592                                        MatDiagonalScale_MPIAIJ,
2593                                        MatNorm_MPIAIJ,
2594                                 /*20*/ MatAssemblyBegin_MPIAIJ,
2595                                        MatAssemblyEnd_MPIAIJ,
2596                                        MatSetOption_MPIAIJ,
2597                                        MatZeroEntries_MPIAIJ,
2598                                 /*24*/ MatZeroRows_MPIAIJ,
2599                                        0,
2600                                        0,
2601                                        0,
2602                                        0,
2603                                 /*29*/ MatSetUp_MPIAIJ,
2604                                        0,
2605                                        0,
2606                                        0,
2607                                        0,
2608                                 /*34*/ MatDuplicate_MPIAIJ,
2609                                        0,
2610                                        0,
2611                                        0,
2612                                        0,
2613                                 /*39*/ MatAXPY_MPIAIJ,
2614                                        MatGetSubMatrices_MPIAIJ,
2615                                        MatIncreaseOverlap_MPIAIJ,
2616                                        MatGetValues_MPIAIJ,
2617                                        MatCopy_MPIAIJ,
2618                                 /*44*/ MatGetRowMax_MPIAIJ,
2619                                        MatScale_MPIAIJ,
2620                                        MatShift_MPIAIJ,
2621                                        MatDiagonalSet_MPIAIJ,
2622                                        MatZeroRowsColumns_MPIAIJ,
2623                                 /*49*/ MatSetRandom_MPIAIJ,
2624                                        0,
2625                                        0,
2626                                        0,
2627                                        0,
2628                                 /*54*/ MatFDColoringCreate_MPIXAIJ,
2629                                        0,
2630                                        MatSetUnfactored_MPIAIJ,
2631                                        MatPermute_MPIAIJ,
2632                                        0,
2633                                 /*59*/ MatGetSubMatrix_MPIAIJ,
2634                                        MatDestroy_MPIAIJ,
2635                                        MatView_MPIAIJ,
2636                                        0,
2637                                        MatMatMatMult_MPIAIJ_MPIAIJ_MPIAIJ,
2638                                 /*64*/ MatMatMatMultSymbolic_MPIAIJ_MPIAIJ_MPIAIJ,
2639                                        MatMatMatMultNumeric_MPIAIJ_MPIAIJ_MPIAIJ,
2640                                        0,
2641                                        0,
2642                                        0,
2643                                 /*69*/ MatGetRowMaxAbs_MPIAIJ,
2644                                        MatGetRowMinAbs_MPIAIJ,
2645                                        0,
2646                                        MatSetColoring_MPIAIJ,
2647                                        0,
2648                                        MatSetValuesAdifor_MPIAIJ,
2649                                 /*75*/ MatFDColoringApply_AIJ,
2650                                        MatSetFromOptions_MPIAIJ,
2651                                        0,
2652                                        0,
2653                                        MatFindZeroDiagonals_MPIAIJ,
2654                                 /*80*/ 0,
2655                                        0,
2656                                        0,
2657                                 /*83*/ MatLoad_MPIAIJ,
2658                                        0,
2659                                        0,
2660                                        0,
2661                                        0,
2662                                        0,
2663                                 /*89*/ MatMatMult_MPIAIJ_MPIAIJ,
2664                                        MatMatMultSymbolic_MPIAIJ_MPIAIJ,
2665                                        MatMatMultNumeric_MPIAIJ_MPIAIJ,
2666                                        MatPtAP_MPIAIJ_MPIAIJ,
2667                                        MatPtAPSymbolic_MPIAIJ_MPIAIJ,
2668                                 /*94*/ MatPtAPNumeric_MPIAIJ_MPIAIJ,
2669                                        0,
2670                                        0,
2671                                        0,
2672                                        0,
2673                                 /*99*/ 0,
2674                                        0,
2675                                        0,
2676                                        MatConjugate_MPIAIJ,
2677                                        0,
2678                                 /*104*/MatSetValuesRow_MPIAIJ,
2679                                        MatRealPart_MPIAIJ,
2680                                        MatImaginaryPart_MPIAIJ,
2681                                        0,
2682                                        0,
2683                                 /*109*/0,
2684                                        0,
2685                                        MatGetRowMin_MPIAIJ,
2686                                        0,
2687                                        MatMissingDiagonal_MPIAIJ,
2688                                 /*114*/MatGetSeqNonzeroStructure_MPIAIJ,
2689                                        0,
2690                                        MatGetGhosts_MPIAIJ,
2691                                        0,
2692                                        0,
2693                                 /*119*/0,
2694                                        0,
2695                                        0,
2696                                        0,
2697                                        MatGetMultiProcBlock_MPIAIJ,
2698                                 /*124*/MatFindNonzeroRows_MPIAIJ,
2699                                        MatGetColumnNorms_MPIAIJ,
2700                                        MatInvertBlockDiagonal_MPIAIJ,
2701                                        0,
2702                                        MatGetSubMatricesMPI_MPIAIJ,
2703                                 /*129*/0,
2704                                        MatTransposeMatMult_MPIAIJ_MPIAIJ,
2705                                        MatTransposeMatMultSymbolic_MPIAIJ_MPIAIJ,
2706                                        MatTransposeMatMultNumeric_MPIAIJ_MPIAIJ,
2707                                        0,
2708                                 /*134*/0,
2709                                        0,
2710                                        0,
2711                                        0,
2712                                        0,
2713                                 /*139*/0,
2714                                        0,
2715                                        0,
2716                                        MatFDColoringSetUp_MPIXAIJ,
2717                                        MatFindOffBlockDiagonalEntries_MPIAIJ,
2718                                 /*144*/MatCreateMPIMatConcatenateSeqMat_MPIAIJ
2719 };
2720 
2721 /* ----------------------------------------------------------------------------------------*/
2722 
2723 #undef __FUNCT__
2724 #define __FUNCT__ "MatStoreValues_MPIAIJ"
2725 PetscErrorCode  MatStoreValues_MPIAIJ(Mat mat)
2726 {
2727   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
2728   PetscErrorCode ierr;
2729 
2730   PetscFunctionBegin;
2731   ierr = MatStoreValues(aij->A);CHKERRQ(ierr);
2732   ierr = MatStoreValues(aij->B);CHKERRQ(ierr);
2733   PetscFunctionReturn(0);
2734 }
2735 
2736 #undef __FUNCT__
2737 #define __FUNCT__ "MatRetrieveValues_MPIAIJ"
2738 PetscErrorCode  MatRetrieveValues_MPIAIJ(Mat mat)
2739 {
2740   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
2741   PetscErrorCode ierr;
2742 
2743   PetscFunctionBegin;
2744   ierr = MatRetrieveValues(aij->A);CHKERRQ(ierr);
2745   ierr = MatRetrieveValues(aij->B);CHKERRQ(ierr);
2746   PetscFunctionReturn(0);
2747 }
2748 
2749 #undef __FUNCT__
2750 #define __FUNCT__ "MatMPIAIJSetPreallocation_MPIAIJ"
2751 PetscErrorCode  MatMPIAIJSetPreallocation_MPIAIJ(Mat B,PetscInt d_nz,const PetscInt d_nnz[],PetscInt o_nz,const PetscInt o_nnz[])
2752 {
2753   Mat_MPIAIJ     *b;
2754   PetscErrorCode ierr;
2755 
2756   PetscFunctionBegin;
2757   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
2758   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
2759   b = (Mat_MPIAIJ*)B->data;
2760 
2761   if (!B->preallocated) {
2762     /* Explicitly create 2 MATSEQAIJ matrices. */
2763     ierr = MatCreate(PETSC_COMM_SELF,&b->A);CHKERRQ(ierr);
2764     ierr = MatSetSizes(b->A,B->rmap->n,B->cmap->n,B->rmap->n,B->cmap->n);CHKERRQ(ierr);
2765     ierr = MatSetBlockSizesFromMats(b->A,B,B);CHKERRQ(ierr);
2766     ierr = MatSetType(b->A,MATSEQAIJ);CHKERRQ(ierr);
2767     ierr = PetscLogObjectParent((PetscObject)B,(PetscObject)b->A);CHKERRQ(ierr);
2768     ierr = MatCreate(PETSC_COMM_SELF,&b->B);CHKERRQ(ierr);
2769     ierr = MatSetSizes(b->B,B->rmap->n,B->cmap->N,B->rmap->n,B->cmap->N);CHKERRQ(ierr);
2770     ierr = MatSetBlockSizesFromMats(b->B,B,B);CHKERRQ(ierr);
2771     ierr = MatSetType(b->B,MATSEQAIJ);CHKERRQ(ierr);
2772     ierr = PetscLogObjectParent((PetscObject)B,(PetscObject)b->B);CHKERRQ(ierr);
2773   }
2774 
2775   ierr = MatSeqAIJSetPreallocation(b->A,d_nz,d_nnz);CHKERRQ(ierr);
2776   ierr = MatSeqAIJSetPreallocation(b->B,o_nz,o_nnz);CHKERRQ(ierr);
2777   B->preallocated = PETSC_TRUE;
2778   PetscFunctionReturn(0);
2779 }
2780 
2781 #undef __FUNCT__
2782 #define __FUNCT__ "MatDuplicate_MPIAIJ"
2783 PetscErrorCode MatDuplicate_MPIAIJ(Mat matin,MatDuplicateOption cpvalues,Mat *newmat)
2784 {
2785   Mat            mat;
2786   Mat_MPIAIJ     *a,*oldmat = (Mat_MPIAIJ*)matin->data;
2787   PetscErrorCode ierr;
2788 
2789   PetscFunctionBegin;
2790   *newmat = 0;
2791   ierr    = MatCreate(PetscObjectComm((PetscObject)matin),&mat);CHKERRQ(ierr);
2792   ierr    = MatSetSizes(mat,matin->rmap->n,matin->cmap->n,matin->rmap->N,matin->cmap->N);CHKERRQ(ierr);
2793   ierr    = MatSetBlockSizesFromMats(mat,matin,matin);CHKERRQ(ierr);
2794   ierr    = MatSetType(mat,((PetscObject)matin)->type_name);CHKERRQ(ierr);
2795   ierr    = PetscMemcpy(mat->ops,matin->ops,sizeof(struct _MatOps));CHKERRQ(ierr);
2796   a       = (Mat_MPIAIJ*)mat->data;
2797 
2798   mat->factortype   = matin->factortype;
2799   mat->assembled    = PETSC_TRUE;
2800   mat->insertmode   = NOT_SET_VALUES;
2801   mat->preallocated = PETSC_TRUE;
2802 
2803   a->size         = oldmat->size;
2804   a->rank         = oldmat->rank;
2805   a->donotstash   = oldmat->donotstash;
2806   a->roworiented  = oldmat->roworiented;
2807   a->rowindices   = 0;
2808   a->rowvalues    = 0;
2809   a->getrowactive = PETSC_FALSE;
2810 
2811   ierr = PetscLayoutReference(matin->rmap,&mat->rmap);CHKERRQ(ierr);
2812   ierr = PetscLayoutReference(matin->cmap,&mat->cmap);CHKERRQ(ierr);
2813 
2814   if (oldmat->colmap) {
2815 #if defined(PETSC_USE_CTABLE)
2816     ierr = PetscTableCreateCopy(oldmat->colmap,&a->colmap);CHKERRQ(ierr);
2817 #else
2818     ierr = PetscMalloc1(mat->cmap->N,&a->colmap);CHKERRQ(ierr);
2819     ierr = PetscLogObjectMemory((PetscObject)mat,(mat->cmap->N)*sizeof(PetscInt));CHKERRQ(ierr);
2820     ierr = PetscMemcpy(a->colmap,oldmat->colmap,(mat->cmap->N)*sizeof(PetscInt));CHKERRQ(ierr);
2821 #endif
2822   } else a->colmap = 0;
2823   if (oldmat->garray) {
2824     PetscInt len;
2825     len  = oldmat->B->cmap->n;
2826     ierr = PetscMalloc1(len+1,&a->garray);CHKERRQ(ierr);
2827     ierr = PetscLogObjectMemory((PetscObject)mat,len*sizeof(PetscInt));CHKERRQ(ierr);
2828     if (len) { ierr = PetscMemcpy(a->garray,oldmat->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
2829   } else a->garray = 0;
2830 
2831   ierr    = VecDuplicate(oldmat->lvec,&a->lvec);CHKERRQ(ierr);
2832   ierr    = PetscLogObjectParent((PetscObject)mat,(PetscObject)a->lvec);CHKERRQ(ierr);
2833   ierr    = VecScatterCopy(oldmat->Mvctx,&a->Mvctx);CHKERRQ(ierr);
2834   ierr    = PetscLogObjectParent((PetscObject)mat,(PetscObject)a->Mvctx);CHKERRQ(ierr);
2835   ierr    = MatDuplicate(oldmat->A,cpvalues,&a->A);CHKERRQ(ierr);
2836   ierr    = PetscLogObjectParent((PetscObject)mat,(PetscObject)a->A);CHKERRQ(ierr);
2837   ierr    = MatDuplicate(oldmat->B,cpvalues,&a->B);CHKERRQ(ierr);
2838   ierr    = PetscLogObjectParent((PetscObject)mat,(PetscObject)a->B);CHKERRQ(ierr);
2839   ierr    = PetscFunctionListDuplicate(((PetscObject)matin)->qlist,&((PetscObject)mat)->qlist);CHKERRQ(ierr);
2840   *newmat = mat;
2841   PetscFunctionReturn(0);
2842 }
2843 
2844 
2845 
2846 #undef __FUNCT__
2847 #define __FUNCT__ "MatLoad_MPIAIJ"
2848 PetscErrorCode MatLoad_MPIAIJ(Mat newMat, PetscViewer viewer)
2849 {
2850   PetscScalar    *vals,*svals;
2851   MPI_Comm       comm;
2852   PetscErrorCode ierr;
2853   PetscMPIInt    rank,size,tag = ((PetscObject)viewer)->tag;
2854   PetscInt       i,nz,j,rstart,rend,mmax,maxnz = 0;
2855   PetscInt       header[4],*rowlengths = 0,M,N,m,*cols;
2856   PetscInt       *ourlens = NULL,*procsnz = NULL,*offlens = NULL,jj,*mycols,*smycols;
2857   PetscInt       cend,cstart,n,*rowners;
2858   int            fd;
2859   PetscInt       bs = newMat->rmap->bs;
2860 
2861   PetscFunctionBegin;
2862   /* force binary viewer to load .info file if it has not yet done so */
2863   ierr = PetscViewerSetUp(viewer);CHKERRQ(ierr);
2864   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
2865   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
2866   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
2867   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
2868   if (!rank) {
2869     ierr = PetscBinaryRead(fd,(char*)header,4,PETSC_INT);CHKERRQ(ierr);
2870     if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"not matrix object");
2871   }
2872 
2873   ierr = PetscOptionsBegin(comm,NULL,"Options for loading MPIAIJ matrix","Mat");CHKERRQ(ierr);
2874   ierr = PetscOptionsInt("-matload_block_size","Set the blocksize used to store the matrix","MatLoad",bs,&bs,NULL);CHKERRQ(ierr);
2875   ierr = PetscOptionsEnd();CHKERRQ(ierr);
2876   if (bs < 0) bs = 1;
2877 
2878   ierr = MPI_Bcast(header+1,3,MPIU_INT,0,comm);CHKERRQ(ierr);
2879   M    = header[1]; N = header[2];
2880 
2881   /* If global sizes are set, check if they are consistent with that given in the file */
2882   if (newMat->rmap->N >= 0 && newMat->rmap->N != M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Inconsistent # of rows:Matrix in file has (%D) and input matrix has (%D)",newMat->rmap->N,M);
2883   if (newMat->cmap->N >=0 && newMat->cmap->N != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Inconsistent # of cols:Matrix in file has (%D) and input matrix has (%D)",newMat->cmap->N,N);
2884 
2885   /* determine ownership of all (block) rows */
2886   if (M%bs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Inconsistent # of rows (%d) and block size (%d)",M,bs);
2887   if (newMat->rmap->n < 0) m = bs*((M/bs)/size + (((M/bs) % size) > rank));    /* PETSC_DECIDE */
2888   else m = newMat->rmap->n; /* Set by user */
2889 
2890   ierr = PetscMalloc1(size+1,&rowners);CHKERRQ(ierr);
2891   ierr = MPI_Allgather(&m,1,MPIU_INT,rowners+1,1,MPIU_INT,comm);CHKERRQ(ierr);
2892 
2893   /* First process needs enough room for process with most rows */
2894   if (!rank) {
2895     mmax = rowners[1];
2896     for (i=2; i<=size; i++) {
2897       mmax = PetscMax(mmax, rowners[i]);
2898     }
2899   } else mmax = -1;             /* unused, but compilers complain */
2900 
2901   rowners[0] = 0;
2902   for (i=2; i<=size; i++) {
2903     rowners[i] += rowners[i-1];
2904   }
2905   rstart = rowners[rank];
2906   rend   = rowners[rank+1];
2907 
2908   /* distribute row lengths to all processors */
2909   ierr = PetscMalloc2(m,&ourlens,m,&offlens);CHKERRQ(ierr);
2910   if (!rank) {
2911     ierr = PetscBinaryRead(fd,ourlens,m,PETSC_INT);CHKERRQ(ierr);
2912     ierr = PetscMalloc1(mmax,&rowlengths);CHKERRQ(ierr);
2913     ierr = PetscCalloc1(size,&procsnz);CHKERRQ(ierr);
2914     for (j=0; j<m; j++) {
2915       procsnz[0] += ourlens[j];
2916     }
2917     for (i=1; i<size; i++) {
2918       ierr = PetscBinaryRead(fd,rowlengths,rowners[i+1]-rowners[i],PETSC_INT);CHKERRQ(ierr);
2919       /* calculate the number of nonzeros on each processor */
2920       for (j=0; j<rowners[i+1]-rowners[i]; j++) {
2921         procsnz[i] += rowlengths[j];
2922       }
2923       ierr = MPIULong_Send(rowlengths,rowners[i+1]-rowners[i],MPIU_INT,i,tag,comm);CHKERRQ(ierr);
2924     }
2925     ierr = PetscFree(rowlengths);CHKERRQ(ierr);
2926   } else {
2927     ierr = MPIULong_Recv(ourlens,m,MPIU_INT,0,tag,comm);CHKERRQ(ierr);
2928   }
2929 
2930   if (!rank) {
2931     /* determine max buffer needed and allocate it */
2932     maxnz = 0;
2933     for (i=0; i<size; i++) {
2934       maxnz = PetscMax(maxnz,procsnz[i]);
2935     }
2936     ierr = PetscMalloc1(maxnz,&cols);CHKERRQ(ierr);
2937 
2938     /* read in my part of the matrix column indices  */
2939     nz   = procsnz[0];
2940     ierr = PetscMalloc1(nz,&mycols);CHKERRQ(ierr);
2941     ierr = PetscBinaryRead(fd,mycols,nz,PETSC_INT);CHKERRQ(ierr);
2942 
2943     /* read in every one elses and ship off */
2944     for (i=1; i<size; i++) {
2945       nz   = procsnz[i];
2946       ierr = PetscBinaryRead(fd,cols,nz,PETSC_INT);CHKERRQ(ierr);
2947       ierr = MPIULong_Send(cols,nz,MPIU_INT,i,tag,comm);CHKERRQ(ierr);
2948     }
2949     ierr = PetscFree(cols);CHKERRQ(ierr);
2950   } else {
2951     /* determine buffer space needed for message */
2952     nz = 0;
2953     for (i=0; i<m; i++) {
2954       nz += ourlens[i];
2955     }
2956     ierr = PetscMalloc1(nz,&mycols);CHKERRQ(ierr);
2957 
2958     /* receive message of column indices*/
2959     ierr = MPIULong_Recv(mycols,nz,MPIU_INT,0,tag,comm);CHKERRQ(ierr);
2960   }
2961 
2962   /* determine column ownership if matrix is not square */
2963   if (N != M) {
2964     if (newMat->cmap->n < 0) n = N/size + ((N % size) > rank);
2965     else n = newMat->cmap->n;
2966     ierr   = MPI_Scan(&n,&cend,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
2967     cstart = cend - n;
2968   } else {
2969     cstart = rstart;
2970     cend   = rend;
2971     n      = cend - cstart;
2972   }
2973 
2974   /* loop over local rows, determining number of off diagonal entries */
2975   ierr = PetscMemzero(offlens,m*sizeof(PetscInt));CHKERRQ(ierr);
2976   jj   = 0;
2977   for (i=0; i<m; i++) {
2978     for (j=0; j<ourlens[i]; j++) {
2979       if (mycols[jj] < cstart || mycols[jj] >= cend) offlens[i]++;
2980       jj++;
2981     }
2982   }
2983 
2984   for (i=0; i<m; i++) {
2985     ourlens[i] -= offlens[i];
2986   }
2987   ierr = MatSetSizes(newMat,m,n,M,N);CHKERRQ(ierr);
2988 
2989   if (bs > 1) {ierr = MatSetBlockSize(newMat,bs);CHKERRQ(ierr);}
2990 
2991   ierr = MatMPIAIJSetPreallocation(newMat,0,ourlens,0,offlens);CHKERRQ(ierr);
2992 
2993   for (i=0; i<m; i++) {
2994     ourlens[i] += offlens[i];
2995   }
2996 
2997   if (!rank) {
2998     ierr = PetscMalloc1(maxnz+1,&vals);CHKERRQ(ierr);
2999 
3000     /* read in my part of the matrix numerical values  */
3001     nz   = procsnz[0];
3002     ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);CHKERRQ(ierr);
3003 
3004     /* insert into matrix */
3005     jj      = rstart;
3006     smycols = mycols;
3007     svals   = vals;
3008     for (i=0; i<m; i++) {
3009       ierr     = MatSetValues_MPIAIJ(newMat,1,&jj,ourlens[i],smycols,svals,INSERT_VALUES);CHKERRQ(ierr);
3010       smycols += ourlens[i];
3011       svals   += ourlens[i];
3012       jj++;
3013     }
3014 
3015     /* read in other processors and ship out */
3016     for (i=1; i<size; i++) {
3017       nz   = procsnz[i];
3018       ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);CHKERRQ(ierr);
3019       ierr = MPIULong_Send(vals,nz,MPIU_SCALAR,i,((PetscObject)newMat)->tag,comm);CHKERRQ(ierr);
3020     }
3021     ierr = PetscFree(procsnz);CHKERRQ(ierr);
3022   } else {
3023     /* receive numeric values */
3024     ierr = PetscMalloc1(nz+1,&vals);CHKERRQ(ierr);
3025 
3026     /* receive message of values*/
3027     ierr = MPIULong_Recv(vals,nz,MPIU_SCALAR,0,((PetscObject)newMat)->tag,comm);CHKERRQ(ierr);
3028 
3029     /* insert into matrix */
3030     jj      = rstart;
3031     smycols = mycols;
3032     svals   = vals;
3033     for (i=0; i<m; i++) {
3034       ierr     = MatSetValues_MPIAIJ(newMat,1,&jj,ourlens[i],smycols,svals,INSERT_VALUES);CHKERRQ(ierr);
3035       smycols += ourlens[i];
3036       svals   += ourlens[i];
3037       jj++;
3038     }
3039   }
3040   ierr = PetscFree2(ourlens,offlens);CHKERRQ(ierr);
3041   ierr = PetscFree(vals);CHKERRQ(ierr);
3042   ierr = PetscFree(mycols);CHKERRQ(ierr);
3043   ierr = PetscFree(rowners);CHKERRQ(ierr);
3044   ierr = MatAssemblyBegin(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3045   ierr = MatAssemblyEnd(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3046   PetscFunctionReturn(0);
3047 }
3048 
3049 #undef __FUNCT__
3050 #define __FUNCT__ "MatGetSubMatrix_MPIAIJ"
3051 /* TODO: Not scalable because of ISAllGather() unless getting all columns. */
3052 PetscErrorCode MatGetSubMatrix_MPIAIJ(Mat mat,IS isrow,IS iscol,MatReuse call,Mat *newmat)
3053 {
3054   PetscErrorCode ierr;
3055   IS             iscol_local;
3056   PetscInt       csize;
3057 
3058   PetscFunctionBegin;
3059   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
3060   if (call == MAT_REUSE_MATRIX) {
3061     ierr = PetscObjectQuery((PetscObject)*newmat,"ISAllGather",(PetscObject*)&iscol_local);CHKERRQ(ierr);
3062     if (!iscol_local) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Submatrix passed in was not used before, cannot reuse");
3063   } else {
3064     /* check if we are grabbing all columns*/
3065     PetscBool    isstride;
3066     PetscMPIInt  lisstride = 0,gisstride;
3067     ierr = PetscObjectTypeCompare((PetscObject)iscol,ISSTRIDE,&isstride);CHKERRQ(ierr);
3068     if (isstride) {
3069       PetscInt  start,len,mstart,mlen;
3070       ierr = ISStrideGetInfo(iscol,&start,NULL);CHKERRQ(ierr);
3071       ierr = ISGetLocalSize(iscol,&len);CHKERRQ(ierr);
3072       ierr = MatGetOwnershipRangeColumn(mat,&mstart,&mlen);CHKERRQ(ierr);
3073       if (mstart == start && mlen-mstart == len) lisstride = 1;
3074     }
3075     ierr = MPIU_Allreduce(&lisstride,&gisstride,1,MPI_INT,MPI_MIN,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
3076     if (gisstride) {
3077       PetscInt N;
3078       ierr = MatGetSize(mat,NULL,&N);CHKERRQ(ierr);
3079       ierr = ISCreateStride(PetscObjectComm((PetscObject)mat),N,0,1,&iscol_local);CHKERRQ(ierr);
3080       ierr = ISSetIdentity(iscol_local);CHKERRQ(ierr);
3081       ierr = PetscInfo(mat,"Optimizing for obtaining all columns of the matrix; skipping ISAllGather()\n");CHKERRQ(ierr);
3082     } else {
3083       PetscInt cbs;
3084       ierr = ISGetBlockSize(iscol,&cbs);CHKERRQ(ierr);
3085       ierr = ISAllGather(iscol,&iscol_local);CHKERRQ(ierr);
3086       ierr = ISSetBlockSize(iscol_local,cbs);CHKERRQ(ierr);
3087     }
3088   }
3089   ierr = MatGetSubMatrix_MPIAIJ_Private(mat,isrow,iscol_local,csize,call,newmat);CHKERRQ(ierr);
3090   if (call == MAT_INITIAL_MATRIX) {
3091     ierr = PetscObjectCompose((PetscObject)*newmat,"ISAllGather",(PetscObject)iscol_local);CHKERRQ(ierr);
3092     ierr = ISDestroy(&iscol_local);CHKERRQ(ierr);
3093   }
3094   PetscFunctionReturn(0);
3095 }
3096 
3097 extern PetscErrorCode MatGetSubMatrices_MPIAIJ_Local(Mat,PetscInt,const IS[],const IS[],MatReuse,PetscBool*,Mat*);
3098 #undef __FUNCT__
3099 #define __FUNCT__ "MatGetSubMatrix_MPIAIJ_Private"
3100 /*
3101     Not great since it makes two copies of the submatrix, first an SeqAIJ
3102   in local and then by concatenating the local matrices the end result.
3103   Writing it directly would be much like MatGetSubMatrices_MPIAIJ()
3104 
3105   Note: This requires a sequential iscol with all indices.
3106 */
3107 PetscErrorCode MatGetSubMatrix_MPIAIJ_Private(Mat mat,IS isrow,IS iscol,PetscInt csize,MatReuse call,Mat *newmat)
3108 {
3109   PetscErrorCode ierr;
3110   PetscMPIInt    rank,size;
3111   PetscInt       i,m,n,rstart,row,rend,nz,*cwork,j,bs,cbs;
3112   PetscInt       *ii,*jj,nlocal,*dlens,*olens,dlen,olen,jend,mglobal,ncol;
3113   PetscBool      allcolumns, colflag;
3114   Mat            M,Mreuse;
3115   MatScalar      *vwork,*aa;
3116   MPI_Comm       comm;
3117   Mat_SeqAIJ     *aij;
3118 
3119   PetscFunctionBegin;
3120   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3121   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
3122   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
3123 
3124   ierr = ISIdentity(iscol,&colflag);CHKERRQ(ierr);
3125   ierr = ISGetLocalSize(iscol,&ncol);CHKERRQ(ierr);
3126   if (colflag && ncol == mat->cmap->N) {
3127     allcolumns = PETSC_TRUE;
3128     ierr = PetscInfo(mat,"Optimizing for obtaining all columns of the matrix\n");CHKERRQ(ierr);
3129   } else {
3130     allcolumns = PETSC_FALSE;
3131   }
3132   if (call ==  MAT_REUSE_MATRIX) {
3133     ierr = PetscObjectQuery((PetscObject)*newmat,"SubMatrix",(PetscObject*)&Mreuse);CHKERRQ(ierr);
3134     if (!Mreuse) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Submatrix passed in was not used before, cannot reuse");
3135     ierr = MatGetSubMatrices_MPIAIJ_Local(mat,1,&isrow,&iscol,MAT_REUSE_MATRIX,&allcolumns,&Mreuse);CHKERRQ(ierr);
3136   } else {
3137     ierr = MatGetSubMatrices_MPIAIJ_Local(mat,1,&isrow,&iscol,MAT_INITIAL_MATRIX,&allcolumns,&Mreuse);CHKERRQ(ierr);
3138   }
3139 
3140   /*
3141       m - number of local rows
3142       n - number of columns (same on all processors)
3143       rstart - first row in new global matrix generated
3144   */
3145   ierr = MatGetSize(Mreuse,&m,&n);CHKERRQ(ierr);
3146   ierr = MatGetBlockSizes(Mreuse,&bs,&cbs);CHKERRQ(ierr);
3147   if (call == MAT_INITIAL_MATRIX) {
3148     aij = (Mat_SeqAIJ*)(Mreuse)->data;
3149     ii  = aij->i;
3150     jj  = aij->j;
3151 
3152     /*
3153         Determine the number of non-zeros in the diagonal and off-diagonal
3154         portions of the matrix in order to do correct preallocation
3155     */
3156 
3157     /* first get start and end of "diagonal" columns */
3158     if (csize == PETSC_DECIDE) {
3159       ierr = ISGetSize(isrow,&mglobal);CHKERRQ(ierr);
3160       if (mglobal == n) { /* square matrix */
3161         nlocal = m;
3162       } else {
3163         nlocal = n/size + ((n % size) > rank);
3164       }
3165     } else {
3166       nlocal = csize;
3167     }
3168     ierr   = MPI_Scan(&nlocal,&rend,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
3169     rstart = rend - nlocal;
3170     if (rank == size - 1 && rend != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local column sizes %D do not add up to total number of columns %D",rend,n);
3171 
3172     /* next, compute all the lengths */
3173     ierr  = PetscMalloc1(2*m+1,&dlens);CHKERRQ(ierr);
3174     olens = dlens + m;
3175     for (i=0; i<m; i++) {
3176       jend = ii[i+1] - ii[i];
3177       olen = 0;
3178       dlen = 0;
3179       for (j=0; j<jend; j++) {
3180         if (*jj < rstart || *jj >= rend) olen++;
3181         else dlen++;
3182         jj++;
3183       }
3184       olens[i] = olen;
3185       dlens[i] = dlen;
3186     }
3187     ierr = MatCreate(comm,&M);CHKERRQ(ierr);
3188     ierr = MatSetSizes(M,m,nlocal,PETSC_DECIDE,n);CHKERRQ(ierr);
3189     ierr = MatSetBlockSizes(M,bs,cbs);CHKERRQ(ierr);
3190     ierr = MatSetType(M,((PetscObject)mat)->type_name);CHKERRQ(ierr);
3191     ierr = MatMPIAIJSetPreallocation(M,0,dlens,0,olens);CHKERRQ(ierr);
3192     ierr = PetscFree(dlens);CHKERRQ(ierr);
3193   } else {
3194     PetscInt ml,nl;
3195 
3196     M    = *newmat;
3197     ierr = MatGetLocalSize(M,&ml,&nl);CHKERRQ(ierr);
3198     if (ml != m) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Previous matrix must be same size/layout as request");
3199     ierr = MatZeroEntries(M);CHKERRQ(ierr);
3200     /*
3201          The next two lines are needed so we may call MatSetValues_MPIAIJ() below directly,
3202        rather than the slower MatSetValues().
3203     */
3204     M->was_assembled = PETSC_TRUE;
3205     M->assembled     = PETSC_FALSE;
3206   }
3207   ierr = MatGetOwnershipRange(M,&rstart,&rend);CHKERRQ(ierr);
3208   aij  = (Mat_SeqAIJ*)(Mreuse)->data;
3209   ii   = aij->i;
3210   jj   = aij->j;
3211   aa   = aij->a;
3212   for (i=0; i<m; i++) {
3213     row   = rstart + i;
3214     nz    = ii[i+1] - ii[i];
3215     cwork = jj;     jj += nz;
3216     vwork = aa;     aa += nz;
3217     ierr  = MatSetValues_MPIAIJ(M,1,&row,nz,cwork,vwork,INSERT_VALUES);CHKERRQ(ierr);
3218   }
3219 
3220   ierr    = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3221   ierr    = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3222   *newmat = M;
3223 
3224   /* save submatrix used in processor for next request */
3225   if (call ==  MAT_INITIAL_MATRIX) {
3226     ierr = PetscObjectCompose((PetscObject)M,"SubMatrix",(PetscObject)Mreuse);CHKERRQ(ierr);
3227     ierr = MatDestroy(&Mreuse);CHKERRQ(ierr);
3228   }
3229   PetscFunctionReturn(0);
3230 }
3231 
3232 #undef __FUNCT__
3233 #define __FUNCT__ "MatMPIAIJSetPreallocationCSR_MPIAIJ"
3234 PetscErrorCode  MatMPIAIJSetPreallocationCSR_MPIAIJ(Mat B,const PetscInt Ii[],const PetscInt J[],const PetscScalar v[])
3235 {
3236   PetscInt       m,cstart, cend,j,nnz,i,d;
3237   PetscInt       *d_nnz,*o_nnz,nnz_max = 0,rstart,ii;
3238   const PetscInt *JJ;
3239   PetscScalar    *values;
3240   PetscErrorCode ierr;
3241 
3242   PetscFunctionBegin;
3243   if (Ii[0]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Ii[0] must be 0 it is %D",Ii[0]);
3244 
3245   ierr   = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
3246   ierr   = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
3247   m      = B->rmap->n;
3248   cstart = B->cmap->rstart;
3249   cend   = B->cmap->rend;
3250   rstart = B->rmap->rstart;
3251 
3252   ierr = PetscMalloc2(m,&d_nnz,m,&o_nnz);CHKERRQ(ierr);
3253 
3254 #if defined(PETSC_USE_DEBUGGING)
3255   for (i=0; i<m; i++) {
3256     nnz = Ii[i+1]- Ii[i];
3257     JJ  = J + Ii[i];
3258     if (nnz < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local row %D has a negative %D number of columns",i,nnz);
3259     if (nnz && (JJ[0] < 0)) SETERRRQ1(PETSC_ERR_ARG_WRONGSTATE,"Row %D starts with negative column index",i,j);
3260     if (nnz && (JJ[nnz-1] >= B->cmap->N) SETERRRQ3(PETSC_ERR_ARG_WRONGSTATE,"Row %D ends with too large a column index %D (max allowed %D)",i,JJ[nnz-1],B->cmap->N);
3261   }
3262 #endif
3263 
3264   for (i=0; i<m; i++) {
3265     nnz     = Ii[i+1]- Ii[i];
3266     JJ      = J + Ii[i];
3267     nnz_max = PetscMax(nnz_max,nnz);
3268     d       = 0;
3269     for (j=0; j<nnz; j++) {
3270       if (cstart <= JJ[j] && JJ[j] < cend) d++;
3271     }
3272     d_nnz[i] = d;
3273     o_nnz[i] = nnz - d;
3274   }
3275   ierr = MatMPIAIJSetPreallocation(B,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
3276   ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
3277 
3278   if (v) values = (PetscScalar*)v;
3279   else {
3280     ierr = PetscCalloc1(nnz_max+1,&values);CHKERRQ(ierr);
3281   }
3282 
3283   for (i=0; i<m; i++) {
3284     ii   = i + rstart;
3285     nnz  = Ii[i+1]- Ii[i];
3286     ierr = MatSetValues_MPIAIJ(B,1,&ii,nnz,J+Ii[i],values+(v ? Ii[i] : 0),INSERT_VALUES);CHKERRQ(ierr);
3287   }
3288   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3289   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3290 
3291   if (!v) {
3292     ierr = PetscFree(values);CHKERRQ(ierr);
3293   }
3294   ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3295   PetscFunctionReturn(0);
3296 }
3297 
3298 #undef __FUNCT__
3299 #define __FUNCT__ "MatMPIAIJSetPreallocationCSR"
3300 /*@
3301    MatMPIAIJSetPreallocationCSR - Allocates memory for a sparse parallel matrix in AIJ format
3302    (the default parallel PETSc format).
3303 
3304    Collective on MPI_Comm
3305 
3306    Input Parameters:
3307 +  B - the matrix
3308 .  i - the indices into j for the start of each local row (starts with zero)
3309 .  j - the column indices for each local row (starts with zero)
3310 -  v - optional values in the matrix
3311 
3312    Level: developer
3313 
3314    Notes:
3315        The i, j, and a arrays ARE copied by this routine into the internal format used by PETSc;
3316      thus you CANNOT change the matrix entries by changing the values of a[] after you have
3317      called this routine. Use MatCreateMPIAIJWithSplitArrays() to avoid needing to copy the arrays.
3318 
3319        The i and j indices are 0 based, and i indices are indices corresponding to the local j array.
3320 
3321        The format which is used for the sparse matrix input, is equivalent to a
3322     row-major ordering.. i.e for the following matrix, the input data expected is
3323     as shown
3324 
3325 $        1 0 0
3326 $        2 0 3     P0
3327 $       -------
3328 $        4 5 6     P1
3329 $
3330 $     Process0 [P0]: rows_owned=[0,1]
3331 $        i =  {0,1,3}  [size = nrow+1  = 2+1]
3332 $        j =  {0,0,2}  [size = 3]
3333 $        v =  {1,2,3}  [size = 3]
3334 $
3335 $     Process1 [P1]: rows_owned=[2]
3336 $        i =  {0,3}    [size = nrow+1  = 1+1]
3337 $        j =  {0,1,2}  [size = 3]
3338 $        v =  {4,5,6}  [size = 3]
3339 
3340 .keywords: matrix, aij, compressed row, sparse, parallel
3341 
3342 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatMPIAIJSetPreallocation(), MatCreateAIJ(), MPIAIJ,
3343           MatCreateSeqAIJWithArrays(), MatCreateMPIAIJWithSplitArrays()
3344 @*/
3345 PetscErrorCode  MatMPIAIJSetPreallocationCSR(Mat B,const PetscInt i[],const PetscInt j[], const PetscScalar v[])
3346 {
3347   PetscErrorCode ierr;
3348 
3349   PetscFunctionBegin;
3350   ierr = PetscTryMethod(B,"MatMPIAIJSetPreallocationCSR_C",(Mat,const PetscInt[],const PetscInt[],const PetscScalar[]),(B,i,j,v));CHKERRQ(ierr);
3351   PetscFunctionReturn(0);
3352 }
3353 
3354 #undef __FUNCT__
3355 #define __FUNCT__ "MatMPIAIJSetPreallocation"
3356 /*@C
3357    MatMPIAIJSetPreallocation - Preallocates memory for a sparse parallel matrix in AIJ format
3358    (the default parallel PETSc format).  For good matrix assembly performance
3359    the user should preallocate the matrix storage by setting the parameters
3360    d_nz (or d_nnz) and o_nz (or o_nnz).  By setting these parameters accurately,
3361    performance can be increased by more than a factor of 50.
3362 
3363    Collective on MPI_Comm
3364 
3365    Input Parameters:
3366 +  B - the matrix
3367 .  d_nz  - number of nonzeros per row in DIAGONAL portion of local submatrix
3368            (same value is used for all local rows)
3369 .  d_nnz - array containing the number of nonzeros in the various rows of the
3370            DIAGONAL portion of the local submatrix (possibly different for each row)
3371            or NULL (PETSC_NULL_INTEGER in Fortran), if d_nz is used to specify the nonzero structure.
3372            The size of this array is equal to the number of local rows, i.e 'm'.
3373            For matrices that will be factored, you must leave room for (and set)
3374            the diagonal entry even if it is zero.
3375 .  o_nz  - number of nonzeros per row in the OFF-DIAGONAL portion of local
3376            submatrix (same value is used for all local rows).
3377 -  o_nnz - array containing the number of nonzeros in the various rows of the
3378            OFF-DIAGONAL portion of the local submatrix (possibly different for
3379            each row) or NULL (PETSC_NULL_INTEGER in Fortran), if o_nz is used to specify the nonzero
3380            structure. The size of this array is equal to the number
3381            of local rows, i.e 'm'.
3382 
3383    If the *_nnz parameter is given then the *_nz parameter is ignored
3384 
3385    The AIJ format (also called the Yale sparse matrix format or
3386    compressed row storage (CSR)), is fully compatible with standard Fortran 77
3387    storage.  The stored row and column indices begin with zero.
3388    See Users-Manual: ch_mat for details.
3389 
3390    The parallel matrix is partitioned such that the first m0 rows belong to
3391    process 0, the next m1 rows belong to process 1, the next m2 rows belong
3392    to process 2 etc.. where m0,m1,m2... are the input parameter 'm'.
3393 
3394    The DIAGONAL portion of the local submatrix of a processor can be defined
3395    as the submatrix which is obtained by extraction the part corresponding to
3396    the rows r1-r2 and columns c1-c2 of the global matrix, where r1 is the
3397    first row that belongs to the processor, r2 is the last row belonging to
3398    the this processor, and c1-c2 is range of indices of the local part of a
3399    vector suitable for applying the matrix to.  This is an mxn matrix.  In the
3400    common case of a square matrix, the row and column ranges are the same and
3401    the DIAGONAL part is also square. The remaining portion of the local
3402    submatrix (mxN) constitute the OFF-DIAGONAL portion.
3403 
3404    If o_nnz, d_nnz are specified, then o_nz, and d_nz are ignored.
3405 
3406    You can call MatGetInfo() to get information on how effective the preallocation was;
3407    for example the fields mallocs,nz_allocated,nz_used,nz_unneeded;
3408    You can also run with the option -info and look for messages with the string
3409    malloc in them to see if additional memory allocation was needed.
3410 
3411    Example usage:
3412 
3413    Consider the following 8x8 matrix with 34 non-zero values, that is
3414    assembled across 3 processors. Lets assume that proc0 owns 3 rows,
3415    proc1 owns 3 rows, proc2 owns 2 rows. This division can be shown
3416    as follows:
3417 
3418 .vb
3419             1  2  0  |  0  3  0  |  0  4
3420     Proc0   0  5  6  |  7  0  0  |  8  0
3421             9  0 10  | 11  0  0  | 12  0
3422     -------------------------------------
3423            13  0 14  | 15 16 17  |  0  0
3424     Proc1   0 18  0  | 19 20 21  |  0  0
3425             0  0  0  | 22 23  0  | 24  0
3426     -------------------------------------
3427     Proc2  25 26 27  |  0  0 28  | 29  0
3428            30  0  0  | 31 32 33  |  0 34
3429 .ve
3430 
3431    This can be represented as a collection of submatrices as:
3432 
3433 .vb
3434       A B C
3435       D E F
3436       G H I
3437 .ve
3438 
3439    Where the submatrices A,B,C are owned by proc0, D,E,F are
3440    owned by proc1, G,H,I are owned by proc2.
3441 
3442    The 'm' parameters for proc0,proc1,proc2 are 3,3,2 respectively.
3443    The 'n' parameters for proc0,proc1,proc2 are 3,3,2 respectively.
3444    The 'M','N' parameters are 8,8, and have the same values on all procs.
3445 
3446    The DIAGONAL submatrices corresponding to proc0,proc1,proc2 are
3447    submatrices [A], [E], [I] respectively. The OFF-DIAGONAL submatrices
3448    corresponding to proc0,proc1,proc2 are [BC], [DF], [GH] respectively.
3449    Internally, each processor stores the DIAGONAL part, and the OFF-DIAGONAL
3450    part as SeqAIJ matrices. for eg: proc1 will store [E] as a SeqAIJ
3451    matrix, ans [DF] as another SeqAIJ matrix.
3452 
3453    When d_nz, o_nz parameters are specified, d_nz storage elements are
3454    allocated for every row of the local diagonal submatrix, and o_nz
3455    storage locations are allocated for every row of the OFF-DIAGONAL submat.
3456    One way to choose d_nz and o_nz is to use the max nonzerors per local
3457    rows for each of the local DIAGONAL, and the OFF-DIAGONAL submatrices.
3458    In this case, the values of d_nz,o_nz are:
3459 .vb
3460      proc0 : dnz = 2, o_nz = 2
3461      proc1 : dnz = 3, o_nz = 2
3462      proc2 : dnz = 1, o_nz = 4
3463 .ve
3464    We are allocating m*(d_nz+o_nz) storage locations for every proc. This
3465    translates to 3*(2+2)=12 for proc0, 3*(3+2)=15 for proc1, 2*(1+4)=10
3466    for proc3. i.e we are using 12+15+10=37 storage locations to store
3467    34 values.
3468 
3469    When d_nnz, o_nnz parameters are specified, the storage is specified
3470    for every row, coresponding to both DIAGONAL and OFF-DIAGONAL submatrices.
3471    In the above case the values for d_nnz,o_nnz are:
3472 .vb
3473      proc0: d_nnz = [2,2,2] and o_nnz = [2,2,2]
3474      proc1: d_nnz = [3,3,2] and o_nnz = [2,1,1]
3475      proc2: d_nnz = [1,1]   and o_nnz = [4,4]
3476 .ve
3477    Here the space allocated is sum of all the above values i.e 34, and
3478    hence pre-allocation is perfect.
3479 
3480    Level: intermediate
3481 
3482 .keywords: matrix, aij, compressed row, sparse, parallel
3483 
3484 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatCreateAIJ(), MatMPIAIJSetPreallocationCSR(),
3485           MPIAIJ, MatGetInfo(), PetscSplitOwnership()
3486 @*/
3487 PetscErrorCode  MatMPIAIJSetPreallocation(Mat B,PetscInt d_nz,const PetscInt d_nnz[],PetscInt o_nz,const PetscInt o_nnz[])
3488 {
3489   PetscErrorCode ierr;
3490 
3491   PetscFunctionBegin;
3492   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
3493   PetscValidType(B,1);
3494   ierr = PetscTryMethod(B,"MatMPIAIJSetPreallocation_C",(Mat,PetscInt,const PetscInt[],PetscInt,const PetscInt[]),(B,d_nz,d_nnz,o_nz,o_nnz));CHKERRQ(ierr);
3495   PetscFunctionReturn(0);
3496 }
3497 
3498 #undef __FUNCT__
3499 #define __FUNCT__ "MatCreateMPIAIJWithArrays"
3500 /*@
3501      MatCreateMPIAIJWithArrays - creates a MPI AIJ matrix using arrays that contain in standard
3502          CSR format the local rows.
3503 
3504    Collective on MPI_Comm
3505 
3506    Input Parameters:
3507 +  comm - MPI communicator
3508 .  m - number of local rows (Cannot be PETSC_DECIDE)
3509 .  n - This value should be the same as the local size used in creating the
3510        x vector for the matrix-vector product y = Ax. (or PETSC_DECIDE to have
3511        calculated if N is given) For square matrices n is almost always m.
3512 .  M - number of global rows (or PETSC_DETERMINE to have calculated if m is given)
3513 .  N - number of global columns (or PETSC_DETERMINE to have calculated if n is given)
3514 .   i - row indices
3515 .   j - column indices
3516 -   a - matrix values
3517 
3518    Output Parameter:
3519 .   mat - the matrix
3520 
3521    Level: intermediate
3522 
3523    Notes:
3524        The i, j, and a arrays ARE copied by this routine into the internal format used by PETSc;
3525      thus you CANNOT change the matrix entries by changing the values of a[] after you have
3526      called this routine. Use MatCreateMPIAIJWithSplitArrays() to avoid needing to copy the arrays.
3527 
3528        The i and j indices are 0 based, and i indices are indices corresponding to the local j array.
3529 
3530        The format which is used for the sparse matrix input, is equivalent to a
3531     row-major ordering.. i.e for the following matrix, the input data expected is
3532     as shown
3533 
3534 $        1 0 0
3535 $        2 0 3     P0
3536 $       -------
3537 $        4 5 6     P1
3538 $
3539 $     Process0 [P0]: rows_owned=[0,1]
3540 $        i =  {0,1,3}  [size = nrow+1  = 2+1]
3541 $        j =  {0,0,2}  [size = 3]
3542 $        v =  {1,2,3}  [size = 3]
3543 $
3544 $     Process1 [P1]: rows_owned=[2]
3545 $        i =  {0,3}    [size = nrow+1  = 1+1]
3546 $        j =  {0,1,2}  [size = 3]
3547 $        v =  {4,5,6}  [size = 3]
3548 
3549 .keywords: matrix, aij, compressed row, sparse, parallel
3550 
3551 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatMPIAIJSetPreallocation(), MatMPIAIJSetPreallocationCSR(),
3552           MPIAIJ, MatCreateAIJ(), MatCreateMPIAIJWithSplitArrays()
3553 @*/
3554 PetscErrorCode  MatCreateMPIAIJWithArrays(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,const PetscInt i[],const PetscInt j[],const PetscScalar a[],Mat *mat)
3555 {
3556   PetscErrorCode ierr;
3557 
3558   PetscFunctionBegin;
3559   if (i[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i (row indices) must start with 0");
3560   if (m < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"local number of rows (m) cannot be PETSC_DECIDE, or negative");
3561   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
3562   ierr = MatSetSizes(*mat,m,n,M,N);CHKERRQ(ierr);
3563   /* ierr = MatSetBlockSizes(M,bs,cbs);CHKERRQ(ierr); */
3564   ierr = MatSetType(*mat,MATMPIAIJ);CHKERRQ(ierr);
3565   ierr = MatMPIAIJSetPreallocationCSR(*mat,i,j,a);CHKERRQ(ierr);
3566   PetscFunctionReturn(0);
3567 }
3568 
3569 #undef __FUNCT__
3570 #define __FUNCT__ "MatCreateAIJ"
3571 /*@C
3572    MatCreateAIJ - Creates a sparse parallel matrix in AIJ format
3573    (the default parallel PETSc format).  For good matrix assembly performance
3574    the user should preallocate the matrix storage by setting the parameters
3575    d_nz (or d_nnz) and o_nz (or o_nnz).  By setting these parameters accurately,
3576    performance can be increased by more than a factor of 50.
3577 
3578    Collective on MPI_Comm
3579 
3580    Input Parameters:
3581 +  comm - MPI communicator
3582 .  m - number of local rows (or PETSC_DECIDE to have calculated if M is given)
3583            This value should be the same as the local size used in creating the
3584            y vector for the matrix-vector product y = Ax.
3585 .  n - This value should be the same as the local size used in creating the
3586        x vector for the matrix-vector product y = Ax. (or PETSC_DECIDE to have
3587        calculated if N is given) For square matrices n is almost always m.
3588 .  M - number of global rows (or PETSC_DETERMINE to have calculated if m is given)
3589 .  N - number of global columns (or PETSC_DETERMINE to have calculated if n is given)
3590 .  d_nz  - number of nonzeros per row in DIAGONAL portion of local submatrix
3591            (same value is used for all local rows)
3592 .  d_nnz - array containing the number of nonzeros in the various rows of the
3593            DIAGONAL portion of the local submatrix (possibly different for each row)
3594            or NULL, if d_nz is used to specify the nonzero structure.
3595            The size of this array is equal to the number of local rows, i.e 'm'.
3596 .  o_nz  - number of nonzeros per row in the OFF-DIAGONAL portion of local
3597            submatrix (same value is used for all local rows).
3598 -  o_nnz - array containing the number of nonzeros in the various rows of the
3599            OFF-DIAGONAL portion of the local submatrix (possibly different for
3600            each row) or NULL, if o_nz is used to specify the nonzero
3601            structure. The size of this array is equal to the number
3602            of local rows, i.e 'm'.
3603 
3604    Output Parameter:
3605 .  A - the matrix
3606 
3607    It is recommended that one use the MatCreate(), MatSetType() and/or MatSetFromOptions(),
3608    MatXXXXSetPreallocation() paradgm instead of this routine directly.
3609    [MatXXXXSetPreallocation() is, for example, MatSeqAIJSetPreallocation]
3610 
3611    Notes:
3612    If the *_nnz parameter is given then the *_nz parameter is ignored
3613 
3614    m,n,M,N parameters specify the size of the matrix, and its partitioning across
3615    processors, while d_nz,d_nnz,o_nz,o_nnz parameters specify the approximate
3616    storage requirements for this matrix.
3617 
3618    If PETSC_DECIDE or  PETSC_DETERMINE is used for a particular argument on one
3619    processor than it must be used on all processors that share the object for
3620    that argument.
3621 
3622    The user MUST specify either the local or global matrix dimensions
3623    (possibly both).
3624 
3625    The parallel matrix is partitioned across processors such that the
3626    first m0 rows belong to process 0, the next m1 rows belong to
3627    process 1, the next m2 rows belong to process 2 etc.. where
3628    m0,m1,m2,.. are the input parameter 'm'. i.e each processor stores
3629    values corresponding to [m x N] submatrix.
3630 
3631    The columns are logically partitioned with the n0 columns belonging
3632    to 0th partition, the next n1 columns belonging to the next
3633    partition etc.. where n0,n1,n2... are the input parameter 'n'.
3634 
3635    The DIAGONAL portion of the local submatrix on any given processor
3636    is the submatrix corresponding to the rows and columns m,n
3637    corresponding to the given processor. i.e diagonal matrix on
3638    process 0 is [m0 x n0], diagonal matrix on process 1 is [m1 x n1]
3639    etc. The remaining portion of the local submatrix [m x (N-n)]
3640    constitute the OFF-DIAGONAL portion. The example below better
3641    illustrates this concept.
3642 
3643    For a square global matrix we define each processor's diagonal portion
3644    to be its local rows and the corresponding columns (a square submatrix);
3645    each processor's off-diagonal portion encompasses the remainder of the
3646    local matrix (a rectangular submatrix).
3647 
3648    If o_nnz, d_nnz are specified, then o_nz, and d_nz are ignored.
3649 
3650    When calling this routine with a single process communicator, a matrix of
3651    type SEQAIJ is returned.  If a matrix of type MPIAIJ is desired for this
3652    type of communicator, use the construction mechanism:
3653      MatCreate(...,&A); MatSetType(A,MATMPIAIJ); MatSetSizes(A, m,n,M,N); MatMPIAIJSetPreallocation(A,...);
3654 
3655    By default, this format uses inodes (identical nodes) when possible.
3656    We search for consecutive rows with the same nonzero structure, thereby
3657    reusing matrix information to achieve increased efficiency.
3658 
3659    Options Database Keys:
3660 +  -mat_no_inode  - Do not use inodes
3661 .  -mat_inode_limit <limit> - Sets inode limit (max limit=5)
3662 -  -mat_aij_oneindex - Internally use indexing starting at 1
3663         rather than 0.  Note that when calling MatSetValues(),
3664         the user still MUST index entries starting at 0!
3665 
3666 
3667    Example usage:
3668 
3669    Consider the following 8x8 matrix with 34 non-zero values, that is
3670    assembled across 3 processors. Lets assume that proc0 owns 3 rows,
3671    proc1 owns 3 rows, proc2 owns 2 rows. This division can be shown
3672    as follows:
3673 
3674 .vb
3675             1  2  0  |  0  3  0  |  0  4
3676     Proc0   0  5  6  |  7  0  0  |  8  0
3677             9  0 10  | 11  0  0  | 12  0
3678     -------------------------------------
3679            13  0 14  | 15 16 17  |  0  0
3680     Proc1   0 18  0  | 19 20 21  |  0  0
3681             0  0  0  | 22 23  0  | 24  0
3682     -------------------------------------
3683     Proc2  25 26 27  |  0  0 28  | 29  0
3684            30  0  0  | 31 32 33  |  0 34
3685 .ve
3686 
3687    This can be represented as a collection of submatrices as:
3688 
3689 .vb
3690       A B C
3691       D E F
3692       G H I
3693 .ve
3694 
3695    Where the submatrices A,B,C are owned by proc0, D,E,F are
3696    owned by proc1, G,H,I are owned by proc2.
3697 
3698    The 'm' parameters for proc0,proc1,proc2 are 3,3,2 respectively.
3699    The 'n' parameters for proc0,proc1,proc2 are 3,3,2 respectively.
3700    The 'M','N' parameters are 8,8, and have the same values on all procs.
3701 
3702    The DIAGONAL submatrices corresponding to proc0,proc1,proc2 are
3703    submatrices [A], [E], [I] respectively. The OFF-DIAGONAL submatrices
3704    corresponding to proc0,proc1,proc2 are [BC], [DF], [GH] respectively.
3705    Internally, each processor stores the DIAGONAL part, and the OFF-DIAGONAL
3706    part as SeqAIJ matrices. for eg: proc1 will store [E] as a SeqAIJ
3707    matrix, ans [DF] as another SeqAIJ matrix.
3708 
3709    When d_nz, o_nz parameters are specified, d_nz storage elements are
3710    allocated for every row of the local diagonal submatrix, and o_nz
3711    storage locations are allocated for every row of the OFF-DIAGONAL submat.
3712    One way to choose d_nz and o_nz is to use the max nonzerors per local
3713    rows for each of the local DIAGONAL, and the OFF-DIAGONAL submatrices.
3714    In this case, the values of d_nz,o_nz are:
3715 .vb
3716      proc0 : dnz = 2, o_nz = 2
3717      proc1 : dnz = 3, o_nz = 2
3718      proc2 : dnz = 1, o_nz = 4
3719 .ve
3720    We are allocating m*(d_nz+o_nz) storage locations for every proc. This
3721    translates to 3*(2+2)=12 for proc0, 3*(3+2)=15 for proc1, 2*(1+4)=10
3722    for proc3. i.e we are using 12+15+10=37 storage locations to store
3723    34 values.
3724 
3725    When d_nnz, o_nnz parameters are specified, the storage is specified
3726    for every row, coresponding to both DIAGONAL and OFF-DIAGONAL submatrices.
3727    In the above case the values for d_nnz,o_nnz are:
3728 .vb
3729      proc0: d_nnz = [2,2,2] and o_nnz = [2,2,2]
3730      proc1: d_nnz = [3,3,2] and o_nnz = [2,1,1]
3731      proc2: d_nnz = [1,1]   and o_nnz = [4,4]
3732 .ve
3733    Here the space allocated is sum of all the above values i.e 34, and
3734    hence pre-allocation is perfect.
3735 
3736    Level: intermediate
3737 
3738 .keywords: matrix, aij, compressed row, sparse, parallel
3739 
3740 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatMPIAIJSetPreallocation(), MatMPIAIJSetPreallocationCSR(),
3741           MPIAIJ, MatCreateMPIAIJWithArrays()
3742 @*/
3743 PetscErrorCode  MatCreateAIJ(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,PetscInt d_nz,const PetscInt d_nnz[],PetscInt o_nz,const PetscInt o_nnz[],Mat *A)
3744 {
3745   PetscErrorCode ierr;
3746   PetscMPIInt    size;
3747 
3748   PetscFunctionBegin;
3749   ierr = MatCreate(comm,A);CHKERRQ(ierr);
3750   ierr = MatSetSizes(*A,m,n,M,N);CHKERRQ(ierr);
3751   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
3752   if (size > 1) {
3753     ierr = MatSetType(*A,MATMPIAIJ);CHKERRQ(ierr);
3754     ierr = MatMPIAIJSetPreallocation(*A,d_nz,d_nnz,o_nz,o_nnz);CHKERRQ(ierr);
3755   } else {
3756     ierr = MatSetType(*A,MATSEQAIJ);CHKERRQ(ierr);
3757     ierr = MatSeqAIJSetPreallocation(*A,d_nz,d_nnz);CHKERRQ(ierr);
3758   }
3759   PetscFunctionReturn(0);
3760 }
3761 
3762 #undef __FUNCT__
3763 #define __FUNCT__ "MatMPIAIJGetSeqAIJ"
3764 PetscErrorCode  MatMPIAIJGetSeqAIJ(Mat A,Mat *Ad,Mat *Ao,const PetscInt *colmap[])
3765 {
3766   Mat_MPIAIJ *a = (Mat_MPIAIJ*)A->data;
3767 
3768   PetscFunctionBegin;
3769   if (Ad)     *Ad     = a->A;
3770   if (Ao)     *Ao     = a->B;
3771   if (colmap) *colmap = a->garray;
3772   PetscFunctionReturn(0);
3773 }
3774 
3775 #undef __FUNCT__
3776 #define __FUNCT__ "MatSetColoring_MPIAIJ"
3777 PetscErrorCode MatSetColoring_MPIAIJ(Mat A,ISColoring coloring)
3778 {
3779   PetscErrorCode ierr;
3780   PetscInt       i;
3781   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
3782 
3783   PetscFunctionBegin;
3784   if (coloring->ctype == IS_COLORING_GLOBAL) {
3785     ISColoringValue *allcolors,*colors;
3786     ISColoring      ocoloring;
3787 
3788     /* set coloring for diagonal portion */
3789     ierr = MatSetColoring_SeqAIJ(a->A,coloring);CHKERRQ(ierr);
3790 
3791     /* set coloring for off-diagonal portion */
3792     ierr = ISAllGatherColors(PetscObjectComm((PetscObject)A),coloring->n,coloring->colors,NULL,&allcolors);CHKERRQ(ierr);
3793     ierr = PetscMalloc1(a->B->cmap->n+1,&colors);CHKERRQ(ierr);
3794     for (i=0; i<a->B->cmap->n; i++) {
3795       colors[i] = allcolors[a->garray[i]];
3796     }
3797     ierr = PetscFree(allcolors);CHKERRQ(ierr);
3798     ierr = ISColoringCreate(MPI_COMM_SELF,coloring->n,a->B->cmap->n,colors,PETSC_OWN_POINTER,&ocoloring);CHKERRQ(ierr);
3799     ierr = MatSetColoring_SeqAIJ(a->B,ocoloring);CHKERRQ(ierr);
3800     ierr = ISColoringDestroy(&ocoloring);CHKERRQ(ierr);
3801   } else if (coloring->ctype == IS_COLORING_GHOSTED) {
3802     ISColoringValue *colors;
3803     PetscInt        *larray;
3804     ISColoring      ocoloring;
3805 
3806     /* set coloring for diagonal portion */
3807     ierr = PetscMalloc1(a->A->cmap->n+1,&larray);CHKERRQ(ierr);
3808     for (i=0; i<a->A->cmap->n; i++) {
3809       larray[i] = i + A->cmap->rstart;
3810     }
3811     ierr = ISGlobalToLocalMappingApply(A->cmap->mapping,IS_GTOLM_MASK,a->A->cmap->n,larray,NULL,larray);CHKERRQ(ierr);
3812     ierr = PetscMalloc1(a->A->cmap->n+1,&colors);CHKERRQ(ierr);
3813     for (i=0; i<a->A->cmap->n; i++) {
3814       colors[i] = coloring->colors[larray[i]];
3815     }
3816     ierr = PetscFree(larray);CHKERRQ(ierr);
3817     ierr = ISColoringCreate(PETSC_COMM_SELF,coloring->n,a->A->cmap->n,colors,PETSC_OWN_POINTER,&ocoloring);CHKERRQ(ierr);
3818     ierr = MatSetColoring_SeqAIJ(a->A,ocoloring);CHKERRQ(ierr);
3819     ierr = ISColoringDestroy(&ocoloring);CHKERRQ(ierr);
3820 
3821     /* set coloring for off-diagonal portion */
3822     ierr = PetscMalloc1(a->B->cmap->n+1,&larray);CHKERRQ(ierr);
3823     ierr = ISGlobalToLocalMappingApply(A->cmap->mapping,IS_GTOLM_MASK,a->B->cmap->n,a->garray,NULL,larray);CHKERRQ(ierr);
3824     ierr = PetscMalloc1(a->B->cmap->n+1,&colors);CHKERRQ(ierr);
3825     for (i=0; i<a->B->cmap->n; i++) {
3826       colors[i] = coloring->colors[larray[i]];
3827     }
3828     ierr = PetscFree(larray);CHKERRQ(ierr);
3829     ierr = ISColoringCreate(MPI_COMM_SELF,coloring->n,a->B->cmap->n,colors,PETSC_OWN_POINTER,&ocoloring);CHKERRQ(ierr);
3830     ierr = MatSetColoring_SeqAIJ(a->B,ocoloring);CHKERRQ(ierr);
3831     ierr = ISColoringDestroy(&ocoloring);CHKERRQ(ierr);
3832   } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support ISColoringType %d",(int)coloring->ctype);
3833   PetscFunctionReturn(0);
3834 }
3835 
3836 #undef __FUNCT__
3837 #define __FUNCT__ "MatSetValuesAdifor_MPIAIJ"
3838 PetscErrorCode MatSetValuesAdifor_MPIAIJ(Mat A,PetscInt nl,void *advalues)
3839 {
3840   Mat_MPIAIJ     *a = (Mat_MPIAIJ*)A->data;
3841   PetscErrorCode ierr;
3842 
3843   PetscFunctionBegin;
3844   ierr = MatSetValuesAdifor_SeqAIJ(a->A,nl,advalues);CHKERRQ(ierr);
3845   ierr = MatSetValuesAdifor_SeqAIJ(a->B,nl,advalues);CHKERRQ(ierr);
3846   PetscFunctionReturn(0);
3847 }
3848 
3849 #undef __FUNCT__
3850 #define __FUNCT__ "MatCreateMPIMatConcatenateSeqMat_MPIAIJ"
3851 PetscErrorCode MatCreateMPIMatConcatenateSeqMat_MPIAIJ(MPI_Comm comm,Mat inmat,PetscInt n,MatReuse scall,Mat *outmat)
3852 {
3853   PetscErrorCode ierr;
3854   PetscInt       m,N,i,rstart,nnz,Ii;
3855   PetscInt       *indx;
3856   PetscScalar    *values;
3857 
3858   PetscFunctionBegin;
3859   ierr = MatGetSize(inmat,&m,&N);CHKERRQ(ierr);
3860   if (scall == MAT_INITIAL_MATRIX) { /* symbolic phase */
3861     PetscInt       *dnz,*onz,sum,bs,cbs;
3862 
3863     if (n == PETSC_DECIDE) {
3864       ierr = PetscSplitOwnership(comm,&n,&N);CHKERRQ(ierr);
3865     }
3866     /* Check sum(n) = N */
3867     ierr = MPIU_Allreduce(&n,&sum,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
3868     if (sum != N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Sum of local columns != global columns %d",N);
3869 
3870     ierr    = MPI_Scan(&m, &rstart,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
3871     rstart -= m;
3872 
3873     ierr = MatPreallocateInitialize(comm,m,n,dnz,onz);CHKERRQ(ierr);
3874     for (i=0; i<m; i++) {
3875       ierr = MatGetRow_SeqAIJ(inmat,i,&nnz,&indx,NULL);CHKERRQ(ierr);
3876       ierr = MatPreallocateSet(i+rstart,nnz,indx,dnz,onz);CHKERRQ(ierr);
3877       ierr = MatRestoreRow_SeqAIJ(inmat,i,&nnz,&indx,NULL);CHKERRQ(ierr);
3878     }
3879 
3880     ierr = MatCreate(comm,outmat);CHKERRQ(ierr);
3881     ierr = MatSetSizes(*outmat,m,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
3882     ierr = MatGetBlockSizes(inmat,&bs,&cbs);CHKERRQ(ierr);
3883     ierr = MatSetBlockSizes(*outmat,bs,cbs);CHKERRQ(ierr);
3884     ierr = MatSetType(*outmat,MATMPIAIJ);CHKERRQ(ierr);
3885     ierr = MatMPIAIJSetPreallocation(*outmat,0,dnz,0,onz);CHKERRQ(ierr);
3886     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
3887   }
3888 
3889   /* numeric phase */
3890   ierr = MatGetOwnershipRange(*outmat,&rstart,NULL);CHKERRQ(ierr);
3891   for (i=0; i<m; i++) {
3892     ierr = MatGetRow_SeqAIJ(inmat,i,&nnz,&indx,&values);CHKERRQ(ierr);
3893     Ii   = i + rstart;
3894     ierr = MatSetValues(*outmat,1,&Ii,nnz,indx,values,INSERT_VALUES);CHKERRQ(ierr);
3895     ierr = MatRestoreRow_SeqAIJ(inmat,i,&nnz,&indx,&values);CHKERRQ(ierr);
3896   }
3897   ierr = MatAssemblyBegin(*outmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3898   ierr = MatAssemblyEnd(*outmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3899   PetscFunctionReturn(0);
3900 }
3901 
3902 #undef __FUNCT__
3903 #define __FUNCT__ "MatFileSplit"
3904 PetscErrorCode MatFileSplit(Mat A,char *outfile)
3905 {
3906   PetscErrorCode    ierr;
3907   PetscMPIInt       rank;
3908   PetscInt          m,N,i,rstart,nnz;
3909   size_t            len;
3910   const PetscInt    *indx;
3911   PetscViewer       out;
3912   char              *name;
3913   Mat               B;
3914   const PetscScalar *values;
3915 
3916   PetscFunctionBegin;
3917   ierr = MatGetLocalSize(A,&m,0);CHKERRQ(ierr);
3918   ierr = MatGetSize(A,0,&N);CHKERRQ(ierr);
3919   /* Should this be the type of the diagonal block of A? */
3920   ierr = MatCreate(PETSC_COMM_SELF,&B);CHKERRQ(ierr);
3921   ierr = MatSetSizes(B,m,N,m,N);CHKERRQ(ierr);
3922   ierr = MatSetBlockSizesFromMats(B,A,A);CHKERRQ(ierr);
3923   ierr = MatSetType(B,MATSEQAIJ);CHKERRQ(ierr);
3924   ierr = MatSeqAIJSetPreallocation(B,0,NULL);CHKERRQ(ierr);
3925   ierr = MatGetOwnershipRange(A,&rstart,0);CHKERRQ(ierr);
3926   for (i=0; i<m; i++) {
3927     ierr = MatGetRow(A,i+rstart,&nnz,&indx,&values);CHKERRQ(ierr);
3928     ierr = MatSetValues(B,1,&i,nnz,indx,values,INSERT_VALUES);CHKERRQ(ierr);
3929     ierr = MatRestoreRow(A,i+rstart,&nnz,&indx,&values);CHKERRQ(ierr);
3930   }
3931   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3932   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3933 
3934   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
3935   ierr = PetscStrlen(outfile,&len);CHKERRQ(ierr);
3936   ierr = PetscMalloc1(len+5,&name);CHKERRQ(ierr);
3937   sprintf(name,"%s.%d",outfile,rank);
3938   ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,name,FILE_MODE_APPEND,&out);CHKERRQ(ierr);
3939   ierr = PetscFree(name);CHKERRQ(ierr);
3940   ierr = MatView(B,out);CHKERRQ(ierr);
3941   ierr = PetscViewerDestroy(&out);CHKERRQ(ierr);
3942   ierr = MatDestroy(&B);CHKERRQ(ierr);
3943   PetscFunctionReturn(0);
3944 }
3945 
3946 extern PetscErrorCode MatDestroy_MPIAIJ(Mat);
3947 #undef __FUNCT__
3948 #define __FUNCT__ "MatDestroy_MPIAIJ_SeqsToMPI"
3949 PetscErrorCode  MatDestroy_MPIAIJ_SeqsToMPI(Mat A)
3950 {
3951   PetscErrorCode      ierr;
3952   Mat_Merge_SeqsToMPI *merge;
3953   PetscContainer      container;
3954 
3955   PetscFunctionBegin;
3956   ierr = PetscObjectQuery((PetscObject)A,"MatMergeSeqsToMPI",(PetscObject*)&container);CHKERRQ(ierr);
3957   if (container) {
3958     ierr = PetscContainerGetPointer(container,(void**)&merge);CHKERRQ(ierr);
3959     ierr = PetscFree(merge->id_r);CHKERRQ(ierr);
3960     ierr = PetscFree(merge->len_s);CHKERRQ(ierr);
3961     ierr = PetscFree(merge->len_r);CHKERRQ(ierr);
3962     ierr = PetscFree(merge->bi);CHKERRQ(ierr);
3963     ierr = PetscFree(merge->bj);CHKERRQ(ierr);
3964     ierr = PetscFree(merge->buf_ri[0]);CHKERRQ(ierr);
3965     ierr = PetscFree(merge->buf_ri);CHKERRQ(ierr);
3966     ierr = PetscFree(merge->buf_rj[0]);CHKERRQ(ierr);
3967     ierr = PetscFree(merge->buf_rj);CHKERRQ(ierr);
3968     ierr = PetscFree(merge->coi);CHKERRQ(ierr);
3969     ierr = PetscFree(merge->coj);CHKERRQ(ierr);
3970     ierr = PetscFree(merge->owners_co);CHKERRQ(ierr);
3971     ierr = PetscLayoutDestroy(&merge->rowmap);CHKERRQ(ierr);
3972     ierr = PetscFree(merge);CHKERRQ(ierr);
3973     ierr = PetscObjectCompose((PetscObject)A,"MatMergeSeqsToMPI",0);CHKERRQ(ierr);
3974   }
3975   ierr = MatDestroy_MPIAIJ(A);CHKERRQ(ierr);
3976   PetscFunctionReturn(0);
3977 }
3978 
3979 #include <../src/mat/utils/freespace.h>
3980 #include <petscbt.h>
3981 
3982 #undef __FUNCT__
3983 #define __FUNCT__ "MatCreateMPIAIJSumSeqAIJNumeric"
3984 PetscErrorCode  MatCreateMPIAIJSumSeqAIJNumeric(Mat seqmat,Mat mpimat)
3985 {
3986   PetscErrorCode      ierr;
3987   MPI_Comm            comm;
3988   Mat_SeqAIJ          *a  =(Mat_SeqAIJ*)seqmat->data;
3989   PetscMPIInt         size,rank,taga,*len_s;
3990   PetscInt            N=mpimat->cmap->N,i,j,*owners,*ai=a->i,*aj;
3991   PetscInt            proc,m;
3992   PetscInt            **buf_ri,**buf_rj;
3993   PetscInt            k,anzi,*bj_i,*bi,*bj,arow,bnzi,nextaj;
3994   PetscInt            nrows,**buf_ri_k,**nextrow,**nextai;
3995   MPI_Request         *s_waits,*r_waits;
3996   MPI_Status          *status;
3997   MatScalar           *aa=a->a;
3998   MatScalar           **abuf_r,*ba_i;
3999   Mat_Merge_SeqsToMPI *merge;
4000   PetscContainer      container;
4001 
4002   PetscFunctionBegin;
4003   ierr = PetscObjectGetComm((PetscObject)mpimat,&comm);CHKERRQ(ierr);
4004   ierr = PetscLogEventBegin(MAT_Seqstompinum,seqmat,0,0,0);CHKERRQ(ierr);
4005 
4006   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4007   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
4008 
4009   ierr = PetscObjectQuery((PetscObject)mpimat,"MatMergeSeqsToMPI",(PetscObject*)&container);CHKERRQ(ierr);
4010   ierr = PetscContainerGetPointer(container,(void**)&merge);CHKERRQ(ierr);
4011 
4012   bi     = merge->bi;
4013   bj     = merge->bj;
4014   buf_ri = merge->buf_ri;
4015   buf_rj = merge->buf_rj;
4016 
4017   ierr   = PetscMalloc1(size,&status);CHKERRQ(ierr);
4018   owners = merge->rowmap->range;
4019   len_s  = merge->len_s;
4020 
4021   /* send and recv matrix values */
4022   /*-----------------------------*/
4023   ierr = PetscObjectGetNewTag((PetscObject)mpimat,&taga);CHKERRQ(ierr);
4024   ierr = PetscPostIrecvScalar(comm,taga,merge->nrecv,merge->id_r,merge->len_r,&abuf_r,&r_waits);CHKERRQ(ierr);
4025 
4026   ierr = PetscMalloc1(merge->nsend+1,&s_waits);CHKERRQ(ierr);
4027   for (proc=0,k=0; proc<size; proc++) {
4028     if (!len_s[proc]) continue;
4029     i    = owners[proc];
4030     ierr = MPI_Isend(aa+ai[i],len_s[proc],MPIU_MATSCALAR,proc,taga,comm,s_waits+k);CHKERRQ(ierr);
4031     k++;
4032   }
4033 
4034   if (merge->nrecv) {ierr = MPI_Waitall(merge->nrecv,r_waits,status);CHKERRQ(ierr);}
4035   if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,s_waits,status);CHKERRQ(ierr);}
4036   ierr = PetscFree(status);CHKERRQ(ierr);
4037 
4038   ierr = PetscFree(s_waits);CHKERRQ(ierr);
4039   ierr = PetscFree(r_waits);CHKERRQ(ierr);
4040 
4041   /* insert mat values of mpimat */
4042   /*----------------------------*/
4043   ierr = PetscMalloc1(N,&ba_i);CHKERRQ(ierr);
4044   ierr = PetscMalloc3(merge->nrecv,&buf_ri_k,merge->nrecv,&nextrow,merge->nrecv,&nextai);CHKERRQ(ierr);
4045 
4046   for (k=0; k<merge->nrecv; k++) {
4047     buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
4048     nrows       = *(buf_ri_k[k]);
4049     nextrow[k]  = buf_ri_k[k]+1;  /* next row number of k-th recved i-structure */
4050     nextai[k]   = buf_ri_k[k] + (nrows + 1); /* poins to the next i-structure of k-th recved i-structure  */
4051   }
4052 
4053   /* set values of ba */
4054   m = merge->rowmap->n;
4055   for (i=0; i<m; i++) {
4056     arow = owners[rank] + i;
4057     bj_i = bj+bi[i];  /* col indices of the i-th row of mpimat */
4058     bnzi = bi[i+1] - bi[i];
4059     ierr = PetscMemzero(ba_i,bnzi*sizeof(PetscScalar));CHKERRQ(ierr);
4060 
4061     /* add local non-zero vals of this proc's seqmat into ba */
4062     anzi   = ai[arow+1] - ai[arow];
4063     aj     = a->j + ai[arow];
4064     aa     = a->a + ai[arow];
4065     nextaj = 0;
4066     for (j=0; nextaj<anzi; j++) {
4067       if (*(bj_i + j) == aj[nextaj]) { /* bcol == acol */
4068         ba_i[j] += aa[nextaj++];
4069       }
4070     }
4071 
4072     /* add received vals into ba */
4073     for (k=0; k<merge->nrecv; k++) { /* k-th received message */
4074       /* i-th row */
4075       if (i == *nextrow[k]) {
4076         anzi   = *(nextai[k]+1) - *nextai[k];
4077         aj     = buf_rj[k] + *(nextai[k]);
4078         aa     = abuf_r[k] + *(nextai[k]);
4079         nextaj = 0;
4080         for (j=0; nextaj<anzi; j++) {
4081           if (*(bj_i + j) == aj[nextaj]) { /* bcol == acol */
4082             ba_i[j] += aa[nextaj++];
4083           }
4084         }
4085         nextrow[k]++; nextai[k]++;
4086       }
4087     }
4088     ierr = MatSetValues(mpimat,1,&arow,bnzi,bj_i,ba_i,INSERT_VALUES);CHKERRQ(ierr);
4089   }
4090   ierr = MatAssemblyBegin(mpimat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4091   ierr = MatAssemblyEnd(mpimat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4092 
4093   ierr = PetscFree(abuf_r[0]);CHKERRQ(ierr);
4094   ierr = PetscFree(abuf_r);CHKERRQ(ierr);
4095   ierr = PetscFree(ba_i);CHKERRQ(ierr);
4096   ierr = PetscFree3(buf_ri_k,nextrow,nextai);CHKERRQ(ierr);
4097   ierr = PetscLogEventEnd(MAT_Seqstompinum,seqmat,0,0,0);CHKERRQ(ierr);
4098   PetscFunctionReturn(0);
4099 }
4100 
4101 extern PetscErrorCode  MatDestroy_MPIAIJ_SeqsToMPI(Mat);
4102 
4103 #undef __FUNCT__
4104 #define __FUNCT__ "MatCreateMPIAIJSumSeqAIJSymbolic"
4105 PetscErrorCode  MatCreateMPIAIJSumSeqAIJSymbolic(MPI_Comm comm,Mat seqmat,PetscInt m,PetscInt n,Mat *mpimat)
4106 {
4107   PetscErrorCode      ierr;
4108   Mat                 B_mpi;
4109   Mat_SeqAIJ          *a=(Mat_SeqAIJ*)seqmat->data;
4110   PetscMPIInt         size,rank,tagi,tagj,*len_s,*len_si,*len_ri;
4111   PetscInt            **buf_rj,**buf_ri,**buf_ri_k;
4112   PetscInt            M=seqmat->rmap->n,N=seqmat->cmap->n,i,*owners,*ai=a->i,*aj=a->j;
4113   PetscInt            len,proc,*dnz,*onz,bs,cbs;
4114   PetscInt            k,anzi,*bi,*bj,*lnk,nlnk,arow,bnzi,nspacedouble=0;
4115   PetscInt            nrows,*buf_s,*buf_si,*buf_si_i,**nextrow,**nextai;
4116   MPI_Request         *si_waits,*sj_waits,*ri_waits,*rj_waits;
4117   MPI_Status          *status;
4118   PetscFreeSpaceList  free_space=NULL,current_space=NULL;
4119   PetscBT             lnkbt;
4120   Mat_Merge_SeqsToMPI *merge;
4121   PetscContainer      container;
4122 
4123   PetscFunctionBegin;
4124   ierr = PetscLogEventBegin(MAT_Seqstompisym,seqmat,0,0,0);CHKERRQ(ierr);
4125 
4126   /* make sure it is a PETSc comm */
4127   ierr = PetscCommDuplicate(comm,&comm,NULL);CHKERRQ(ierr);
4128   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4129   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
4130 
4131   ierr = PetscNew(&merge);CHKERRQ(ierr);
4132   ierr = PetscMalloc1(size,&status);CHKERRQ(ierr);
4133 
4134   /* determine row ownership */
4135   /*---------------------------------------------------------*/
4136   ierr = PetscLayoutCreate(comm,&merge->rowmap);CHKERRQ(ierr);
4137   ierr = PetscLayoutSetLocalSize(merge->rowmap,m);CHKERRQ(ierr);
4138   ierr = PetscLayoutSetSize(merge->rowmap,M);CHKERRQ(ierr);
4139   ierr = PetscLayoutSetBlockSize(merge->rowmap,1);CHKERRQ(ierr);
4140   ierr = PetscLayoutSetUp(merge->rowmap);CHKERRQ(ierr);
4141   ierr = PetscMalloc1(size,&len_si);CHKERRQ(ierr);
4142   ierr = PetscMalloc1(size,&merge->len_s);CHKERRQ(ierr);
4143 
4144   m      = merge->rowmap->n;
4145   owners = merge->rowmap->range;
4146 
4147   /* determine the number of messages to send, their lengths */
4148   /*---------------------------------------------------------*/
4149   len_s = merge->len_s;
4150 
4151   len          = 0; /* length of buf_si[] */
4152   merge->nsend = 0;
4153   for (proc=0; proc<size; proc++) {
4154     len_si[proc] = 0;
4155     if (proc == rank) {
4156       len_s[proc] = 0;
4157     } else {
4158       len_si[proc] = owners[proc+1] - owners[proc] + 1;
4159       len_s[proc]  = ai[owners[proc+1]] - ai[owners[proc]]; /* num of rows to be sent to [proc] */
4160     }
4161     if (len_s[proc]) {
4162       merge->nsend++;
4163       nrows = 0;
4164       for (i=owners[proc]; i<owners[proc+1]; i++) {
4165         if (ai[i+1] > ai[i]) nrows++;
4166       }
4167       len_si[proc] = 2*(nrows+1);
4168       len         += len_si[proc];
4169     }
4170   }
4171 
4172   /* determine the number and length of messages to receive for ij-structure */
4173   /*-------------------------------------------------------------------------*/
4174   ierr = PetscGatherNumberOfMessages(comm,NULL,len_s,&merge->nrecv);CHKERRQ(ierr);
4175   ierr = PetscGatherMessageLengths2(comm,merge->nsend,merge->nrecv,len_s,len_si,&merge->id_r,&merge->len_r,&len_ri);CHKERRQ(ierr);
4176 
4177   /* post the Irecv of j-structure */
4178   /*-------------------------------*/
4179   ierr = PetscCommGetNewTag(comm,&tagj);CHKERRQ(ierr);
4180   ierr = PetscPostIrecvInt(comm,tagj,merge->nrecv,merge->id_r,merge->len_r,&buf_rj,&rj_waits);CHKERRQ(ierr);
4181 
4182   /* post the Isend of j-structure */
4183   /*--------------------------------*/
4184   ierr = PetscMalloc2(merge->nsend,&si_waits,merge->nsend,&sj_waits);CHKERRQ(ierr);
4185 
4186   for (proc=0, k=0; proc<size; proc++) {
4187     if (!len_s[proc]) continue;
4188     i    = owners[proc];
4189     ierr = MPI_Isend(aj+ai[i],len_s[proc],MPIU_INT,proc,tagj,comm,sj_waits+k);CHKERRQ(ierr);
4190     k++;
4191   }
4192 
4193   /* receives and sends of j-structure are complete */
4194   /*------------------------------------------------*/
4195   if (merge->nrecv) {ierr = MPI_Waitall(merge->nrecv,rj_waits,status);CHKERRQ(ierr);}
4196   if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,sj_waits,status);CHKERRQ(ierr);}
4197 
4198   /* send and recv i-structure */
4199   /*---------------------------*/
4200   ierr = PetscCommGetNewTag(comm,&tagi);CHKERRQ(ierr);
4201   ierr = PetscPostIrecvInt(comm,tagi,merge->nrecv,merge->id_r,len_ri,&buf_ri,&ri_waits);CHKERRQ(ierr);
4202 
4203   ierr   = PetscMalloc1(len+1,&buf_s);CHKERRQ(ierr);
4204   buf_si = buf_s;  /* points to the beginning of k-th msg to be sent */
4205   for (proc=0,k=0; proc<size; proc++) {
4206     if (!len_s[proc]) continue;
4207     /* form outgoing message for i-structure:
4208          buf_si[0]:                 nrows to be sent
4209                [1:nrows]:           row index (global)
4210                [nrows+1:2*nrows+1]: i-structure index
4211     */
4212     /*-------------------------------------------*/
4213     nrows       = len_si[proc]/2 - 1;
4214     buf_si_i    = buf_si + nrows+1;
4215     buf_si[0]   = nrows;
4216     buf_si_i[0] = 0;
4217     nrows       = 0;
4218     for (i=owners[proc]; i<owners[proc+1]; i++) {
4219       anzi = ai[i+1] - ai[i];
4220       if (anzi) {
4221         buf_si_i[nrows+1] = buf_si_i[nrows] + anzi; /* i-structure */
4222         buf_si[nrows+1]   = i-owners[proc]; /* local row index */
4223         nrows++;
4224       }
4225     }
4226     ierr = MPI_Isend(buf_si,len_si[proc],MPIU_INT,proc,tagi,comm,si_waits+k);CHKERRQ(ierr);
4227     k++;
4228     buf_si += len_si[proc];
4229   }
4230 
4231   if (merge->nrecv) {ierr = MPI_Waitall(merge->nrecv,ri_waits,status);CHKERRQ(ierr);}
4232   if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,si_waits,status);CHKERRQ(ierr);}
4233 
4234   ierr = PetscInfo2(seqmat,"nsend: %D, nrecv: %D\n",merge->nsend,merge->nrecv);CHKERRQ(ierr);
4235   for (i=0; i<merge->nrecv; i++) {
4236     ierr = PetscInfo3(seqmat,"recv len_ri=%D, len_rj=%D from [%D]\n",len_ri[i],merge->len_r[i],merge->id_r[i]);CHKERRQ(ierr);
4237   }
4238 
4239   ierr = PetscFree(len_si);CHKERRQ(ierr);
4240   ierr = PetscFree(len_ri);CHKERRQ(ierr);
4241   ierr = PetscFree(rj_waits);CHKERRQ(ierr);
4242   ierr = PetscFree2(si_waits,sj_waits);CHKERRQ(ierr);
4243   ierr = PetscFree(ri_waits);CHKERRQ(ierr);
4244   ierr = PetscFree(buf_s);CHKERRQ(ierr);
4245   ierr = PetscFree(status);CHKERRQ(ierr);
4246 
4247   /* compute a local seq matrix in each processor */
4248   /*----------------------------------------------*/
4249   /* allocate bi array and free space for accumulating nonzero column info */
4250   ierr  = PetscMalloc1(m+1,&bi);CHKERRQ(ierr);
4251   bi[0] = 0;
4252 
4253   /* create and initialize a linked list */
4254   nlnk = N+1;
4255   ierr = PetscLLCreate(N,N,nlnk,lnk,lnkbt);CHKERRQ(ierr);
4256 
4257   /* initial FreeSpace size is 2*(num of local nnz(seqmat)) */
4258   len  = ai[owners[rank+1]] - ai[owners[rank]];
4259   ierr = PetscFreeSpaceGet(PetscIntMultTruncate(2,len)+1,&free_space);CHKERRQ(ierr);
4260 
4261   current_space = free_space;
4262 
4263   /* determine symbolic info for each local row */
4264   ierr = PetscMalloc3(merge->nrecv,&buf_ri_k,merge->nrecv,&nextrow,merge->nrecv,&nextai);CHKERRQ(ierr);
4265 
4266   for (k=0; k<merge->nrecv; k++) {
4267     buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
4268     nrows       = *buf_ri_k[k];
4269     nextrow[k]  = buf_ri_k[k] + 1;  /* next row number of k-th recved i-structure */
4270     nextai[k]   = buf_ri_k[k] + (nrows + 1); /* poins to the next i-structure of k-th recved i-structure  */
4271   }
4272 
4273   ierr = MatPreallocateInitialize(comm,m,n,dnz,onz);CHKERRQ(ierr);
4274   len  = 0;
4275   for (i=0; i<m; i++) {
4276     bnzi = 0;
4277     /* add local non-zero cols of this proc's seqmat into lnk */
4278     arow  = owners[rank] + i;
4279     anzi  = ai[arow+1] - ai[arow];
4280     aj    = a->j + ai[arow];
4281     ierr  = PetscLLAddSorted(anzi,aj,N,nlnk,lnk,lnkbt);CHKERRQ(ierr);
4282     bnzi += nlnk;
4283     /* add received col data into lnk */
4284     for (k=0; k<merge->nrecv; k++) { /* k-th received message */
4285       if (i == *nextrow[k]) { /* i-th row */
4286         anzi  = *(nextai[k]+1) - *nextai[k];
4287         aj    = buf_rj[k] + *nextai[k];
4288         ierr  = PetscLLAddSorted(anzi,aj,N,nlnk,lnk,lnkbt);CHKERRQ(ierr);
4289         bnzi += nlnk;
4290         nextrow[k]++; nextai[k]++;
4291       }
4292     }
4293     if (len < bnzi) len = bnzi;  /* =max(bnzi) */
4294 
4295     /* if free space is not available, make more free space */
4296     if (current_space->local_remaining<bnzi) {
4297       ierr = PetscFreeSpaceGet(PetscIntSumTruncate(bnzi,current_space->total_array_size),&current_space);CHKERRQ(ierr);
4298       nspacedouble++;
4299     }
4300     /* copy data into free space, then initialize lnk */
4301     ierr = PetscLLClean(N,N,bnzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
4302     ierr = MatPreallocateSet(i+owners[rank],bnzi,current_space->array,dnz,onz);CHKERRQ(ierr);
4303 
4304     current_space->array           += bnzi;
4305     current_space->local_used      += bnzi;
4306     current_space->local_remaining -= bnzi;
4307 
4308     bi[i+1] = bi[i] + bnzi;
4309   }
4310 
4311   ierr = PetscFree3(buf_ri_k,nextrow,nextai);CHKERRQ(ierr);
4312 
4313   ierr = PetscMalloc1(bi[m]+1,&bj);CHKERRQ(ierr);
4314   ierr = PetscFreeSpaceContiguous(&free_space,bj);CHKERRQ(ierr);
4315   ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
4316 
4317   /* create symbolic parallel matrix B_mpi */
4318   /*---------------------------------------*/
4319   ierr = MatGetBlockSizes(seqmat,&bs,&cbs);CHKERRQ(ierr);
4320   ierr = MatCreate(comm,&B_mpi);CHKERRQ(ierr);
4321   if (n==PETSC_DECIDE) {
4322     ierr = MatSetSizes(B_mpi,m,n,PETSC_DETERMINE,N);CHKERRQ(ierr);
4323   } else {
4324     ierr = MatSetSizes(B_mpi,m,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
4325   }
4326   ierr = MatSetBlockSizes(B_mpi,bs,cbs);CHKERRQ(ierr);
4327   ierr = MatSetType(B_mpi,MATMPIAIJ);CHKERRQ(ierr);
4328   ierr = MatMPIAIJSetPreallocation(B_mpi,0,dnz,0,onz);CHKERRQ(ierr);
4329   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
4330   ierr = MatSetOption(B_mpi,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
4331 
4332   /* B_mpi is not ready for use - assembly will be done by MatCreateMPIAIJSumSeqAIJNumeric() */
4333   B_mpi->assembled    = PETSC_FALSE;
4334   B_mpi->ops->destroy = MatDestroy_MPIAIJ_SeqsToMPI;
4335   merge->bi           = bi;
4336   merge->bj           = bj;
4337   merge->buf_ri       = buf_ri;
4338   merge->buf_rj       = buf_rj;
4339   merge->coi          = NULL;
4340   merge->coj          = NULL;
4341   merge->owners_co    = NULL;
4342 
4343   ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
4344 
4345   /* attach the supporting struct to B_mpi for reuse */
4346   ierr    = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
4347   ierr    = PetscContainerSetPointer(container,merge);CHKERRQ(ierr);
4348   ierr    = PetscObjectCompose((PetscObject)B_mpi,"MatMergeSeqsToMPI",(PetscObject)container);CHKERRQ(ierr);
4349   ierr    = PetscContainerDestroy(&container);CHKERRQ(ierr);
4350   *mpimat = B_mpi;
4351 
4352   ierr = PetscLogEventEnd(MAT_Seqstompisym,seqmat,0,0,0);CHKERRQ(ierr);
4353   PetscFunctionReturn(0);
4354 }
4355 
4356 #undef __FUNCT__
4357 #define __FUNCT__ "MatCreateMPIAIJSumSeqAIJ"
4358 /*@C
4359       MatCreateMPIAIJSumSeqAIJ - Creates a MPIAIJ matrix by adding sequential
4360                  matrices from each processor
4361 
4362     Collective on MPI_Comm
4363 
4364    Input Parameters:
4365 +    comm - the communicators the parallel matrix will live on
4366 .    seqmat - the input sequential matrices
4367 .    m - number of local rows (or PETSC_DECIDE)
4368 .    n - number of local columns (or PETSC_DECIDE)
4369 -    scall - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
4370 
4371    Output Parameter:
4372 .    mpimat - the parallel matrix generated
4373 
4374     Level: advanced
4375 
4376    Notes:
4377      The dimensions of the sequential matrix in each processor MUST be the same.
4378      The input seqmat is included into the container "Mat_Merge_SeqsToMPI", and will be
4379      destroyed when mpimat is destroyed. Call PetscObjectQuery() to access seqmat.
4380 @*/
4381 PetscErrorCode  MatCreateMPIAIJSumSeqAIJ(MPI_Comm comm,Mat seqmat,PetscInt m,PetscInt n,MatReuse scall,Mat *mpimat)
4382 {
4383   PetscErrorCode ierr;
4384   PetscMPIInt    size;
4385 
4386   PetscFunctionBegin;
4387   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4388   if (size == 1) {
4389     ierr = PetscLogEventBegin(MAT_Seqstompi,seqmat,0,0,0);CHKERRQ(ierr);
4390     if (scall == MAT_INITIAL_MATRIX) {
4391       ierr = MatDuplicate(seqmat,MAT_COPY_VALUES,mpimat);CHKERRQ(ierr);
4392     } else {
4393       ierr = MatCopy(seqmat,*mpimat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4394     }
4395     ierr = PetscLogEventEnd(MAT_Seqstompi,seqmat,0,0,0);CHKERRQ(ierr);
4396     PetscFunctionReturn(0);
4397   }
4398   ierr = PetscLogEventBegin(MAT_Seqstompi,seqmat,0,0,0);CHKERRQ(ierr);
4399   if (scall == MAT_INITIAL_MATRIX) {
4400     ierr = MatCreateMPIAIJSumSeqAIJSymbolic(comm,seqmat,m,n,mpimat);CHKERRQ(ierr);
4401   }
4402   ierr = MatCreateMPIAIJSumSeqAIJNumeric(seqmat,*mpimat);CHKERRQ(ierr);
4403   ierr = PetscLogEventEnd(MAT_Seqstompi,seqmat,0,0,0);CHKERRQ(ierr);
4404   PetscFunctionReturn(0);
4405 }
4406 
4407 #undef __FUNCT__
4408 #define __FUNCT__ "MatMPIAIJGetLocalMat"
4409 /*@
4410      MatMPIAIJGetLocalMat - Creates a SeqAIJ from a MPIAIJ matrix by taking all its local rows and putting them into a sequential vector with
4411           mlocal rows and n columns. Where mlocal is the row count obtained with MatGetLocalSize() and n is the global column count obtained
4412           with MatGetSize()
4413 
4414     Not Collective
4415 
4416    Input Parameters:
4417 +    A - the matrix
4418 .    scall - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
4419 
4420    Output Parameter:
4421 .    A_loc - the local sequential matrix generated
4422 
4423     Level: developer
4424 
4425 .seealso: MatGetOwnerShipRange(), MatMPIAIJGetLocalMatCondensed()
4426 
4427 @*/
4428 PetscErrorCode  MatMPIAIJGetLocalMat(Mat A,MatReuse scall,Mat *A_loc)
4429 {
4430   PetscErrorCode ierr;
4431   Mat_MPIAIJ     *mpimat=(Mat_MPIAIJ*)A->data;
4432   Mat_SeqAIJ     *mat,*a,*b;
4433   PetscInt       *ai,*aj,*bi,*bj,*cmap=mpimat->garray;
4434   MatScalar      *aa,*ba,*cam;
4435   PetscScalar    *ca;
4436   PetscInt       am=A->rmap->n,i,j,k,cstart=A->cmap->rstart;
4437   PetscInt       *ci,*cj,col,ncols_d,ncols_o,jo;
4438   PetscBool      match;
4439   MPI_Comm       comm;
4440   PetscMPIInt    size;
4441 
4442   PetscFunctionBegin;
4443   ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&match);CHKERRQ(ierr);
4444   if (!match) SETERRQ(PetscObjectComm((PetscObject)A), PETSC_ERR_SUP,"Requires MPIAIJ matrix as input");
4445   ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
4446   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4447   if (size == 1 && scall == MAT_REUSE_MATRIX) PetscFunctionReturn(0);
4448 
4449   ierr = PetscLogEventBegin(MAT_Getlocalmat,A,0,0,0);CHKERRQ(ierr);
4450   a = (Mat_SeqAIJ*)(mpimat->A)->data;
4451   b = (Mat_SeqAIJ*)(mpimat->B)->data;
4452   ai = a->i; aj = a->j; bi = b->i; bj = b->j;
4453   aa = a->a; ba = b->a;
4454   if (scall == MAT_INITIAL_MATRIX) {
4455     if (size == 1) {
4456       ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,am,A->cmap->N,ai,aj,aa,A_loc);CHKERRQ(ierr);
4457       PetscFunctionReturn(0);
4458     }
4459 
4460     ierr  = PetscMalloc1(1+am,&ci);CHKERRQ(ierr);
4461     ci[0] = 0;
4462     for (i=0; i<am; i++) {
4463       ci[i+1] = ci[i] + (ai[i+1] - ai[i]) + (bi[i+1] - bi[i]);
4464     }
4465     ierr = PetscMalloc1(1+ci[am],&cj);CHKERRQ(ierr);
4466     ierr = PetscMalloc1(1+ci[am],&ca);CHKERRQ(ierr);
4467     k    = 0;
4468     for (i=0; i<am; i++) {
4469       ncols_o = bi[i+1] - bi[i];
4470       ncols_d = ai[i+1] - ai[i];
4471       /* off-diagonal portion of A */
4472       for (jo=0; jo<ncols_o; jo++) {
4473         col = cmap[*bj];
4474         if (col >= cstart) break;
4475         cj[k]   = col; bj++;
4476         ca[k++] = *ba++;
4477       }
4478       /* diagonal portion of A */
4479       for (j=0; j<ncols_d; j++) {
4480         cj[k]   = cstart + *aj++;
4481         ca[k++] = *aa++;
4482       }
4483       /* off-diagonal portion of A */
4484       for (j=jo; j<ncols_o; j++) {
4485         cj[k]   = cmap[*bj++];
4486         ca[k++] = *ba++;
4487       }
4488     }
4489     /* put together the new matrix */
4490     ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,am,A->cmap->N,ci,cj,ca,A_loc);CHKERRQ(ierr);
4491     /* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */
4492     /* Since these are PETSc arrays, change flags to free them as necessary. */
4493     mat          = (Mat_SeqAIJ*)(*A_loc)->data;
4494     mat->free_a  = PETSC_TRUE;
4495     mat->free_ij = PETSC_TRUE;
4496     mat->nonew   = 0;
4497   } else if (scall == MAT_REUSE_MATRIX) {
4498     mat=(Mat_SeqAIJ*)(*A_loc)->data;
4499     ci = mat->i; cj = mat->j; cam = mat->a;
4500     for (i=0; i<am; i++) {
4501       /* off-diagonal portion of A */
4502       ncols_o = bi[i+1] - bi[i];
4503       for (jo=0; jo<ncols_o; jo++) {
4504         col = cmap[*bj];
4505         if (col >= cstart) break;
4506         *cam++ = *ba++; bj++;
4507       }
4508       /* diagonal portion of A */
4509       ncols_d = ai[i+1] - ai[i];
4510       for (j=0; j<ncols_d; j++) *cam++ = *aa++;
4511       /* off-diagonal portion of A */
4512       for (j=jo; j<ncols_o; j++) {
4513         *cam++ = *ba++; bj++;
4514       }
4515     }
4516   } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid MatReuse %d",(int)scall);
4517   ierr = PetscLogEventEnd(MAT_Getlocalmat,A,0,0,0);CHKERRQ(ierr);
4518   PetscFunctionReturn(0);
4519 }
4520 
4521 #undef __FUNCT__
4522 #define __FUNCT__ "MatMPIAIJGetLocalMatCondensed"
4523 /*@C
4524      MatMPIAIJGetLocalMatCondensed - Creates a SeqAIJ matrix from an MPIAIJ matrix by taking all its local rows and NON-ZERO columns
4525 
4526     Not Collective
4527 
4528    Input Parameters:
4529 +    A - the matrix
4530 .    scall - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
4531 -    row, col - index sets of rows and columns to extract (or NULL)
4532 
4533    Output Parameter:
4534 .    A_loc - the local sequential matrix generated
4535 
4536     Level: developer
4537 
4538 .seealso: MatGetOwnershipRange(), MatMPIAIJGetLocalMat()
4539 
4540 @*/
4541 PetscErrorCode  MatMPIAIJGetLocalMatCondensed(Mat A,MatReuse scall,IS *row,IS *col,Mat *A_loc)
4542 {
4543   Mat_MPIAIJ     *a=(Mat_MPIAIJ*)A->data;
4544   PetscErrorCode ierr;
4545   PetscInt       i,start,end,ncols,nzA,nzB,*cmap,imark,*idx;
4546   IS             isrowa,iscola;
4547   Mat            *aloc;
4548   PetscBool      match;
4549 
4550   PetscFunctionBegin;
4551   ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&match);CHKERRQ(ierr);
4552   if (!match) SETERRQ(PetscObjectComm((PetscObject)A), PETSC_ERR_SUP,"Requires MPIAIJ matrix as input");
4553   ierr = PetscLogEventBegin(MAT_Getlocalmatcondensed,A,0,0,0);CHKERRQ(ierr);
4554   if (!row) {
4555     start = A->rmap->rstart; end = A->rmap->rend;
4556     ierr  = ISCreateStride(PETSC_COMM_SELF,end-start,start,1,&isrowa);CHKERRQ(ierr);
4557   } else {
4558     isrowa = *row;
4559   }
4560   if (!col) {
4561     start = A->cmap->rstart;
4562     cmap  = a->garray;
4563     nzA   = a->A->cmap->n;
4564     nzB   = a->B->cmap->n;
4565     ierr  = PetscMalloc1(nzA+nzB, &idx);CHKERRQ(ierr);
4566     ncols = 0;
4567     for (i=0; i<nzB; i++) {
4568       if (cmap[i] < start) idx[ncols++] = cmap[i];
4569       else break;
4570     }
4571     imark = i;
4572     for (i=0; i<nzA; i++) idx[ncols++] = start + i;
4573     for (i=imark; i<nzB; i++) idx[ncols++] = cmap[i];
4574     ierr = ISCreateGeneral(PETSC_COMM_SELF,ncols,idx,PETSC_OWN_POINTER,&iscola);CHKERRQ(ierr);
4575   } else {
4576     iscola = *col;
4577   }
4578   if (scall != MAT_INITIAL_MATRIX) {
4579     ierr    = PetscMalloc1(1,&aloc);CHKERRQ(ierr);
4580     aloc[0] = *A_loc;
4581   }
4582   ierr   = MatGetSubMatrices(A,1,&isrowa,&iscola,scall,&aloc);CHKERRQ(ierr);
4583   *A_loc = aloc[0];
4584   ierr   = PetscFree(aloc);CHKERRQ(ierr);
4585   if (!row) {
4586     ierr = ISDestroy(&isrowa);CHKERRQ(ierr);
4587   }
4588   if (!col) {
4589     ierr = ISDestroy(&iscola);CHKERRQ(ierr);
4590   }
4591   ierr = PetscLogEventEnd(MAT_Getlocalmatcondensed,A,0,0,0);CHKERRQ(ierr);
4592   PetscFunctionReturn(0);
4593 }
4594 
4595 #undef __FUNCT__
4596 #define __FUNCT__ "MatGetBrowsOfAcols"
4597 /*@C
4598     MatGetBrowsOfAcols - Creates a SeqAIJ matrix by taking rows of B that equal to nonzero columns of local A
4599 
4600     Collective on Mat
4601 
4602    Input Parameters:
4603 +    A,B - the matrices in mpiaij format
4604 .    scall - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
4605 -    rowb, colb - index sets of rows and columns of B to extract (or NULL)
4606 
4607    Output Parameter:
4608 +    rowb, colb - index sets of rows and columns of B to extract
4609 -    B_seq - the sequential matrix generated
4610 
4611     Level: developer
4612 
4613 @*/
4614 PetscErrorCode  MatGetBrowsOfAcols(Mat A,Mat B,MatReuse scall,IS *rowb,IS *colb,Mat *B_seq)
4615 {
4616   Mat_MPIAIJ     *a=(Mat_MPIAIJ*)A->data;
4617   PetscErrorCode ierr;
4618   PetscInt       *idx,i,start,ncols,nzA,nzB,*cmap,imark;
4619   IS             isrowb,iscolb;
4620   Mat            *bseq=NULL;
4621 
4622   PetscFunctionBegin;
4623   if (A->cmap->rstart != B->rmap->rstart || A->cmap->rend != B->rmap->rend) {
4624     SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, (%D, %D) != (%D,%D)",A->cmap->rstart,A->cmap->rend,B->rmap->rstart,B->rmap->rend);
4625   }
4626   ierr = PetscLogEventBegin(MAT_GetBrowsOfAcols,A,B,0,0);CHKERRQ(ierr);
4627 
4628   if (scall == MAT_INITIAL_MATRIX) {
4629     start = A->cmap->rstart;
4630     cmap  = a->garray;
4631     nzA   = a->A->cmap->n;
4632     nzB   = a->B->cmap->n;
4633     ierr  = PetscMalloc1(nzA+nzB, &idx);CHKERRQ(ierr);
4634     ncols = 0;
4635     for (i=0; i<nzB; i++) {  /* row < local row index */
4636       if (cmap[i] < start) idx[ncols++] = cmap[i];
4637       else break;
4638     }
4639     imark = i;
4640     for (i=0; i<nzA; i++) idx[ncols++] = start + i;  /* local rows */
4641     for (i=imark; i<nzB; i++) idx[ncols++] = cmap[i]; /* row > local row index */
4642     ierr = ISCreateGeneral(PETSC_COMM_SELF,ncols,idx,PETSC_OWN_POINTER,&isrowb);CHKERRQ(ierr);
4643     ierr = ISCreateStride(PETSC_COMM_SELF,B->cmap->N,0,1,&iscolb);CHKERRQ(ierr);
4644   } else {
4645     if (!rowb || !colb) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"IS rowb and colb must be provided for MAT_REUSE_MATRIX");
4646     isrowb  = *rowb; iscolb = *colb;
4647     ierr    = PetscMalloc1(1,&bseq);CHKERRQ(ierr);
4648     bseq[0] = *B_seq;
4649   }
4650   ierr   = MatGetSubMatrices(B,1,&isrowb,&iscolb,scall,&bseq);CHKERRQ(ierr);
4651   *B_seq = bseq[0];
4652   ierr   = PetscFree(bseq);CHKERRQ(ierr);
4653   if (!rowb) {
4654     ierr = ISDestroy(&isrowb);CHKERRQ(ierr);
4655   } else {
4656     *rowb = isrowb;
4657   }
4658   if (!colb) {
4659     ierr = ISDestroy(&iscolb);CHKERRQ(ierr);
4660   } else {
4661     *colb = iscolb;
4662   }
4663   ierr = PetscLogEventEnd(MAT_GetBrowsOfAcols,A,B,0,0);CHKERRQ(ierr);
4664   PetscFunctionReturn(0);
4665 }
4666 
4667 #undef __FUNCT__
4668 #define __FUNCT__ "MatGetBrowsOfAoCols_MPIAIJ"
4669 /*
4670     MatGetBrowsOfAoCols_MPIAIJ - Creates a SeqAIJ matrix by taking rows of B that equal to nonzero columns
4671     of the OFF-DIAGONAL portion of local A
4672 
4673     Collective on Mat
4674 
4675    Input Parameters:
4676 +    A,B - the matrices in mpiaij format
4677 -    scall - either MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX
4678 
4679    Output Parameter:
4680 +    startsj_s - starting point in B's sending j-arrays, saved for MAT_REUSE (or NULL)
4681 .    startsj_r - starting point in B's receiving j-arrays, saved for MAT_REUSE (or NULL)
4682 .    bufa_ptr - array for sending matrix values, saved for MAT_REUSE (or NULL)
4683 -    B_oth - the sequential matrix generated with size aBn=a->B->cmap->n by B->cmap->N
4684 
4685     Level: developer
4686 
4687 */
4688 PetscErrorCode  MatGetBrowsOfAoCols_MPIAIJ(Mat A,Mat B,MatReuse scall,PetscInt **startsj_s,PetscInt **startsj_r,MatScalar **bufa_ptr,Mat *B_oth)
4689 {
4690   VecScatter_MPI_General *gen_to,*gen_from;
4691   PetscErrorCode         ierr;
4692   Mat_MPIAIJ             *a=(Mat_MPIAIJ*)A->data;
4693   Mat_SeqAIJ             *b_oth;
4694   VecScatter             ctx =a->Mvctx;
4695   MPI_Comm               comm;
4696   PetscMPIInt            *rprocs,*sprocs,tag=((PetscObject)ctx)->tag,rank;
4697   PetscInt               *rowlen,*bufj,*bufJ,ncols,aBn=a->B->cmap->n,row,*b_othi,*b_othj;
4698   PetscScalar            *rvalues,*svalues;
4699   MatScalar              *b_otha,*bufa,*bufA;
4700   PetscInt               i,j,k,l,ll,nrecvs,nsends,nrows,*srow,*rstarts,*rstartsj = 0,*sstarts,*sstartsj,len;
4701   MPI_Request            *rwaits = NULL,*swaits = NULL;
4702   MPI_Status             *sstatus,rstatus;
4703   PetscMPIInt            jj,size;
4704   PetscInt               *cols,sbs,rbs;
4705   PetscScalar            *vals;
4706 
4707   PetscFunctionBegin;
4708   ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
4709   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4710 
4711   if (A->cmap->rstart != B->rmap->rstart || A->cmap->rend != B->rmap->rend) {
4712     SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, (%d, %d) != (%d,%d)",A->cmap->rstart,A->cmap->rend,B->rmap->rstart,B->rmap->rend);
4713   }
4714   ierr = PetscLogEventBegin(MAT_GetBrowsOfAocols,A,B,0,0);CHKERRQ(ierr);
4715   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
4716 
4717   gen_to   = (VecScatter_MPI_General*)ctx->todata;
4718   gen_from = (VecScatter_MPI_General*)ctx->fromdata;
4719   rvalues  = gen_from->values; /* holds the length of receiving row */
4720   svalues  = gen_to->values;   /* holds the length of sending row */
4721   nrecvs   = gen_from->n;
4722   nsends   = gen_to->n;
4723 
4724   ierr    = PetscMalloc2(nrecvs,&rwaits,nsends,&swaits);CHKERRQ(ierr);
4725   srow    = gen_to->indices;    /* local row index to be sent */
4726   sstarts = gen_to->starts;
4727   sprocs  = gen_to->procs;
4728   sstatus = gen_to->sstatus;
4729   sbs     = gen_to->bs;
4730   rstarts = gen_from->starts;
4731   rprocs  = gen_from->procs;
4732   rbs     = gen_from->bs;
4733 
4734   if (!startsj_s || !bufa_ptr) scall = MAT_INITIAL_MATRIX;
4735   if (scall == MAT_INITIAL_MATRIX) {
4736     /* i-array */
4737     /*---------*/
4738     /*  post receives */
4739     for (i=0; i<nrecvs; i++) {
4740       rowlen = (PetscInt*)rvalues + rstarts[i]*rbs;
4741       nrows  = (rstarts[i+1]-rstarts[i])*rbs; /* num of indices to be received */
4742       ierr   = MPI_Irecv(rowlen,nrows,MPIU_INT,rprocs[i],tag,comm,rwaits+i);CHKERRQ(ierr);
4743     }
4744 
4745     /* pack the outgoing message */
4746     ierr = PetscMalloc2(nsends+1,&sstartsj,nrecvs+1,&rstartsj);CHKERRQ(ierr);
4747 
4748     sstartsj[0] = 0;
4749     rstartsj[0] = 0;
4750     len         = 0; /* total length of j or a array to be sent */
4751     k           = 0;
4752     for (i=0; i<nsends; i++) {
4753       rowlen = (PetscInt*)svalues + sstarts[i]*sbs;
4754       nrows  = sstarts[i+1]-sstarts[i]; /* num of block rows */
4755       for (j=0; j<nrows; j++) {
4756         row = srow[k] + B->rmap->range[rank]; /* global row idx */
4757         for (l=0; l<sbs; l++) {
4758           ierr = MatGetRow_MPIAIJ(B,row+l,&ncols,NULL,NULL);CHKERRQ(ierr); /* rowlength */
4759 
4760           rowlen[j*sbs+l] = ncols;
4761 
4762           len += ncols;
4763           ierr = MatRestoreRow_MPIAIJ(B,row+l,&ncols,NULL,NULL);CHKERRQ(ierr);
4764         }
4765         k++;
4766       }
4767       ierr = MPI_Isend(rowlen,nrows*sbs,MPIU_INT,sprocs[i],tag,comm,swaits+i);CHKERRQ(ierr);
4768 
4769       sstartsj[i+1] = len;  /* starting point of (i+1)-th outgoing msg in bufj and bufa */
4770     }
4771     /* recvs and sends of i-array are completed */
4772     i = nrecvs;
4773     while (i--) {
4774       ierr = MPI_Waitany(nrecvs,rwaits,&jj,&rstatus);CHKERRQ(ierr);
4775     }
4776     if (nsends) {ierr = MPI_Waitall(nsends,swaits,sstatus);CHKERRQ(ierr);}
4777 
4778     /* allocate buffers for sending j and a arrays */
4779     ierr = PetscMalloc1(len+1,&bufj);CHKERRQ(ierr);
4780     ierr = PetscMalloc1(len+1,&bufa);CHKERRQ(ierr);
4781 
4782     /* create i-array of B_oth */
4783     ierr = PetscMalloc1(aBn+2,&b_othi);CHKERRQ(ierr);
4784 
4785     b_othi[0] = 0;
4786     len       = 0; /* total length of j or a array to be received */
4787     k         = 0;
4788     for (i=0; i<nrecvs; i++) {
4789       rowlen = (PetscInt*)rvalues + rstarts[i]*rbs;
4790       nrows  = rbs*(rstarts[i+1]-rstarts[i]); /* num of rows to be received */
4791       for (j=0; j<nrows; j++) {
4792         b_othi[k+1] = b_othi[k] + rowlen[j];
4793         ierr = PetscIntSumError(rowlen[j],len,&len);
4794         k++;
4795       }
4796       rstartsj[i+1] = len; /* starting point of (i+1)-th incoming msg in bufj and bufa */
4797     }
4798 
4799     /* allocate space for j and a arrrays of B_oth */
4800     ierr = PetscMalloc1(b_othi[aBn]+1,&b_othj);CHKERRQ(ierr);
4801     ierr = PetscMalloc1(b_othi[aBn]+1,&b_otha);CHKERRQ(ierr);
4802 
4803     /* j-array */
4804     /*---------*/
4805     /*  post receives of j-array */
4806     for (i=0; i<nrecvs; i++) {
4807       nrows = rstartsj[i+1]-rstartsj[i]; /* length of the msg received */
4808       ierr  = MPI_Irecv(b_othj+rstartsj[i],nrows,MPIU_INT,rprocs[i],tag,comm,rwaits+i);CHKERRQ(ierr);
4809     }
4810 
4811     /* pack the outgoing message j-array */
4812     k = 0;
4813     for (i=0; i<nsends; i++) {
4814       nrows = sstarts[i+1]-sstarts[i]; /* num of block rows */
4815       bufJ  = bufj+sstartsj[i];
4816       for (j=0; j<nrows; j++) {
4817         row = srow[k++] + B->rmap->range[rank];  /* global row idx */
4818         for (ll=0; ll<sbs; ll++) {
4819           ierr = MatGetRow_MPIAIJ(B,row+ll,&ncols,&cols,NULL);CHKERRQ(ierr);
4820           for (l=0; l<ncols; l++) {
4821             *bufJ++ = cols[l];
4822           }
4823           ierr = MatRestoreRow_MPIAIJ(B,row+ll,&ncols,&cols,NULL);CHKERRQ(ierr);
4824         }
4825       }
4826       ierr = MPI_Isend(bufj+sstartsj[i],sstartsj[i+1]-sstartsj[i],MPIU_INT,sprocs[i],tag,comm,swaits+i);CHKERRQ(ierr);
4827     }
4828 
4829     /* recvs and sends of j-array are completed */
4830     i = nrecvs;
4831     while (i--) {
4832       ierr = MPI_Waitany(nrecvs,rwaits,&jj,&rstatus);CHKERRQ(ierr);
4833     }
4834     if (nsends) {ierr = MPI_Waitall(nsends,swaits,sstatus);CHKERRQ(ierr);}
4835   } else if (scall == MAT_REUSE_MATRIX) {
4836     sstartsj = *startsj_s;
4837     rstartsj = *startsj_r;
4838     bufa     = *bufa_ptr;
4839     b_oth    = (Mat_SeqAIJ*)(*B_oth)->data;
4840     b_otha   = b_oth->a;
4841   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "Matrix P does not posses an object container");
4842 
4843   /* a-array */
4844   /*---------*/
4845   /*  post receives of a-array */
4846   for (i=0; i<nrecvs; i++) {
4847     nrows = rstartsj[i+1]-rstartsj[i]; /* length of the msg received */
4848     ierr  = MPI_Irecv(b_otha+rstartsj[i],nrows,MPIU_SCALAR,rprocs[i],tag,comm,rwaits+i);CHKERRQ(ierr);
4849   }
4850 
4851   /* pack the outgoing message a-array */
4852   k = 0;
4853   for (i=0; i<nsends; i++) {
4854     nrows = sstarts[i+1]-sstarts[i]; /* num of block rows */
4855     bufA  = bufa+sstartsj[i];
4856     for (j=0; j<nrows; j++) {
4857       row = srow[k++] + B->rmap->range[rank];  /* global row idx */
4858       for (ll=0; ll<sbs; ll++) {
4859         ierr = MatGetRow_MPIAIJ(B,row+ll,&ncols,NULL,&vals);CHKERRQ(ierr);
4860         for (l=0; l<ncols; l++) {
4861           *bufA++ = vals[l];
4862         }
4863         ierr = MatRestoreRow_MPIAIJ(B,row+ll,&ncols,NULL,&vals);CHKERRQ(ierr);
4864       }
4865     }
4866     ierr = MPI_Isend(bufa+sstartsj[i],sstartsj[i+1]-sstartsj[i],MPIU_SCALAR,sprocs[i],tag,comm,swaits+i);CHKERRQ(ierr);
4867   }
4868   /* recvs and sends of a-array are completed */
4869   i = nrecvs;
4870   while (i--) {
4871     ierr = MPI_Waitany(nrecvs,rwaits,&jj,&rstatus);CHKERRQ(ierr);
4872   }
4873   if (nsends) {ierr = MPI_Waitall(nsends,swaits,sstatus);CHKERRQ(ierr);}
4874   ierr = PetscFree2(rwaits,swaits);CHKERRQ(ierr);
4875 
4876   if (scall == MAT_INITIAL_MATRIX) {
4877     /* put together the new matrix */
4878     ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,aBn,B->cmap->N,b_othi,b_othj,b_otha,B_oth);CHKERRQ(ierr);
4879 
4880     /* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */
4881     /* Since these are PETSc arrays, change flags to free them as necessary. */
4882     b_oth          = (Mat_SeqAIJ*)(*B_oth)->data;
4883     b_oth->free_a  = PETSC_TRUE;
4884     b_oth->free_ij = PETSC_TRUE;
4885     b_oth->nonew   = 0;
4886 
4887     ierr = PetscFree(bufj);CHKERRQ(ierr);
4888     if (!startsj_s || !bufa_ptr) {
4889       ierr = PetscFree2(sstartsj,rstartsj);CHKERRQ(ierr);
4890       ierr = PetscFree(bufa_ptr);CHKERRQ(ierr);
4891     } else {
4892       *startsj_s = sstartsj;
4893       *startsj_r = rstartsj;
4894       *bufa_ptr  = bufa;
4895     }
4896   }
4897   ierr = PetscLogEventEnd(MAT_GetBrowsOfAocols,A,B,0,0);CHKERRQ(ierr);
4898   PetscFunctionReturn(0);
4899 }
4900 
4901 #undef __FUNCT__
4902 #define __FUNCT__ "MatGetCommunicationStructs"
4903 /*@C
4904   MatGetCommunicationStructs - Provides access to the communication structures used in matrix-vector multiplication.
4905 
4906   Not Collective
4907 
4908   Input Parameters:
4909 . A - The matrix in mpiaij format
4910 
4911   Output Parameter:
4912 + lvec - The local vector holding off-process values from the argument to a matrix-vector product
4913 . colmap - A map from global column index to local index into lvec
4914 - multScatter - A scatter from the argument of a matrix-vector product to lvec
4915 
4916   Level: developer
4917 
4918 @*/
4919 #if defined(PETSC_USE_CTABLE)
4920 PetscErrorCode  MatGetCommunicationStructs(Mat A, Vec *lvec, PetscTable *colmap, VecScatter *multScatter)
4921 #else
4922 PetscErrorCode  MatGetCommunicationStructs(Mat A, Vec *lvec, PetscInt *colmap[], VecScatter *multScatter)
4923 #endif
4924 {
4925   Mat_MPIAIJ *a;
4926 
4927   PetscFunctionBegin;
4928   PetscValidHeaderSpecific(A, MAT_CLASSID, 1);
4929   PetscValidPointer(lvec, 2);
4930   PetscValidPointer(colmap, 3);
4931   PetscValidPointer(multScatter, 4);
4932   a = (Mat_MPIAIJ*) A->data;
4933   if (lvec) *lvec = a->lvec;
4934   if (colmap) *colmap = a->colmap;
4935   if (multScatter) *multScatter = a->Mvctx;
4936   PetscFunctionReturn(0);
4937 }
4938 
4939 PETSC_EXTERN PetscErrorCode MatConvert_MPIAIJ_MPIAIJCRL(Mat,MatType,MatReuse,Mat*);
4940 PETSC_EXTERN PetscErrorCode MatConvert_MPIAIJ_MPIAIJPERM(Mat,MatType,MatReuse,Mat*);
4941 PETSC_EXTERN PetscErrorCode MatConvert_MPIAIJ_MPISBAIJ(Mat,MatType,MatReuse,Mat*);
4942 #if defined(PETSC_HAVE_ELEMENTAL)
4943 PETSC_EXTERN PetscErrorCode MatConvert_MPIAIJ_Elemental(Mat,MatType,MatReuse,Mat*);
4944 #endif
4945 
4946 #undef __FUNCT__
4947 #define __FUNCT__ "MatMatMultNumeric_MPIDense_MPIAIJ"
4948 /*
4949     Computes (B'*A')' since computing B*A directly is untenable
4950 
4951                n                       p                          p
4952         (              )       (              )         (                  )
4953       m (      A       )  *  n (       B      )   =   m (         C        )
4954         (              )       (              )         (                  )
4955 
4956 */
4957 PetscErrorCode MatMatMultNumeric_MPIDense_MPIAIJ(Mat A,Mat B,Mat C)
4958 {
4959   PetscErrorCode ierr;
4960   Mat            At,Bt,Ct;
4961 
4962   PetscFunctionBegin;
4963   ierr = MatTranspose(A,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
4964   ierr = MatTranspose(B,MAT_INITIAL_MATRIX,&Bt);CHKERRQ(ierr);
4965   ierr = MatMatMult(Bt,At,MAT_INITIAL_MATRIX,1.0,&Ct);CHKERRQ(ierr);
4966   ierr = MatDestroy(&At);CHKERRQ(ierr);
4967   ierr = MatDestroy(&Bt);CHKERRQ(ierr);
4968   ierr = MatTranspose(Ct,MAT_REUSE_MATRIX,&C);CHKERRQ(ierr);
4969   ierr = MatDestroy(&Ct);CHKERRQ(ierr);
4970   PetscFunctionReturn(0);
4971 }
4972 
4973 #undef __FUNCT__
4974 #define __FUNCT__ "MatMatMultSymbolic_MPIDense_MPIAIJ"
4975 PetscErrorCode MatMatMultSymbolic_MPIDense_MPIAIJ(Mat A,Mat B,PetscReal fill,Mat *C)
4976 {
4977   PetscErrorCode ierr;
4978   PetscInt       m=A->rmap->n,n=B->cmap->n;
4979   Mat            Cmat;
4980 
4981   PetscFunctionBegin;
4982   if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n);
4983   ierr = MatCreate(PetscObjectComm((PetscObject)A),&Cmat);CHKERRQ(ierr);
4984   ierr = MatSetSizes(Cmat,m,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
4985   ierr = MatSetBlockSizesFromMats(Cmat,A,B);CHKERRQ(ierr);
4986   ierr = MatSetType(Cmat,MATMPIDENSE);CHKERRQ(ierr);
4987   ierr = MatMPIDenseSetPreallocation(Cmat,NULL);CHKERRQ(ierr);
4988   ierr = MatAssemblyBegin(Cmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4989   ierr = MatAssemblyEnd(Cmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4990 
4991   Cmat->ops->matmultnumeric = MatMatMultNumeric_MPIDense_MPIAIJ;
4992 
4993   *C = Cmat;
4994   PetscFunctionReturn(0);
4995 }
4996 
4997 /* ----------------------------------------------------------------*/
4998 #undef __FUNCT__
4999 #define __FUNCT__ "MatMatMult_MPIDense_MPIAIJ"
5000 PetscErrorCode MatMatMult_MPIDense_MPIAIJ(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
5001 {
5002   PetscErrorCode ierr;
5003 
5004   PetscFunctionBegin;
5005   if (scall == MAT_INITIAL_MATRIX) {
5006     ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
5007     ierr = MatMatMultSymbolic_MPIDense_MPIAIJ(A,B,fill,C);CHKERRQ(ierr);
5008     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
5009   }
5010   ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
5011   ierr = MatMatMultNumeric_MPIDense_MPIAIJ(A,B,*C);CHKERRQ(ierr);
5012   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
5013   PetscFunctionReturn(0);
5014 }
5015 
5016 /*MC
5017    MATMPIAIJ - MATMPIAIJ = "mpiaij" - A matrix type to be used for parallel sparse matrices.
5018 
5019    Options Database Keys:
5020 . -mat_type mpiaij - sets the matrix type to "mpiaij" during a call to MatSetFromOptions()
5021 
5022   Level: beginner
5023 
5024 .seealso: MatCreateAIJ()
5025 M*/
5026 
5027 #undef __FUNCT__
5028 #define __FUNCT__ "MatCreate_MPIAIJ"
5029 PETSC_EXTERN PetscErrorCode MatCreate_MPIAIJ(Mat B)
5030 {
5031   Mat_MPIAIJ     *b;
5032   PetscErrorCode ierr;
5033   PetscMPIInt    size;
5034 
5035   PetscFunctionBegin;
5036   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)B),&size);CHKERRQ(ierr);
5037 
5038   ierr          = PetscNewLog(B,&b);CHKERRQ(ierr);
5039   B->data       = (void*)b;
5040   ierr          = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
5041   B->assembled  = PETSC_FALSE;
5042   B->insertmode = NOT_SET_VALUES;
5043   b->size       = size;
5044 
5045   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)B),&b->rank);CHKERRQ(ierr);
5046 
5047   /* build cache for off array entries formed */
5048   ierr = MatStashCreate_Private(PetscObjectComm((PetscObject)B),1,&B->stash);CHKERRQ(ierr);
5049 
5050   b->donotstash  = PETSC_FALSE;
5051   b->colmap      = 0;
5052   b->garray      = 0;
5053   b->roworiented = PETSC_TRUE;
5054 
5055   /* stuff used for matrix vector multiply */
5056   b->lvec  = NULL;
5057   b->Mvctx = NULL;
5058 
5059   /* stuff for MatGetRow() */
5060   b->rowindices   = 0;
5061   b->rowvalues    = 0;
5062   b->getrowactive = PETSC_FALSE;
5063 
5064   /* flexible pointer used in CUSP/CUSPARSE classes */
5065   b->spptr = NULL;
5066 
5067   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMPIAIJSetUseScalableIncreaseOverlap_C",MatMPIAIJSetUseScalableIncreaseOverlap_MPIAIJ);CHKERRQ(ierr);
5068   ierr = PetscObjectComposeFunction((PetscObject)B,"MatStoreValues_C",MatStoreValues_MPIAIJ);CHKERRQ(ierr);
5069   ierr = PetscObjectComposeFunction((PetscObject)B,"MatRetrieveValues_C",MatRetrieveValues_MPIAIJ);CHKERRQ(ierr);
5070   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetDiagonalBlock_C",MatGetDiagonalBlock_MPIAIJ);CHKERRQ(ierr);
5071   ierr = PetscObjectComposeFunction((PetscObject)B,"MatIsTranspose_C",MatIsTranspose_MPIAIJ);CHKERRQ(ierr);
5072   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMPIAIJSetPreallocation_C",MatMPIAIJSetPreallocation_MPIAIJ);CHKERRQ(ierr);
5073   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMPIAIJSetPreallocationCSR_C",MatMPIAIJSetPreallocationCSR_MPIAIJ);CHKERRQ(ierr);
5074   ierr = PetscObjectComposeFunction((PetscObject)B,"MatDiagonalScaleLocal_C",MatDiagonalScaleLocal_MPIAIJ);CHKERRQ(ierr);
5075   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_mpiaij_mpiaijperm_C",MatConvert_MPIAIJ_MPIAIJPERM);CHKERRQ(ierr);
5076   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_mpiaij_mpiaijcrl_C",MatConvert_MPIAIJ_MPIAIJCRL);CHKERRQ(ierr);
5077   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_mpiaij_mpisbaij_C",MatConvert_MPIAIJ_MPISBAIJ);CHKERRQ(ierr);
5078 #if defined(PETSC_HAVE_ELEMENTAL)
5079   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_mpiaij_elemental_C",MatConvert_MPIAIJ_Elemental);CHKERRQ(ierr);
5080 #endif
5081   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMult_mpidense_mpiaij_C",MatMatMult_MPIDense_MPIAIJ);CHKERRQ(ierr);
5082   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultSymbolic_mpidense_mpiaij_C",MatMatMultSymbolic_MPIDense_MPIAIJ);CHKERRQ(ierr);
5083   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultNumeric_mpidense_mpiaij_C",MatMatMultNumeric_MPIDense_MPIAIJ);CHKERRQ(ierr);
5084   ierr = PetscObjectChangeTypeName((PetscObject)B,MATMPIAIJ);CHKERRQ(ierr);
5085   PetscFunctionReturn(0);
5086 }
5087 
5088 #undef __FUNCT__
5089 #define __FUNCT__ "MatCreateMPIAIJWithSplitArrays"
5090 /*@C
5091      MatCreateMPIAIJWithSplitArrays - creates a MPI AIJ matrix using arrays that contain the "diagonal"
5092          and "off-diagonal" part of the matrix in CSR format.
5093 
5094    Collective on MPI_Comm
5095 
5096    Input Parameters:
5097 +  comm - MPI communicator
5098 .  m - number of local rows (Cannot be PETSC_DECIDE)
5099 .  n - This value should be the same as the local size used in creating the
5100        x vector for the matrix-vector product y = Ax. (or PETSC_DECIDE to have
5101        calculated if N is given) For square matrices n is almost always m.
5102 .  M - number of global rows (or PETSC_DETERMINE to have calculated if m is given)
5103 .  N - number of global columns (or PETSC_DETERMINE to have calculated if n is given)
5104 .   i - row indices for "diagonal" portion of matrix
5105 .   j - column indices
5106 .   a - matrix values
5107 .   oi - row indices for "off-diagonal" portion of matrix
5108 .   oj - column indices
5109 -   oa - matrix values
5110 
5111    Output Parameter:
5112 .   mat - the matrix
5113 
5114    Level: advanced
5115 
5116    Notes:
5117        The i, j, and a arrays ARE NOT copied by this routine into the internal format used by PETSc. The user
5118        must free the arrays once the matrix has been destroyed and not before.
5119 
5120        The i and j indices are 0 based
5121 
5122        See MatCreateAIJ() for the definition of "diagonal" and "off-diagonal" portion of the matrix
5123 
5124        This sets local rows and cannot be used to set off-processor values.
5125 
5126        Use of this routine is discouraged because it is inflexible and cumbersome to use. It is extremely rare that a
5127        legacy application natively assembles into exactly this split format. The code to do so is nontrivial and does
5128        not easily support in-place reassembly. It is recommended to use MatSetValues() (or a variant thereof) because
5129        the resulting assembly is easier to implement, will work with any matrix format, and the user does not have to
5130        keep track of the underlying array. Use MatSetOption(A,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE) to disable all
5131        communication if it is known that only local entries will be set.
5132 
5133 .keywords: matrix, aij, compressed row, sparse, parallel
5134 
5135 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatMPIAIJSetPreallocation(), MatMPIAIJSetPreallocationCSR(),
5136           MPIAIJ, MatCreateAIJ(), MatCreateMPIAIJWithArrays()
5137 @*/
5138 PetscErrorCode  MatCreateMPIAIJWithSplitArrays(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,PetscInt i[],PetscInt j[],PetscScalar a[],PetscInt oi[], PetscInt oj[],PetscScalar oa[],Mat *mat)
5139 {
5140   PetscErrorCode ierr;
5141   Mat_MPIAIJ     *maij;
5142 
5143   PetscFunctionBegin;
5144   if (m < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"local number of rows (m) cannot be PETSC_DECIDE, or negative");
5145   if (i[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i (row indices) must start with 0");
5146   if (oi[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"oi (row indices) must start with 0");
5147   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
5148   ierr = MatSetSizes(*mat,m,n,M,N);CHKERRQ(ierr);
5149   ierr = MatSetType(*mat,MATMPIAIJ);CHKERRQ(ierr);
5150   maij = (Mat_MPIAIJ*) (*mat)->data;
5151 
5152   (*mat)->preallocated = PETSC_TRUE;
5153 
5154   ierr = PetscLayoutSetUp((*mat)->rmap);CHKERRQ(ierr);
5155   ierr = PetscLayoutSetUp((*mat)->cmap);CHKERRQ(ierr);
5156 
5157   ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,m,n,i,j,a,&maij->A);CHKERRQ(ierr);
5158   ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,m,(*mat)->cmap->N,oi,oj,oa,&maij->B);CHKERRQ(ierr);
5159 
5160   ierr = MatAssemblyBegin(maij->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5161   ierr = MatAssemblyEnd(maij->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5162   ierr = MatAssemblyBegin(maij->B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5163   ierr = MatAssemblyEnd(maij->B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5164 
5165   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5166   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5167   ierr = MatSetOption(*mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
5168   PetscFunctionReturn(0);
5169 }
5170 
5171 /*
5172     Special version for direct calls from Fortran
5173 */
5174 #include <petsc/private/fortranimpl.h>
5175 
5176 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5177 #define matsetvaluesmpiaij_ MATSETVALUESMPIAIJ
5178 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
5179 #define matsetvaluesmpiaij_ matsetvaluesmpiaij
5180 #endif
5181 
5182 /* Change these macros so can be used in void function */
5183 #undef CHKERRQ
5184 #define CHKERRQ(ierr) CHKERRABORT(PETSC_COMM_WORLD,ierr)
5185 #undef SETERRQ2
5186 #define SETERRQ2(comm,ierr,b,c,d) CHKERRABORT(comm,ierr)
5187 #undef SETERRQ3
5188 #define SETERRQ3(comm,ierr,b,c,d,e) CHKERRABORT(comm,ierr)
5189 #undef SETERRQ
5190 #define SETERRQ(c,ierr,b) CHKERRABORT(c,ierr)
5191 
5192 #undef __FUNCT__
5193 #define __FUNCT__ "matsetvaluesmpiaij_"
5194 PETSC_EXTERN void PETSC_STDCALL matsetvaluesmpiaij_(Mat *mmat,PetscInt *mm,const PetscInt im[],PetscInt *mn,const PetscInt in[],const PetscScalar v[],InsertMode *maddv,PetscErrorCode *_ierr)
5195 {
5196   Mat            mat  = *mmat;
5197   PetscInt       m    = *mm, n = *mn;
5198   InsertMode     addv = *maddv;
5199   Mat_MPIAIJ     *aij = (Mat_MPIAIJ*)mat->data;
5200   PetscScalar    value;
5201   PetscErrorCode ierr;
5202 
5203   MatCheckPreallocated(mat,1);
5204   if (mat->insertmode == NOT_SET_VALUES) mat->insertmode = addv;
5205 
5206 #if defined(PETSC_USE_DEBUG)
5207   else if (mat->insertmode != addv) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Cannot mix add values and insert values");
5208 #endif
5209   {
5210     PetscInt  i,j,rstart  = mat->rmap->rstart,rend = mat->rmap->rend;
5211     PetscInt  cstart      = mat->cmap->rstart,cend = mat->cmap->rend,row,col;
5212     PetscBool roworiented = aij->roworiented;
5213 
5214     /* Some Variables required in the macro */
5215     Mat        A                 = aij->A;
5216     Mat_SeqAIJ *a                = (Mat_SeqAIJ*)A->data;
5217     PetscInt   *aimax            = a->imax,*ai = a->i,*ailen = a->ilen,*aj = a->j;
5218     MatScalar  *aa               = a->a;
5219     PetscBool  ignorezeroentries = (((a->ignorezeroentries)&&(addv==ADD_VALUES)) ? PETSC_TRUE : PETSC_FALSE);
5220     Mat        B                 = aij->B;
5221     Mat_SeqAIJ *b                = (Mat_SeqAIJ*)B->data;
5222     PetscInt   *bimax            = b->imax,*bi = b->i,*bilen = b->ilen,*bj = b->j,bm = aij->B->rmap->n,am = aij->A->rmap->n;
5223     MatScalar  *ba               = b->a;
5224 
5225     PetscInt  *rp1,*rp2,ii,nrow1,nrow2,_i,rmax1,rmax2,N,low1,high1,low2,high2,t,lastcol1,lastcol2;
5226     PetscInt  nonew = a->nonew;
5227     MatScalar *ap1,*ap2;
5228 
5229     PetscFunctionBegin;
5230     for (i=0; i<m; i++) {
5231       if (im[i] < 0) continue;
5232 #if defined(PETSC_USE_DEBUG)
5233       if (im[i] >= mat->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",im[i],mat->rmap->N-1);
5234 #endif
5235       if (im[i] >= rstart && im[i] < rend) {
5236         row      = im[i] - rstart;
5237         lastcol1 = -1;
5238         rp1      = aj + ai[row];
5239         ap1      = aa + ai[row];
5240         rmax1    = aimax[row];
5241         nrow1    = ailen[row];
5242         low1     = 0;
5243         high1    = nrow1;
5244         lastcol2 = -1;
5245         rp2      = bj + bi[row];
5246         ap2      = ba + bi[row];
5247         rmax2    = bimax[row];
5248         nrow2    = bilen[row];
5249         low2     = 0;
5250         high2    = nrow2;
5251 
5252         for (j=0; j<n; j++) {
5253           if (roworiented) value = v[i*n+j];
5254           else value = v[i+j*m];
5255           if (ignorezeroentries && value == 0.0 && (addv == ADD_VALUES)) continue;
5256           if (in[j] >= cstart && in[j] < cend) {
5257             col = in[j] - cstart;
5258             MatSetValues_SeqAIJ_A_Private(row,col,value,addv,im[i],in[j]);
5259           } else if (in[j] < 0) continue;
5260 #if defined(PETSC_USE_DEBUG)
5261           else if (in[j] >= mat->cmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[j],mat->cmap->N-1);
5262 #endif
5263           else {
5264             if (mat->was_assembled) {
5265               if (!aij->colmap) {
5266                 ierr = MatCreateColmap_MPIAIJ_Private(mat);CHKERRQ(ierr);
5267               }
5268 #if defined(PETSC_USE_CTABLE)
5269               ierr = PetscTableFind(aij->colmap,in[j]+1,&col);CHKERRQ(ierr);
5270               col--;
5271 #else
5272               col = aij->colmap[in[j]] - 1;
5273 #endif
5274               if (col < 0 && !((Mat_SeqAIJ*)(aij->A->data))->nonew) {
5275                 ierr = MatDisAssemble_MPIAIJ(mat);CHKERRQ(ierr);
5276                 col  =  in[j];
5277                 /* Reinitialize the variables required by MatSetValues_SeqAIJ_B_Private() */
5278                 B     = aij->B;
5279                 b     = (Mat_SeqAIJ*)B->data;
5280                 bimax = b->imax; bi = b->i; bilen = b->ilen; bj = b->j;
5281                 rp2   = bj + bi[row];
5282                 ap2   = ba + bi[row];
5283                 rmax2 = bimax[row];
5284                 nrow2 = bilen[row];
5285                 low2  = 0;
5286                 high2 = nrow2;
5287                 bm    = aij->B->rmap->n;
5288                 ba    = b->a;
5289               }
5290             } else col = in[j];
5291             MatSetValues_SeqAIJ_B_Private(row,col,value,addv,im[i],in[j]);
5292           }
5293         }
5294       } else if (!aij->donotstash) {
5295         if (roworiented) {
5296           ierr = MatStashValuesRow_Private(&mat->stash,im[i],n,in,v+i*n,(PetscBool)(ignorezeroentries && (addv == ADD_VALUES)));CHKERRQ(ierr);
5297         } else {
5298           ierr = MatStashValuesCol_Private(&mat->stash,im[i],n,in,v+i,m,(PetscBool)(ignorezeroentries && (addv == ADD_VALUES)));CHKERRQ(ierr);
5299         }
5300       }
5301     }
5302   }
5303   PetscFunctionReturnVoid();
5304 }
5305 
5306