xref: /petsc/src/mat/impls/aij/seq/aij.c (revision 85740eac76d20a0cac9a36a21d5752ff4c70535a)
1 
2 /*
3     Defines the basic matrix operations for the AIJ (compressed row)
4   matrix storage format.
5 */
6 
7 
8 #include <../src/mat/impls/aij/seq/aij.h>          /*I "petscmat.h" I*/
9 #include <petscblaslapack.h>
10 #include <petscbt.h>
11 #include <petsc-private/kernels/blocktranspose.h>
12 #if defined(PETSC_THREADCOMM_ACTIVE)
13 #include <petscthreadcomm.h>
14 #endif
15 
16 #undef __FUNCT__
17 #define __FUNCT__ "MatGetColumnNorms_SeqAIJ"
18 PetscErrorCode MatGetColumnNorms_SeqAIJ(Mat A,NormType type,PetscReal *norms)
19 {
20   PetscErrorCode ierr;
21   PetscInt       i,m,n;
22   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)A->data;
23 
24   PetscFunctionBegin;
25   ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
26   ierr = PetscMemzero(norms,n*sizeof(PetscReal));CHKERRQ(ierr);
27   if (type == NORM_2) {
28     for (i=0; i<aij->i[m]; i++) {
29       norms[aij->j[i]] += PetscAbsScalar(aij->a[i]*aij->a[i]);
30     }
31   } else if (type == NORM_1) {
32     for (i=0; i<aij->i[m]; i++) {
33       norms[aij->j[i]] += PetscAbsScalar(aij->a[i]);
34     }
35   } else if (type == NORM_INFINITY) {
36     for (i=0; i<aij->i[m]; i++) {
37       norms[aij->j[i]] = PetscMax(PetscAbsScalar(aij->a[i]),norms[aij->j[i]]);
38     }
39   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown NormType");
40 
41   if (type == NORM_2) {
42     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
43   }
44   PetscFunctionReturn(0);
45 }
46 
47 #undef __FUNCT__
48 #define __FUNCT__ "MatFindZeroDiagonals_SeqAIJ_Private"
49 PetscErrorCode MatFindZeroDiagonals_SeqAIJ_Private(Mat A,PetscInt *nrows,PetscInt **zrows)
50 {
51   Mat_SeqAIJ      *a  = (Mat_SeqAIJ*)A->data;
52   const MatScalar *aa = a->a;
53   PetscInt        i,m=A->rmap->n,cnt = 0;
54   const PetscInt  *jj = a->j,*diag;
55   PetscInt        *rows;
56   PetscErrorCode  ierr;
57 
58   PetscFunctionBegin;
59   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
60   diag = a->diag;
61   for (i=0; i<m; i++) {
62     if ((jj[diag[i]] != i) || (aa[diag[i]] == 0.0)) {
63       cnt++;
64     }
65   }
66   ierr = PetscMalloc(cnt*sizeof(PetscInt),&rows);CHKERRQ(ierr);
67   cnt  = 0;
68   for (i=0; i<m; i++) {
69     if ((jj[diag[i]] != i) || (aa[diag[i]] == 0.0)) {
70       rows[cnt++] = i;
71     }
72   }
73   *nrows = cnt;
74   *zrows = rows;
75   PetscFunctionReturn(0);
76 }
77 
78 #undef __FUNCT__
79 #define __FUNCT__ "MatFindZeroDiagonals_SeqAIJ"
80 PetscErrorCode MatFindZeroDiagonals_SeqAIJ(Mat A,IS *zrows)
81 {
82   PetscInt       nrows,*rows;
83   PetscErrorCode ierr;
84 
85   PetscFunctionBegin;
86   *zrows = NULL;
87   ierr   = MatFindZeroDiagonals_SeqAIJ_Private(A,&nrows,&rows);CHKERRQ(ierr);
88   ierr   = ISCreateGeneral(PetscObjectComm((PetscObject)A),nrows,rows,PETSC_OWN_POINTER,zrows);CHKERRQ(ierr);
89   PetscFunctionReturn(0);
90 }
91 
92 #undef __FUNCT__
93 #define __FUNCT__ "MatFindNonzeroRows_SeqAIJ"
94 PetscErrorCode MatFindNonzeroRows_SeqAIJ(Mat A,IS *keptrows)
95 {
96   Mat_SeqAIJ      *a = (Mat_SeqAIJ*)A->data;
97   const MatScalar *aa;
98   PetscInt        m=A->rmap->n,cnt = 0;
99   const PetscInt  *ii;
100   PetscInt        n,i,j,*rows;
101   PetscErrorCode  ierr;
102 
103   PetscFunctionBegin;
104   *keptrows = 0;
105   ii        = a->i;
106   for (i=0; i<m; i++) {
107     n = ii[i+1] - ii[i];
108     if (!n) {
109       cnt++;
110       goto ok1;
111     }
112     aa = a->a + ii[i];
113     for (j=0; j<n; j++) {
114       if (aa[j] != 0.0) goto ok1;
115     }
116     cnt++;
117 ok1:;
118   }
119   if (!cnt) PetscFunctionReturn(0);
120   ierr = PetscMalloc((A->rmap->n-cnt)*sizeof(PetscInt),&rows);CHKERRQ(ierr);
121   cnt  = 0;
122   for (i=0; i<m; i++) {
123     n = ii[i+1] - ii[i];
124     if (!n) continue;
125     aa = a->a + ii[i];
126     for (j=0; j<n; j++) {
127       if (aa[j] != 0.0) {
128         rows[cnt++] = i;
129         break;
130       }
131     }
132   }
133   ierr = ISCreateGeneral(PETSC_COMM_SELF,cnt,rows,PETSC_OWN_POINTER,keptrows);CHKERRQ(ierr);
134   PetscFunctionReturn(0);
135 }
136 
137 #undef __FUNCT__
138 #define __FUNCT__ "MatDiagonalSet_SeqAIJ"
139 PetscErrorCode  MatDiagonalSet_SeqAIJ(Mat Y,Vec D,InsertMode is)
140 {
141   PetscErrorCode ierr;
142   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*) Y->data;
143   PetscInt       i,*diag, m = Y->rmap->n;
144   MatScalar      *aa = aij->a;
145   PetscScalar    *v;
146   PetscBool      missing;
147 
148   PetscFunctionBegin;
149   if (Y->assembled) {
150     ierr = MatMissingDiagonal_SeqAIJ(Y,&missing,NULL);CHKERRQ(ierr);
151     if (!missing) {
152       diag = aij->diag;
153       ierr = VecGetArray(D,&v);CHKERRQ(ierr);
154       if (is == INSERT_VALUES) {
155         for (i=0; i<m; i++) {
156           aa[diag[i]] = v[i];
157         }
158       } else {
159         for (i=0; i<m; i++) {
160           aa[diag[i]] += v[i];
161         }
162       }
163       ierr = VecRestoreArray(D,&v);CHKERRQ(ierr);
164       PetscFunctionReturn(0);
165     }
166     ierr = MatSeqAIJInvalidateDiagonal(Y);CHKERRQ(ierr);
167   }
168   ierr = MatDiagonalSet_Default(Y,D,is);CHKERRQ(ierr);
169   PetscFunctionReturn(0);
170 }
171 
172 #undef __FUNCT__
173 #define __FUNCT__ "MatGetRowIJ_SeqAIJ"
174 PetscErrorCode MatGetRowIJ_SeqAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *m,const PetscInt *ia[],const PetscInt *ja[],PetscBool  *done)
175 {
176   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
177   PetscErrorCode ierr;
178   PetscInt       i,ishift;
179 
180   PetscFunctionBegin;
181   *m = A->rmap->n;
182   if (!ia) PetscFunctionReturn(0);
183   ishift = 0;
184   if (symmetric && !A->structurally_symmetric) {
185     ierr = MatToSymmetricIJ_SeqAIJ(A->rmap->n,a->i,a->j,ishift,oshift,(PetscInt**)ia,(PetscInt**)ja);CHKERRQ(ierr);
186   } else if (oshift == 1) {
187     PetscInt *tia;
188     PetscInt nz = a->i[A->rmap->n];
189     /* malloc space and  add 1 to i and j indices */
190     ierr = PetscMalloc((A->rmap->n+1)*sizeof(PetscInt),&tia);CHKERRQ(ierr);
191     for (i=0; i<A->rmap->n+1; i++) tia[i] = a->i[i] + 1;
192     *ia = tia;
193     if (ja) {
194       PetscInt *tja;
195       ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&tja);CHKERRQ(ierr);
196       for (i=0; i<nz; i++) tja[i] = a->j[i] + 1;
197       *ja = tja;
198     }
199   } else {
200     *ia = a->i;
201     if (ja) *ja = a->j;
202   }
203   PetscFunctionReturn(0);
204 }
205 
206 #undef __FUNCT__
207 #define __FUNCT__ "MatRestoreRowIJ_SeqAIJ"
208 PetscErrorCode MatRestoreRowIJ_SeqAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *n,const PetscInt *ia[],const PetscInt *ja[],PetscBool  *done)
209 {
210   PetscErrorCode ierr;
211 
212   PetscFunctionBegin;
213   if (!ia) PetscFunctionReturn(0);
214   if ((symmetric && !A->structurally_symmetric) || oshift == 1) {
215     ierr = PetscFree(*ia);CHKERRQ(ierr);
216     if (ja) {ierr = PetscFree(*ja);CHKERRQ(ierr);}
217   }
218   PetscFunctionReturn(0);
219 }
220 
221 #undef __FUNCT__
222 #define __FUNCT__ "MatGetColumnIJ_SeqAIJ"
223 PetscErrorCode MatGetColumnIJ_SeqAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *nn,const PetscInt *ia[],const PetscInt *ja[],PetscBool  *done)
224 {
225   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
226   PetscErrorCode ierr;
227   PetscInt       i,*collengths,*cia,*cja,n = A->cmap->n,m = A->rmap->n;
228   PetscInt       nz = a->i[m],row,*jj,mr,col;
229 
230   PetscFunctionBegin;
231   *nn = n;
232   if (!ia) PetscFunctionReturn(0);
233   if (symmetric) {
234     ierr = MatToSymmetricIJ_SeqAIJ(A->rmap->n,a->i,a->j,0,oshift,(PetscInt**)ia,(PetscInt**)ja);CHKERRQ(ierr);
235   } else {
236     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&collengths);CHKERRQ(ierr);
237     ierr = PetscMemzero(collengths,n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&cia);CHKERRQ(ierr);
239     ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&cja);CHKERRQ(ierr);
240     jj   = a->j;
241     for (i=0; i<nz; i++) {
242       collengths[jj[i]]++;
243     }
244     cia[0] = oshift;
245     for (i=0; i<n; i++) {
246       cia[i+1] = cia[i] + collengths[i];
247     }
248     ierr = PetscMemzero(collengths,n*sizeof(PetscInt));CHKERRQ(ierr);
249     jj   = a->j;
250     for (row=0; row<m; row++) {
251       mr = a->i[row+1] - a->i[row];
252       for (i=0; i<mr; i++) {
253         col = *jj++;
254 
255         cja[cia[col] + collengths[col]++ - oshift] = row + oshift;
256       }
257     }
258     ierr = PetscFree(collengths);CHKERRQ(ierr);
259     *ia  = cia; *ja = cja;
260   }
261   PetscFunctionReturn(0);
262 }
263 
264 #undef __FUNCT__
265 #define __FUNCT__ "MatRestoreColumnIJ_SeqAIJ"
266 PetscErrorCode MatRestoreColumnIJ_SeqAIJ(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *n,const PetscInt *ia[],const PetscInt *ja[],PetscBool  *done)
267 {
268   PetscErrorCode ierr;
269 
270   PetscFunctionBegin;
271   if (!ia) PetscFunctionReturn(0);
272 
273   ierr = PetscFree(*ia);CHKERRQ(ierr);
274   ierr = PetscFree(*ja);CHKERRQ(ierr);
275   PetscFunctionReturn(0);
276 }
277 
278 /*
279  MatGetColumnIJ_SeqAIJ_Color() and MatRestoreColumnIJ_SeqAIJ_Color() are customized from
280  MatGetColumnIJ_SeqAIJ() and MatRestoreColumnIJ_SeqAIJ() by adding an output
281  spidx[], index of a->a, to be used in MatTransposeColoringCreate_SeqAIJ() and MatFDColoringCreate_SeqAIJ()
282 */
283 #undef __FUNCT__
284 #define __FUNCT__ "MatGetColumnIJ_SeqAIJ_Color"
285 PetscErrorCode MatGetColumnIJ_SeqAIJ_Color(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *nn,const PetscInt *ia[],const PetscInt *ja[],PetscInt *spidx[],PetscBool  *done)
286 {
287   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
288   PetscErrorCode ierr;
289   PetscInt       i,*collengths,*cia,*cja,n = A->cmap->n,m = A->rmap->n;
290   PetscInt       nz = a->i[m],row,*jj,mr,col;
291   PetscInt       *cspidx;
292 
293   PetscFunctionBegin;
294   *nn = n;
295   if (!ia) PetscFunctionReturn(0);
296   if (symmetric) {
297     SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"MatGetColumnIJ_SeqAIJ_Color() not supported for the case symmetric");
298     ierr = MatToSymmetricIJ_SeqAIJ(A->rmap->n,a->i,a->j,0,oshift,(PetscInt**)ia,(PetscInt**)ja);CHKERRQ(ierr);
299   } else {
300     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&collengths);CHKERRQ(ierr);
301     ierr = PetscMemzero(collengths,n*sizeof(PetscInt));CHKERRQ(ierr);
302     ierr = PetscMalloc((n+1)*sizeof(PetscInt),&cia);CHKERRQ(ierr);
303     ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&cja);CHKERRQ(ierr);
304     ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&cspidx);CHKERRQ(ierr);
305     jj   = a->j;
306     for (i=0; i<nz; i++) {
307       collengths[jj[i]]++;
308     }
309     cia[0] = oshift;
310     for (i=0; i<n; i++) {
311       cia[i+1] = cia[i] + collengths[i];
312     }
313     ierr = PetscMemzero(collengths,n*sizeof(PetscInt));CHKERRQ(ierr);
314     jj   = a->j;
315     for (row=0; row<m; row++) {
316       mr = a->i[row+1] - a->i[row];
317       for (i=0; i<mr; i++) {
318         col = *jj++;
319 
320         cspidx[cia[col] + collengths[col] - oshift] = a->i[row] + i; /* index of a->j */
321         cja[cia[col] + collengths[col]++ - oshift]  = row + oshift;
322       }
323     }
324     ierr   = PetscFree(collengths);CHKERRQ(ierr);
325     *ia    = cia; *ja = cja;
326     *spidx = cspidx;
327   }
328   PetscFunctionReturn(0);
329 }
330 
331 #undef __FUNCT__
332 #define __FUNCT__ "MatRestoreColumnIJ_SeqAIJ_Color"
333 PetscErrorCode MatRestoreColumnIJ_SeqAIJ_Color(Mat A,PetscInt oshift,PetscBool symmetric,PetscBool inodecompressed,PetscInt *n,const PetscInt *ia[],const PetscInt *ja[],PetscInt *spidx[],PetscBool  *done)
334 {
335   PetscErrorCode ierr;
336 
337   PetscFunctionBegin;
338   if (!ia) PetscFunctionReturn(0);
339 
340   ierr = PetscFree(*ia);CHKERRQ(ierr);
341   ierr = PetscFree(*ja);CHKERRQ(ierr);
342   ierr = PetscFree(*spidx);CHKERRQ(ierr);
343   PetscFunctionReturn(0);
344 }
345 
346 #undef __FUNCT__
347 #define __FUNCT__ "MatSetValuesRow_SeqAIJ"
348 PetscErrorCode MatSetValuesRow_SeqAIJ(Mat A,PetscInt row,const PetscScalar v[])
349 {
350   Mat_SeqAIJ     *a  = (Mat_SeqAIJ*)A->data;
351   PetscInt       *ai = a->i;
352   PetscErrorCode ierr;
353 
354   PetscFunctionBegin;
355   ierr = PetscMemcpy(a->a+ai[row],v,(ai[row+1]-ai[row])*sizeof(PetscScalar));CHKERRQ(ierr);
356   PetscFunctionReturn(0);
357 }
358 
359 #undef __FUNCT__
360 #define __FUNCT__ "MatSetValues_SeqAIJ"
361 PetscErrorCode MatSetValues_SeqAIJ(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],const PetscScalar v[],InsertMode is)
362 {
363   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
364   PetscInt       *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax,N;
365   PetscInt       *imax = a->imax,*ai = a->i,*ailen = a->ilen;
366   PetscErrorCode ierr;
367   PetscInt       *aj = a->j,nonew = a->nonew,lastcol = -1;
368   MatScalar      *ap,value,*aa = a->a;
369   PetscBool      ignorezeroentries = a->ignorezeroentries;
370   PetscBool      roworiented       = a->roworiented;
371 
372   PetscFunctionBegin;
373   if (v) PetscValidScalarPointer(v,6);
374   for (k=0; k<m; k++) { /* loop over added rows */
375     row = im[k];
376     if (row < 0) continue;
377 #if defined(PETSC_USE_DEBUG)
378     if (row >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",row,A->rmap->n-1);
379 #endif
380     rp   = aj + ai[row]; ap = aa + ai[row];
381     rmax = imax[row]; nrow = ailen[row];
382     low  = 0;
383     high = nrow;
384     for (l=0; l<n; l++) { /* loop over added columns */
385       if (in[l] < 0) continue;
386 #if defined(PETSC_USE_DEBUG)
387       if (in[l] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[l],A->cmap->n-1);
388 #endif
389       col = in[l];
390       if (v) {
391         if (roworiented) {
392           value = v[l + k*n];
393         } else {
394           value = v[k + l*m];
395         }
396       } else {
397         value = 0.;
398       }
399       if (value == 0.0 && ignorezeroentries && (is == ADD_VALUES)) continue;
400 
401       if (col <= lastcol) low = 0;
402       else high = nrow;
403       lastcol = col;
404       while (high-low > 5) {
405         t = (low+high)/2;
406         if (rp[t] > col) high = t;
407         else low = t;
408       }
409       for (i=low; i<high; i++) {
410         if (rp[i] > col) break;
411         if (rp[i] == col) {
412           if (is == ADD_VALUES) ap[i] += value;
413           else ap[i] = value;
414           low = i + 1;
415           goto noinsert;
416         }
417       }
418       if (value == 0.0 && ignorezeroentries) goto noinsert;
419       if (nonew == 1) goto noinsert;
420       if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero at (%D,%D) in the matrix",row,col);
421       MatSeqXAIJReallocateAIJ(A,A->rmap->n,1,nrow,row,col,rmax,aa,ai,aj,rp,ap,imax,nonew,MatScalar);
422       N = nrow++ - 1; a->nz++; high++;
423       /* shift up all the later entries in this row */
424       for (ii=N; ii>=i; ii--) {
425         rp[ii+1] = rp[ii];
426         ap[ii+1] = ap[ii];
427       }
428       rp[i] = col;
429       ap[i] = value;
430       low   = i + 1;
431 noinsert:;
432     }
433     ailen[row] = nrow;
434   }
435   A->same_nonzero = PETSC_FALSE;
436   PetscFunctionReturn(0);
437 }
438 
439 
440 #undef __FUNCT__
441 #define __FUNCT__ "MatGetValues_SeqAIJ"
442 PetscErrorCode MatGetValues_SeqAIJ(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],PetscScalar v[])
443 {
444   Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
445   PetscInt   *rp,k,low,high,t,row,nrow,i,col,l,*aj = a->j;
446   PetscInt   *ai = a->i,*ailen = a->ilen;
447   MatScalar  *ap,*aa = a->a;
448 
449   PetscFunctionBegin;
450   for (k=0; k<m; k++) { /* loop over rows */
451     row = im[k];
452     if (row < 0) {v += n; continue;} /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row: %D",row); */
453     if (row >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",row,A->rmap->n-1);
454     rp   = aj + ai[row]; ap = aa + ai[row];
455     nrow = ailen[row];
456     for (l=0; l<n; l++) { /* loop over columns */
457       if (in[l] < 0) {v++; continue;} /* SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column: %D",in[l]); */
458       if (in[l] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[l],A->cmap->n-1);
459       col  = in[l];
460       high = nrow; low = 0; /* assume unsorted */
461       while (high-low > 5) {
462         t = (low+high)/2;
463         if (rp[t] > col) high = t;
464         else low = t;
465       }
466       for (i=low; i<high; i++) {
467         if (rp[i] > col) break;
468         if (rp[i] == col) {
469           *v++ = ap[i];
470           goto finished;
471         }
472       }
473       *v++ = 0.0;
474 finished:;
475     }
476   }
477   PetscFunctionReturn(0);
478 }
479 
480 
481 #undef __FUNCT__
482 #define __FUNCT__ "MatView_SeqAIJ_Binary"
483 PetscErrorCode MatView_SeqAIJ_Binary(Mat A,PetscViewer viewer)
484 {
485   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
486   PetscErrorCode ierr;
487   PetscInt       i,*col_lens;
488   int            fd;
489   FILE           *file;
490 
491   PetscFunctionBegin;
492   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
493   ierr = PetscMalloc((4+A->rmap->n)*sizeof(PetscInt),&col_lens);CHKERRQ(ierr);
494 
495   col_lens[0] = MAT_FILE_CLASSID;
496   col_lens[1] = A->rmap->n;
497   col_lens[2] = A->cmap->n;
498   col_lens[3] = a->nz;
499 
500   /* store lengths of each row and write (including header) to file */
501   for (i=0; i<A->rmap->n; i++) {
502     col_lens[4+i] = a->i[i+1] - a->i[i];
503   }
504   ierr = PetscBinaryWrite(fd,col_lens,4+A->rmap->n,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
505   ierr = PetscFree(col_lens);CHKERRQ(ierr);
506 
507   /* store column indices (zero start index) */
508   ierr = PetscBinaryWrite(fd,a->j,a->nz,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
509 
510   /* store nonzero values */
511   ierr = PetscBinaryWrite(fd,a->a,a->nz,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
512 
513   ierr = PetscViewerBinaryGetInfoPointer(viewer,&file);CHKERRQ(ierr);
514   if (file) {
515     fprintf(file,"-matload_block_size %d\n",(int)A->rmap->bs);
516   }
517   PetscFunctionReturn(0);
518 }
519 
520 extern PetscErrorCode MatSeqAIJFactorInfo_Matlab(Mat,PetscViewer);
521 
522 #undef __FUNCT__
523 #define __FUNCT__ "MatView_SeqAIJ_ASCII"
524 PetscErrorCode MatView_SeqAIJ_ASCII(Mat A,PetscViewer viewer)
525 {
526   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
527   PetscErrorCode    ierr;
528   PetscInt          i,j,m = A->rmap->n,shift=0;
529   const char        *name;
530   PetscViewerFormat format;
531 
532   PetscFunctionBegin;
533   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
534   if (format == PETSC_VIEWER_ASCII_MATLAB) {
535     PetscInt nofinalvalue = 0;
536     if (m && ((a->i[m] == a->i[m-1]) || (a->j[a->nz-1] != A->cmap->n-!shift))) {
537       nofinalvalue = 1;
538     }
539     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
540     ierr = PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",m,A->cmap->n);CHKERRQ(ierr);
541     ierr = PetscViewerASCIIPrintf(viewer,"%% Nonzeros = %D \n",a->nz);CHKERRQ(ierr);
542     ierr = PetscViewerASCIIPrintf(viewer,"zzz = zeros(%D,3);\n",a->nz+nofinalvalue);CHKERRQ(ierr);
543     ierr = PetscViewerASCIIPrintf(viewer,"zzz = [\n");CHKERRQ(ierr);
544 
545     for (i=0; i<m; i++) {
546       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
547 #if defined(PETSC_USE_COMPLEX)
548         ierr = PetscViewerASCIIPrintf(viewer,"%D %D  %18.16e + %18.16ei \n",i+1,a->j[j]+!shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
549 #else
550         ierr = PetscViewerASCIIPrintf(viewer,"%D %D  %18.16e\n",i+1,a->j[j]+!shift,a->a[j]);CHKERRQ(ierr);
551 #endif
552       }
553     }
554     if (nofinalvalue) {
555       ierr = PetscViewerASCIIPrintf(viewer,"%D %D  %18.16e\n",m,A->cmap->n,0.0);CHKERRQ(ierr);
556     }
557     ierr = PetscObjectGetName((PetscObject)A,&name);CHKERRQ(ierr);
558     ierr = PetscViewerASCIIPrintf(viewer,"];\n %s = spconvert(zzz);\n",name);CHKERRQ(ierr);
559     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
560   } else if (format == PETSC_VIEWER_ASCII_FACTOR_INFO || format == PETSC_VIEWER_ASCII_INFO) {
561     PetscFunctionReturn(0);
562   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
563     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
564     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer);CHKERRQ(ierr);
565     for (i=0; i<m; i++) {
566       ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
567       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
568 #if defined(PETSC_USE_COMPLEX)
569         if (PetscImaginaryPart(a->a[j]) > 0.0 && PetscRealPart(a->a[j]) != 0.0) {
570           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
571         } else if (PetscImaginaryPart(a->a[j]) < 0.0 && PetscRealPart(a->a[j]) != 0.0) {
572           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),-PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
573         } else if (PetscRealPart(a->a[j]) != 0.0) {
574           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,PetscRealPart(a->a[j]));CHKERRQ(ierr);
575         }
576 #else
577         if (a->a[j] != 0.0) {ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,(double)a->a[j]);CHKERRQ(ierr);}
578 #endif
579       }
580       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
581     }
582     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
583   } else if (format == PETSC_VIEWER_ASCII_SYMMODU) {
584     PetscInt nzd=0,fshift=1,*sptr;
585     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
586     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer);CHKERRQ(ierr);
587     ierr = PetscMalloc((m+1)*sizeof(PetscInt),&sptr);CHKERRQ(ierr);
588     for (i=0; i<m; i++) {
589       sptr[i] = nzd+1;
590       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
591         if (a->j[j] >= i) {
592 #if defined(PETSC_USE_COMPLEX)
593           if (PetscImaginaryPart(a->a[j]) != 0.0 || PetscRealPart(a->a[j]) != 0.0) nzd++;
594 #else
595           if (a->a[j] != 0.0) nzd++;
596 #endif
597         }
598       }
599     }
600     sptr[m] = nzd+1;
601     ierr    = PetscViewerASCIIPrintf(viewer," %D %D\n\n",m,nzd);CHKERRQ(ierr);
602     for (i=0; i<m+1; i+=6) {
603       if (i+4<m) {
604         ierr = PetscViewerASCIIPrintf(viewer," %D %D %D %D %D %D\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3],sptr[i+4],sptr[i+5]);CHKERRQ(ierr);
605       } else if (i+3<m) {
606         ierr = PetscViewerASCIIPrintf(viewer," %D %D %D %D %D\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3],sptr[i+4]);CHKERRQ(ierr);
607       } else if (i+2<m) {
608         ierr = PetscViewerASCIIPrintf(viewer," %D %D %D %D\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3]);CHKERRQ(ierr);
609       } else if (i+1<m) {
610         ierr = PetscViewerASCIIPrintf(viewer," %D %D %D\n",sptr[i],sptr[i+1],sptr[i+2]);CHKERRQ(ierr);
611       } else if (i<m) {
612         ierr = PetscViewerASCIIPrintf(viewer," %D %D\n",sptr[i],sptr[i+1]);CHKERRQ(ierr);
613       } else {
614         ierr = PetscViewerASCIIPrintf(viewer," %D\n",sptr[i]);CHKERRQ(ierr);
615       }
616     }
617     ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
618     ierr = PetscFree(sptr);CHKERRQ(ierr);
619     for (i=0; i<m; i++) {
620       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
621         if (a->j[j] >= i) {ierr = PetscViewerASCIIPrintf(viewer," %D ",a->j[j]+fshift);CHKERRQ(ierr);}
622       }
623       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
624     }
625     ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
626     for (i=0; i<m; i++) {
627       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
628         if (a->j[j] >= i) {
629 #if defined(PETSC_USE_COMPLEX)
630           if (PetscImaginaryPart(a->a[j]) != 0.0 || PetscRealPart(a->a[j]) != 0.0) {
631             ierr = PetscViewerASCIIPrintf(viewer," %18.16e %18.16e ",PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
632           }
633 #else
634           if (a->a[j] != 0.0) {ierr = PetscViewerASCIIPrintf(viewer," %18.16e ",a->a[j]);CHKERRQ(ierr);}
635 #endif
636         }
637       }
638       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
639     }
640     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
641   } else if (format == PETSC_VIEWER_ASCII_DENSE) {
642     PetscInt    cnt = 0,jcnt;
643     PetscScalar value;
644 
645     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
646     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer);CHKERRQ(ierr);
647     for (i=0; i<m; i++) {
648       jcnt = 0;
649       for (j=0; j<A->cmap->n; j++) {
650         if (jcnt < a->i[i+1]-a->i[i] && j == a->j[cnt]) {
651           value = a->a[cnt++];
652           jcnt++;
653         } else {
654           value = 0.0;
655         }
656 #if defined(PETSC_USE_COMPLEX)
657         ierr = PetscViewerASCIIPrintf(viewer," %7.5e+%7.5e i ",PetscRealPart(value),PetscImaginaryPart(value));CHKERRQ(ierr);
658 #else
659         ierr = PetscViewerASCIIPrintf(viewer," %7.5e ",value);CHKERRQ(ierr);
660 #endif
661       }
662       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
663     }
664     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
665   } else if (format == PETSC_VIEWER_ASCII_MATRIXMARKET) {
666     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
667     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer);CHKERRQ(ierr);
668 #if defined(PETSC_USE_COMPLEX)
669     ierr = PetscViewerASCIIPrintf(viewer,"%%matrix complex general\n");CHKERRQ(ierr);
670 #else
671     ierr = PetscViewerASCIIPrintf(viewer,"%%matrix real general\n");CHKERRQ(ierr);
672 #endif
673     ierr = PetscViewerASCIIPrintf(viewer,"%D %D %D\n", m, A->cmap->n, a->nz);CHKERRQ(ierr);
674     for (i=0; i<m; i++) {
675       for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
676 #if defined(PETSC_USE_COMPLEX)
677         if (PetscImaginaryPart(a->a[j]) > 0.0) {
678           ierr = PetscViewerASCIIPrintf(viewer,"%D %D, %g %g\n", i+shift,a->j[j]+shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
679         } else if (PetscImaginaryPart(a->a[j]) < 0.0) {
680           ierr = PetscViewerASCIIPrintf(viewer,"%D %D, %g -%g\n", i+shift,a->j[j]+shift,PetscRealPart(a->a[j]),-PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
681         } else {
682           ierr = PetscViewerASCIIPrintf(viewer,"%D %D, %g\n", i+shift,a->j[j]+shift,PetscRealPart(a->a[j]));CHKERRQ(ierr);
683         }
684 #else
685         ierr = PetscViewerASCIIPrintf(viewer,"%D %D %g\n", i+shift, a->j[j]+shift, (double)a->a[j]);CHKERRQ(ierr);
686 #endif
687       }
688     }
689     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
690   } else {
691     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
692     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer);CHKERRQ(ierr);
693     if (A->factortype) {
694       for (i=0; i<m; i++) {
695         ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
696         /* L part */
697         for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
698 #if defined(PETSC_USE_COMPLEX)
699           if (PetscImaginaryPart(a->a[j]) > 0.0) {
700             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
701           } else if (PetscImaginaryPart(a->a[j]) < 0.0) {
702             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),-PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
703           } else {
704             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,PetscRealPart(a->a[j]));CHKERRQ(ierr);
705           }
706 #else
707           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,(double)a->a[j]);CHKERRQ(ierr);
708 #endif
709         }
710         /* diagonal */
711         j = a->diag[i];
712 #if defined(PETSC_USE_COMPLEX)
713         if (PetscImaginaryPart(a->a[j]) > 0.0) {
714           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i)",a->j[j]+shift,PetscRealPart(1.0/a->a[j]),PetscImaginaryPart(1.0/a->a[j]));CHKERRQ(ierr);
715         } else if (PetscImaginaryPart(a->a[j]) < 0.0) {
716           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i)",a->j[j]+shift,PetscRealPart(1.0/a->a[j]),-PetscImaginaryPart(1.0/a->a[j]));CHKERRQ(ierr);
717         } else {
718           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,PetscRealPart(1.0/a->a[j]));CHKERRQ(ierr);
719         }
720 #else
721         ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,(double)1.0/a->a[j]);CHKERRQ(ierr);
722 #endif
723 
724         /* U part */
725         for (j=a->diag[i+1]+1+shift; j<a->diag[i]+shift; j++) {
726 #if defined(PETSC_USE_COMPLEX)
727           if (PetscImaginaryPart(a->a[j]) > 0.0) {
728             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
729           } else if (PetscImaginaryPart(a->a[j]) < 0.0) {
730             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),-PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
731           } else {
732             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,PetscRealPart(a->a[j]));CHKERRQ(ierr);
733           }
734 #else
735           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,(double)a->a[j]);CHKERRQ(ierr);
736 #endif
737         }
738         ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
739       }
740     } else {
741       for (i=0; i<m; i++) {
742         ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
743         for (j=a->i[i]+shift; j<a->i[i+1]+shift; j++) {
744 #if defined(PETSC_USE_COMPLEX)
745           if (PetscImaginaryPart(a->a[j]) > 0.0) {
746             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g + %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
747           } else if (PetscImaginaryPart(a->a[j]) < 0.0) {
748             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g - %g i)",a->j[j]+shift,PetscRealPart(a->a[j]),-PetscImaginaryPart(a->a[j]));CHKERRQ(ierr);
749           } else {
750             ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,PetscRealPart(a->a[j]));CHKERRQ(ierr);
751           }
752 #else
753           ierr = PetscViewerASCIIPrintf(viewer," (%D, %g) ",a->j[j]+shift,(double)a->a[j]);CHKERRQ(ierr);
754 #endif
755         }
756         ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
757       }
758     }
759     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
760   }
761   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
762   PetscFunctionReturn(0);
763 }
764 
765 #include <petscdraw.h>
766 #undef __FUNCT__
767 #define __FUNCT__ "MatView_SeqAIJ_Draw_Zoom"
768 PetscErrorCode MatView_SeqAIJ_Draw_Zoom(PetscDraw draw,void *Aa)
769 {
770   Mat               A  = (Mat) Aa;
771   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
772   PetscErrorCode    ierr;
773   PetscInt          i,j,m = A->rmap->n,color;
774   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,maxv = 0.0;
775   PetscViewer       viewer;
776   PetscViewerFormat format;
777 
778   PetscFunctionBegin;
779   ierr = PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);CHKERRQ(ierr);
780   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
781 
782   ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
783   /* loop over matrix elements drawing boxes */
784 
785   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
786     /* Blue for negative, Cyan for zero and  Red for positive */
787     color = PETSC_DRAW_BLUE;
788     for (i=0; i<m; i++) {
789       y_l = m - i - 1.0; y_r = y_l + 1.0;
790       for (j=a->i[i]; j<a->i[i+1]; j++) {
791         x_l = a->j[j]; x_r = x_l + 1.0;
792         if (PetscRealPart(a->a[j]) >=  0.) continue;
793         ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
794       }
795     }
796     color = PETSC_DRAW_CYAN;
797     for (i=0; i<m; i++) {
798       y_l = m - i - 1.0; y_r = y_l + 1.0;
799       for (j=a->i[i]; j<a->i[i+1]; j++) {
800         x_l = a->j[j]; x_r = x_l + 1.0;
801         if (a->a[j] !=  0.) continue;
802         ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
803       }
804     }
805     color = PETSC_DRAW_RED;
806     for (i=0; i<m; i++) {
807       y_l = m - i - 1.0; y_r = y_l + 1.0;
808       for (j=a->i[i]; j<a->i[i+1]; j++) {
809         x_l = a->j[j]; x_r = x_l + 1.0;
810         if (PetscRealPart(a->a[j]) <=  0.) continue;
811         ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
812       }
813     }
814   } else {
815     /* use contour shading to indicate magnitude of values */
816     /* first determine max of all nonzero values */
817     PetscInt  nz = a->nz,count;
818     PetscDraw popup;
819     PetscReal scale;
820 
821     for (i=0; i<nz; i++) {
822       if (PetscAbsScalar(a->a[i]) > maxv) maxv = PetscAbsScalar(a->a[i]);
823     }
824     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
825     ierr  = PetscDrawGetPopup(draw,&popup);CHKERRQ(ierr);
826     if (popup) {
827       ierr = PetscDrawScalePopup(popup,0.0,maxv);CHKERRQ(ierr);
828     }
829     count = 0;
830     for (i=0; i<m; i++) {
831       y_l = m - i - 1.0; y_r = y_l + 1.0;
832       for (j=a->i[i]; j<a->i[i+1]; j++) {
833         x_l   = a->j[j]; x_r = x_l + 1.0;
834         color = PETSC_DRAW_BASIC_COLORS + (PetscInt)(scale*PetscAbsScalar(a->a[count]));
835         ierr  = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
836         count++;
837       }
838     }
839   }
840   PetscFunctionReturn(0);
841 }
842 
843 #include <petscdraw.h>
844 #undef __FUNCT__
845 #define __FUNCT__ "MatView_SeqAIJ_Draw"
846 PetscErrorCode MatView_SeqAIJ_Draw(Mat A,PetscViewer viewer)
847 {
848   PetscErrorCode ierr;
849   PetscDraw      draw;
850   PetscReal      xr,yr,xl,yl,h,w;
851   PetscBool      isnull;
852 
853   PetscFunctionBegin;
854   ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
855   ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
856   if (isnull) PetscFunctionReturn(0);
857 
858   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr);
859   xr   = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
860   xr  += w;    yr += h;  xl = -w;     yl = -h;
861   ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr);
862   ierr = PetscDrawZoom(draw,MatView_SeqAIJ_Draw_Zoom,A);CHKERRQ(ierr);
863   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",NULL);CHKERRQ(ierr);
864   PetscFunctionReturn(0);
865 }
866 
867 #undef __FUNCT__
868 #define __FUNCT__ "MatView_SeqAIJ"
869 PetscErrorCode MatView_SeqAIJ(Mat A,PetscViewer viewer)
870 {
871   PetscErrorCode ierr;
872   PetscBool      iascii,isbinary,isdraw;
873 
874   PetscFunctionBegin;
875   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
876   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
877   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
878   if (iascii) {
879     ierr = MatView_SeqAIJ_ASCII(A,viewer);CHKERRQ(ierr);
880   } else if (isbinary) {
881     ierr = MatView_SeqAIJ_Binary(A,viewer);CHKERRQ(ierr);
882   } else if (isdraw) {
883     ierr = MatView_SeqAIJ_Draw(A,viewer);CHKERRQ(ierr);
884   }
885   ierr = MatView_SeqAIJ_Inode(A,viewer);CHKERRQ(ierr);
886   PetscFunctionReturn(0);
887 }
888 
889 #undef __FUNCT__
890 #define __FUNCT__ "MatAssemblyEnd_SeqAIJ"
891 PetscErrorCode MatAssemblyEnd_SeqAIJ(Mat A,MatAssemblyType mode)
892 {
893   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
894   PetscErrorCode ierr;
895   PetscInt       fshift = 0,i,j,*ai = a->i,*aj = a->j,*imax = a->imax;
896   PetscInt       m      = A->rmap->n,*ip,N,*ailen = a->ilen,rmax = 0;
897   MatScalar      *aa    = a->a,*ap;
898   PetscReal      ratio  = 0.6;
899 
900   PetscFunctionBegin;
901   if (mode == MAT_FLUSH_ASSEMBLY) PetscFunctionReturn(0);
902 
903   if (m) rmax = ailen[0]; /* determine row with most nonzeros */
904   for (i=1; i<m; i++) {
905     /* move each row back by the amount of empty slots (fshift) before it*/
906     fshift += imax[i-1] - ailen[i-1];
907     rmax    = PetscMax(rmax,ailen[i]);
908     if (fshift) {
909       ip = aj + ai[i];
910       ap = aa + ai[i];
911       N  = ailen[i];
912       for (j=0; j<N; j++) {
913         ip[j-fshift] = ip[j];
914         ap[j-fshift] = ap[j];
915       }
916     }
917     ai[i] = ai[i-1] + ailen[i-1];
918   }
919   if (m) {
920     fshift += imax[m-1] - ailen[m-1];
921     ai[m]   = ai[m-1] + ailen[m-1];
922   }
923   /* reset ilen and imax for each row */
924   for (i=0; i<m; i++) {
925     ailen[i] = imax[i] = ai[i+1] - ai[i];
926   }
927   a->nz = ai[m];
928   if (fshift && a->nounused == -1) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Unused space detected in matrix: %D X %D, %D unneeded", m, A->cmap->n, fshift);
929 
930   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
931   ierr = PetscInfo4(A,"Matrix size: %D X %D; storage space: %D unneeded,%D used\n",m,A->cmap->n,fshift,a->nz);CHKERRQ(ierr);
932   ierr = PetscInfo1(A,"Number of mallocs during MatSetValues() is %D\n",a->reallocs);CHKERRQ(ierr);
933   ierr = PetscInfo1(A,"Maximum nonzeros in any row is %D\n",rmax);CHKERRQ(ierr);
934 
935   A->info.mallocs    += a->reallocs;
936   a->reallocs         = 0;
937   A->info.nz_unneeded = (double)fshift;
938   a->rmax             = rmax;
939 
940   ierr = MatCheckCompressedRow(A,&a->compressedrow,a->i,m,ratio);CHKERRQ(ierr);
941 
942   A->same_nonzero = PETSC_TRUE;
943 
944   ierr = MatAssemblyEnd_SeqAIJ_Inode(A,mode);CHKERRQ(ierr);
945 
946   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
947   PetscFunctionReturn(0);
948 }
949 
950 #undef __FUNCT__
951 #define __FUNCT__ "MatRealPart_SeqAIJ"
952 PetscErrorCode MatRealPart_SeqAIJ(Mat A)
953 {
954   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
955   PetscInt       i,nz = a->nz;
956   MatScalar      *aa = a->a;
957   PetscErrorCode ierr;
958 
959   PetscFunctionBegin;
960   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
961   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
962   PetscFunctionReturn(0);
963 }
964 
965 #undef __FUNCT__
966 #define __FUNCT__ "MatImaginaryPart_SeqAIJ"
967 PetscErrorCode MatImaginaryPart_SeqAIJ(Mat A)
968 {
969   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
970   PetscInt       i,nz = a->nz;
971   MatScalar      *aa = a->a;
972   PetscErrorCode ierr;
973 
974   PetscFunctionBegin;
975   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
976   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
977   PetscFunctionReturn(0);
978 }
979 
980 #if defined(PETSC_THREADCOMM_ACTIVE)
981 PetscErrorCode MatZeroEntries_SeqAIJ_Kernel(PetscInt thread_id,Mat A)
982 {
983   PetscErrorCode ierr;
984   PetscInt       *trstarts=A->rmap->trstarts;
985   PetscInt       n,start,end;
986   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
987 
988   start = trstarts[thread_id];
989   end   = trstarts[thread_id+1];
990   n     = a->i[end] - a->i[start];
991   ierr  = PetscMemzero(a->a+a->i[start],n*sizeof(PetscScalar));CHKERRQ(ierr);
992   return 0;
993 }
994 
995 #undef __FUNCT__
996 #define __FUNCT__ "MatZeroEntries_SeqAIJ"
997 PetscErrorCode MatZeroEntries_SeqAIJ(Mat A)
998 {
999   PetscErrorCode ierr;
1000 
1001   PetscFunctionBegin;
1002   ierr = PetscThreadCommRunKernel(PetscObjectComm((PetscObject)A),(PetscThreadKernel)MatZeroEntries_SeqAIJ_Kernel,1,A);CHKERRQ(ierr);
1003   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
1004   PetscFunctionReturn(0);
1005 }
1006 #else
1007 #undef __FUNCT__
1008 #define __FUNCT__ "MatZeroEntries_SeqAIJ"
1009 PetscErrorCode MatZeroEntries_SeqAIJ(Mat A)
1010 {
1011   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1012   PetscErrorCode ierr;
1013 
1014   PetscFunctionBegin;
1015   ierr = PetscMemzero(a->a,(a->i[A->rmap->n])*sizeof(PetscScalar));CHKERRQ(ierr);
1016   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
1017   PetscFunctionReturn(0);
1018 }
1019 #endif
1020 
1021 #undef __FUNCT__
1022 #define __FUNCT__ "MatDestroy_SeqAIJ"
1023 PetscErrorCode MatDestroy_SeqAIJ(Mat A)
1024 {
1025   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1026   PetscErrorCode ierr;
1027 
1028   PetscFunctionBegin;
1029 #if defined(PETSC_USE_LOG)
1030   PetscLogObjectState((PetscObject)A,"Rows=%D, Cols=%D, NZ=%D",A->rmap->n,A->cmap->n,a->nz);
1031 #endif
1032   ierr = MatSeqXAIJFreeAIJ(A,&a->a,&a->j,&a->i);CHKERRQ(ierr);
1033   ierr = ISDestroy(&a->row);CHKERRQ(ierr);
1034   ierr = ISDestroy(&a->col);CHKERRQ(ierr);
1035   ierr = PetscFree(a->diag);CHKERRQ(ierr);
1036   ierr = PetscFree(a->ibdiag);CHKERRQ(ierr);
1037   ierr = PetscFree2(a->imax,a->ilen);CHKERRQ(ierr);
1038   ierr = PetscFree3(a->idiag,a->mdiag,a->ssor_work);CHKERRQ(ierr);
1039   ierr = PetscFree(a->solve_work);CHKERRQ(ierr);
1040   ierr = ISDestroy(&a->icol);CHKERRQ(ierr);
1041   ierr = PetscFree(a->saved_values);CHKERRQ(ierr);
1042   ierr = ISColoringDestroy(&a->coloring);CHKERRQ(ierr);
1043   ierr = PetscFree(a->xtoy);CHKERRQ(ierr);
1044   ierr = MatDestroy(&a->XtoY);CHKERRQ(ierr);
1045   ierr = PetscFree2(a->compressedrow.i,a->compressedrow.rindex);CHKERRQ(ierr);
1046   ierr = PetscFree(a->matmult_abdense);CHKERRQ(ierr);
1047 
1048   ierr = MatDestroy_SeqAIJ_Inode(A);CHKERRQ(ierr);
1049   ierr = PetscFree(A->data);CHKERRQ(ierr);
1050 
1051   ierr = PetscObjectChangeTypeName((PetscObject)A,0);CHKERRQ(ierr);
1052   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqAIJSetColumnIndices_C",NULL);CHKERRQ(ierr);
1053   ierr = PetscObjectComposeFunction((PetscObject)A,"MatStoreValues_C",NULL);CHKERRQ(ierr);
1054   ierr = PetscObjectComposeFunction((PetscObject)A,"MatRetrieveValues_C",NULL);CHKERRQ(ierr);
1055   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqaij_seqsbaij_C",NULL);CHKERRQ(ierr);
1056   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqaij_seqbaij_C",NULL);CHKERRQ(ierr);
1057   ierr = PetscObjectComposeFunction((PetscObject)A,"MatConvert_seqaij_seqaijperm_C",NULL);CHKERRQ(ierr);
1058   ierr = PetscObjectComposeFunction((PetscObject)A,"MatIsTranspose_C",NULL);CHKERRQ(ierr);
1059   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqAIJSetPreallocation_C",NULL);CHKERRQ(ierr);
1060   ierr = PetscObjectComposeFunction((PetscObject)A,"MatSeqAIJSetPreallocationCSR_C",NULL);CHKERRQ(ierr);
1061   ierr = PetscObjectComposeFunction((PetscObject)A,"MatReorderForNonzeroDiagonal_C",NULL);CHKERRQ(ierr);
1062   PetscFunctionReturn(0);
1063 }
1064 
1065 #undef __FUNCT__
1066 #define __FUNCT__ "MatSetOption_SeqAIJ"
1067 PetscErrorCode MatSetOption_SeqAIJ(Mat A,MatOption op,PetscBool flg)
1068 {
1069   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1070   PetscErrorCode ierr;
1071 
1072   PetscFunctionBegin;
1073   switch (op) {
1074   case MAT_ROW_ORIENTED:
1075     a->roworiented = flg;
1076     break;
1077   case MAT_KEEP_NONZERO_PATTERN:
1078     a->keepnonzeropattern = flg;
1079     break;
1080   case MAT_NEW_NONZERO_LOCATIONS:
1081     a->nonew = (flg ? 0 : 1);
1082     break;
1083   case MAT_NEW_NONZERO_LOCATION_ERR:
1084     a->nonew = (flg ? -1 : 0);
1085     break;
1086   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1087     a->nonew = (flg ? -2 : 0);
1088     break;
1089   case MAT_UNUSED_NONZERO_LOCATION_ERR:
1090     a->nounused = (flg ? -1 : 0);
1091     break;
1092   case MAT_IGNORE_ZERO_ENTRIES:
1093     a->ignorezeroentries = flg;
1094     break;
1095   case MAT_CHECK_COMPRESSED_ROW:
1096     a->compressedrow.check = flg;
1097     break;
1098   case MAT_SPD:
1099   case MAT_SYMMETRIC:
1100   case MAT_STRUCTURALLY_SYMMETRIC:
1101   case MAT_HERMITIAN:
1102   case MAT_SYMMETRY_ETERNAL:
1103     /* These options are handled directly by MatSetOption() */
1104     break;
1105   case MAT_NEW_DIAGONALS:
1106   case MAT_IGNORE_OFF_PROC_ENTRIES:
1107   case MAT_USE_HASH_TABLE:
1108     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
1109     break;
1110   case MAT_USE_INODES:
1111     /* Not an error because MatSetOption_SeqAIJ_Inode handles this one */
1112     break;
1113   default:
1114     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %d",op);
1115   }
1116   ierr = MatSetOption_SeqAIJ_Inode(A,op,flg);CHKERRQ(ierr);
1117   PetscFunctionReturn(0);
1118 }
1119 
1120 #undef __FUNCT__
1121 #define __FUNCT__ "MatGetDiagonal_SeqAIJ"
1122 PetscErrorCode MatGetDiagonal_SeqAIJ(Mat A,Vec v)
1123 {
1124   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1125   PetscErrorCode ierr;
1126   PetscInt       i,j,n,*ai=a->i,*aj=a->j,nz;
1127   PetscScalar    *aa=a->a,*x,zero=0.0;
1128 
1129   PetscFunctionBegin;
1130   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
1131   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1132 
1133   if (A->factortype == MAT_FACTOR_ILU || A->factortype == MAT_FACTOR_LU) {
1134     PetscInt *diag=a->diag;
1135     ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1136     for (i=0; i<n; i++) x[i] = 1.0/aa[diag[i]];
1137     ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1138     PetscFunctionReturn(0);
1139   }
1140 
1141   ierr = VecSet(v,zero);CHKERRQ(ierr);
1142   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1143   for (i=0; i<n; i++) {
1144     nz = ai[i+1] - ai[i];
1145     if (!nz) x[i] = 0.0;
1146     for (j=ai[i]; j<ai[i+1]; j++) {
1147       if (aj[j] == i) {
1148         x[i] = aa[j];
1149         break;
1150       }
1151     }
1152   }
1153   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1154   PetscFunctionReturn(0);
1155 }
1156 
1157 #include <../src/mat/impls/aij/seq/ftn-kernels/fmult.h>
1158 #undef __FUNCT__
1159 #define __FUNCT__ "MatMultTransposeAdd_SeqAIJ"
1160 PetscErrorCode MatMultTransposeAdd_SeqAIJ(Mat A,Vec xx,Vec zz,Vec yy)
1161 {
1162   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1163   PetscScalar    *x,*y;
1164   PetscErrorCode ierr;
1165   PetscInt       m = A->rmap->n;
1166 #if !defined(PETSC_USE_FORTRAN_KERNEL_MULTTRANSPOSEAIJ)
1167   MatScalar         *v;
1168   PetscScalar       alpha;
1169   PetscInt          n,i,j,*idx,*ii,*ridx=NULL;
1170   Mat_CompressedRow cprow    = a->compressedrow;
1171   PetscBool         usecprow = cprow.use;
1172 #endif
1173 
1174   PetscFunctionBegin;
1175   if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);}
1176   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1177   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1178 
1179 #if defined(PETSC_USE_FORTRAN_KERNEL_MULTTRANSPOSEAIJ)
1180   fortranmulttransposeaddaij_(&m,x,a->i,a->j,a->a,y);
1181 #else
1182   if (usecprow) {
1183     m    = cprow.nrows;
1184     ii   = cprow.i;
1185     ridx = cprow.rindex;
1186   } else {
1187     ii = a->i;
1188   }
1189   for (i=0; i<m; i++) {
1190     idx = a->j + ii[i];
1191     v   = a->a + ii[i];
1192     n   = ii[i+1] - ii[i];
1193     if (usecprow) {
1194       alpha = x[ridx[i]];
1195     } else {
1196       alpha = x[i];
1197     }
1198     for (j=0; j<n; j++) y[idx[j]] += alpha*v[j];
1199   }
1200 #endif
1201   ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1202   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1203   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1204   PetscFunctionReturn(0);
1205 }
1206 
1207 #undef __FUNCT__
1208 #define __FUNCT__ "MatMultTranspose_SeqAIJ"
1209 PetscErrorCode MatMultTranspose_SeqAIJ(Mat A,Vec xx,Vec yy)
1210 {
1211   PetscErrorCode ierr;
1212 
1213   PetscFunctionBegin;
1214   ierr = VecSet(yy,0.0);CHKERRQ(ierr);
1215   ierr = MatMultTransposeAdd_SeqAIJ(A,xx,yy,yy);CHKERRQ(ierr);
1216   PetscFunctionReturn(0);
1217 }
1218 
1219 #include <../src/mat/impls/aij/seq/ftn-kernels/fmult.h>
1220 #if defined(PETSC_THREADCOMM_ACTIVE)
1221 PetscErrorCode MatMult_SeqAIJ_Kernel(PetscInt thread_id,Mat A,Vec xx,Vec yy)
1222 {
1223   PetscErrorCode    ierr;
1224   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1225   PetscScalar       *y;
1226   const PetscScalar *x;
1227   const MatScalar   *aa;
1228   PetscInt          *trstarts=A->rmap->trstarts;
1229   PetscInt          n,start,end,i;
1230   const PetscInt    *aj,*ai;
1231   PetscScalar       sum;
1232 
1233   ierr  = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1234   ierr  = VecGetArray(yy,&y);CHKERRQ(ierr);
1235   start = trstarts[thread_id];
1236   end   = trstarts[thread_id+1];
1237   aj    = a->j;
1238   aa    = a->a;
1239   ai    = a->i;
1240   for (i=start; i<end; i++) {
1241     n   = ai[i+1] - ai[i];
1242     aj  = a->j + ai[i];
1243     aa  = a->a + ai[i];
1244     sum = 0.0;
1245     PetscSparseDensePlusDot(sum,x,aa,aj,n);
1246     y[i] = sum;
1247   }
1248   ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1249   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1250   return 0;
1251 }
1252 
1253 #undef __FUNCT__
1254 #define __FUNCT__ "MatMult_SeqAIJ"
1255 PetscErrorCode MatMult_SeqAIJ(Mat A,Vec xx,Vec yy)
1256 {
1257   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1258   PetscScalar       *y;
1259   const PetscScalar *x;
1260   const MatScalar   *aa;
1261   PetscErrorCode    ierr;
1262   PetscInt          m=A->rmap->n;
1263   const PetscInt    *aj,*ii,*ridx=NULL;
1264   PetscInt          n,i,nonzerorow=0;
1265   PetscScalar       sum;
1266   PetscBool         usecprow=a->compressedrow.use;
1267 
1268 #if defined(PETSC_HAVE_PRAGMA_DISJOINT)
1269 #pragma disjoint(*x,*y,*aa)
1270 #endif
1271 
1272   PetscFunctionBegin;
1273   aj = a->j;
1274   aa = a->a;
1275   ii = a->i;
1276   if (usecprow) { /* use compressed row format */
1277     ierr = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1278     ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1279     m    = a->compressedrow.nrows;
1280     ii   = a->compressedrow.i;
1281     ridx = a->compressedrow.rindex;
1282     for (i=0; i<m; i++) {
1283       n           = ii[i+1] - ii[i];
1284       aj          = a->j + ii[i];
1285       aa          = a->a + ii[i];
1286       sum         = 0.0;
1287       nonzerorow += (n>0);
1288       PetscSparseDensePlusDot(sum,x,aa,aj,n);
1289       /* for (j=0; j<n; j++) sum += (*aa++)*x[*aj++]; */
1290       y[*ridx++] = sum;
1291     }
1292     ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1293     ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1294   } else { /* do not use compressed row format */
1295 #if defined(PETSC_USE_FORTRAN_KERNEL_MULTAIJ)
1296     fortranmultaij_(&m,x,ii,aj,aa,y);
1297 #else
1298     ierr = PetscThreadCommRunKernel(PetscObjectComm((PetscObject)A),(PetscThreadKernel)MatMult_SeqAIJ_Kernel,3,A,xx,yy);CHKERRQ(ierr);
1299 #endif
1300   }
1301   ierr = PetscLogFlops(2.0*a->nz - nonzerorow);CHKERRQ(ierr);
1302   PetscFunctionReturn(0);
1303 }
1304 #else
1305 #undef __FUNCT__
1306 #define __FUNCT__ "MatMult_SeqAIJ"
1307 PetscErrorCode MatMult_SeqAIJ(Mat A,Vec xx,Vec yy)
1308 {
1309   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1310   PetscScalar       *y;
1311   const PetscScalar *x;
1312   const MatScalar   *aa;
1313   PetscErrorCode    ierr;
1314   PetscInt          m=A->rmap->n;
1315   const PetscInt    *aj,*ii,*ridx=NULL;
1316   PetscInt          n,i,nonzerorow=0;
1317   PetscScalar       sum;
1318   PetscBool         usecprow=a->compressedrow.use;
1319 
1320 #if defined(PETSC_HAVE_PRAGMA_DISJOINT)
1321 #pragma disjoint(*x,*y,*aa)
1322 #endif
1323 
1324   PetscFunctionBegin;
1325   ierr = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1326   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1327   aj   = a->j;
1328   aa   = a->a;
1329   ii   = a->i;
1330   if (usecprow) { /* use compressed row format */
1331     m    = a->compressedrow.nrows;
1332     ii   = a->compressedrow.i;
1333     ridx = a->compressedrow.rindex;
1334     for (i=0; i<m; i++) {
1335       n           = ii[i+1] - ii[i];
1336       aj          = a->j + ii[i];
1337       aa          = a->a + ii[i];
1338       sum         = 0.0;
1339       nonzerorow += (n>0);
1340       PetscSparseDensePlusDot(sum,x,aa,aj,n);
1341       /* for (j=0; j<n; j++) sum += (*aa++)*x[*aj++]; */
1342       y[*ridx++] = sum;
1343     }
1344   } else { /* do not use compressed row format */
1345 #if defined(PETSC_USE_FORTRAN_KERNEL_MULTAIJ)
1346     fortranmultaij_(&m,x,ii,aj,aa,y);
1347 #else
1348 #if defined(PETSC_THREADCOMM_ACTIVE)
1349     ierr = PetscThreadCommRunKernel(PetscObjectComm((PetscObject)A),(PetscThreadKernel)MatMult_SeqAIJ_Kernel,3,A,xx,yy);CHKERRQ(ierr);
1350 #else
1351     for (i=0; i<m; i++) {
1352       n           = ii[i+1] - ii[i];
1353       aj          = a->j + ii[i];
1354       aa          = a->a + ii[i];
1355       sum         = 0.0;
1356       nonzerorow += (n>0);
1357       PetscSparseDensePlusDot(sum,x,aa,aj,n);
1358       y[i] = sum;
1359     }
1360 #endif
1361 #endif
1362   }
1363   ierr = PetscLogFlops(2.0*a->nz - nonzerorow);CHKERRQ(ierr);
1364   ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1365   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1366   PetscFunctionReturn(0);
1367 }
1368 #endif
1369 
1370 #undef __FUNCT__
1371 #define __FUNCT__ "MatMultMax_SeqAIJ"
1372 PetscErrorCode MatMultMax_SeqAIJ(Mat A,Vec xx,Vec yy)
1373 {
1374   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1375   PetscScalar       *y;
1376   const PetscScalar *x;
1377   const MatScalar   *aa;
1378   PetscErrorCode    ierr;
1379   PetscInt          m=A->rmap->n;
1380   const PetscInt    *aj,*ii,*ridx=NULL;
1381   PetscInt          n,i,nonzerorow=0;
1382   PetscScalar       sum;
1383   PetscBool         usecprow=a->compressedrow.use;
1384 
1385 #if defined(PETSC_HAVE_PRAGMA_DISJOINT)
1386 #pragma disjoint(*x,*y,*aa)
1387 #endif
1388 
1389   PetscFunctionBegin;
1390   ierr = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1391   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1392   aj   = a->j;
1393   aa   = a->a;
1394   ii   = a->i;
1395   if (usecprow) { /* use compressed row format */
1396     m    = a->compressedrow.nrows;
1397     ii   = a->compressedrow.i;
1398     ridx = a->compressedrow.rindex;
1399     for (i=0; i<m; i++) {
1400       n           = ii[i+1] - ii[i];
1401       aj          = a->j + ii[i];
1402       aa          = a->a + ii[i];
1403       sum         = 0.0;
1404       nonzerorow += (n>0);
1405       PetscSparseDenseMaxDot(sum,x,aa,aj,n);
1406       /* for (j=0; j<n; j++) sum += (*aa++)*x[*aj++]; */
1407       y[*ridx++] = sum;
1408     }
1409   } else { /* do not use compressed row format */
1410     for (i=0; i<m; i++) {
1411       n           = ii[i+1] - ii[i];
1412       aj          = a->j + ii[i];
1413       aa          = a->a + ii[i];
1414       sum         = 0.0;
1415       nonzerorow += (n>0);
1416       PetscSparseDenseMaxDot(sum,x,aa,aj,n);
1417       y[i] = sum;
1418     }
1419   }
1420   ierr = PetscLogFlops(2.0*a->nz - nonzerorow);CHKERRQ(ierr);
1421   ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1422   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1423   PetscFunctionReturn(0);
1424 }
1425 
1426 #undef __FUNCT__
1427 #define __FUNCT__ "MatMultAddMax_SeqAIJ"
1428 PetscErrorCode MatMultAddMax_SeqAIJ(Mat A,Vec xx,Vec yy,Vec zz)
1429 {
1430   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1431   PetscScalar       *y,*z;
1432   const PetscScalar *x;
1433   const MatScalar   *aa;
1434   PetscErrorCode    ierr;
1435   PetscInt          m = A->rmap->n,*aj,*ii;
1436   PetscInt          n,i,*ridx=NULL;
1437   PetscScalar       sum;
1438   PetscBool         usecprow=a->compressedrow.use;
1439 
1440   PetscFunctionBegin;
1441   ierr = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1442   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1443   if (zz != yy) {
1444     ierr = VecGetArray(zz,&z);CHKERRQ(ierr);
1445   } else {
1446     z = y;
1447   }
1448 
1449   aj = a->j;
1450   aa = a->a;
1451   ii = a->i;
1452   if (usecprow) { /* use compressed row format */
1453     if (zz != yy) {
1454       ierr = PetscMemcpy(z,y,m*sizeof(PetscScalar));CHKERRQ(ierr);
1455     }
1456     m    = a->compressedrow.nrows;
1457     ii   = a->compressedrow.i;
1458     ridx = a->compressedrow.rindex;
1459     for (i=0; i<m; i++) {
1460       n   = ii[i+1] - ii[i];
1461       aj  = a->j + ii[i];
1462       aa  = a->a + ii[i];
1463       sum = y[*ridx];
1464       PetscSparseDenseMaxDot(sum,x,aa,aj,n);
1465       z[*ridx++] = sum;
1466     }
1467   } else { /* do not use compressed row format */
1468     for (i=0; i<m; i++) {
1469       n   = ii[i+1] - ii[i];
1470       aj  = a->j + ii[i];
1471       aa  = a->a + ii[i];
1472       sum = y[i];
1473       PetscSparseDenseMaxDot(sum,x,aa,aj,n);
1474       z[i] = sum;
1475     }
1476   }
1477   ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1478   ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1479   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1480   if (zz != yy) {
1481     ierr = VecRestoreArray(zz,&z);CHKERRQ(ierr);
1482   }
1483   PetscFunctionReturn(0);
1484 }
1485 
1486 #include <../src/mat/impls/aij/seq/ftn-kernels/fmultadd.h>
1487 #undef __FUNCT__
1488 #define __FUNCT__ "MatMultAdd_SeqAIJ"
1489 PetscErrorCode MatMultAdd_SeqAIJ(Mat A,Vec xx,Vec yy,Vec zz)
1490 {
1491   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1492   PetscScalar       *y,*z;
1493   const PetscScalar *x;
1494   const MatScalar   *aa;
1495   PetscErrorCode    ierr;
1496   PetscInt          m = A->rmap->n,*aj,*ii;
1497   PetscInt          n,i,*ridx=NULL;
1498   PetscScalar       sum;
1499   PetscBool         usecprow=a->compressedrow.use;
1500 
1501   PetscFunctionBegin;
1502   ierr = VecGetArrayRead(xx,&x);CHKERRQ(ierr);
1503   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
1504   if (zz != yy) {
1505     ierr = VecGetArray(zz,&z);CHKERRQ(ierr);
1506   } else {
1507     z = y;
1508   }
1509 
1510   aj = a->j;
1511   aa = a->a;
1512   ii = a->i;
1513   if (usecprow) { /* use compressed row format */
1514     if (zz != yy) {
1515       ierr = PetscMemcpy(z,y,m*sizeof(PetscScalar));CHKERRQ(ierr);
1516     }
1517     m    = a->compressedrow.nrows;
1518     ii   = a->compressedrow.i;
1519     ridx = a->compressedrow.rindex;
1520     for (i=0; i<m; i++) {
1521       n   = ii[i+1] - ii[i];
1522       aj  = a->j + ii[i];
1523       aa  = a->a + ii[i];
1524       sum = y[*ridx];
1525       PetscSparseDensePlusDot(sum,x,aa,aj,n);
1526       z[*ridx++] = sum;
1527     }
1528   } else { /* do not use compressed row format */
1529 #if defined(PETSC_USE_FORTRAN_KERNEL_MULTADDAIJ)
1530     fortranmultaddaij_(&m,x,ii,aj,aa,y,z);
1531 #else
1532     for (i=0; i<m; i++) {
1533       n   = ii[i+1] - ii[i];
1534       aj  = a->j + ii[i];
1535       aa  = a->a + ii[i];
1536       sum = y[i];
1537       PetscSparseDensePlusDot(sum,x,aa,aj,n);
1538       z[i] = sum;
1539     }
1540 #endif
1541   }
1542   ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1543   ierr = VecRestoreArrayRead(xx,&x);CHKERRQ(ierr);
1544   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
1545   if (zz != yy) {
1546     ierr = VecRestoreArray(zz,&z);CHKERRQ(ierr);
1547   }
1548 #if defined(PETSC_HAVE_CUSP)
1549   /*
1550   ierr = VecView(xx,0);CHKERRQ(ierr);
1551   ierr = VecView(zz,0);CHKERRQ(ierr);
1552   ierr = MatView(A,0);CHKERRQ(ierr);
1553   */
1554 #endif
1555   PetscFunctionReturn(0);
1556 }
1557 
1558 /*
1559      Adds diagonal pointers to sparse matrix structure.
1560 */
1561 #undef __FUNCT__
1562 #define __FUNCT__ "MatMarkDiagonal_SeqAIJ"
1563 PetscErrorCode MatMarkDiagonal_SeqAIJ(Mat A)
1564 {
1565   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
1566   PetscErrorCode ierr;
1567   PetscInt       i,j,m = A->rmap->n;
1568 
1569   PetscFunctionBegin;
1570   if (!a->diag) {
1571     ierr = PetscMalloc(m*sizeof(PetscInt),&a->diag);CHKERRQ(ierr);
1572     ierr = PetscLogObjectMemory((PetscObject)A, m*sizeof(PetscInt));CHKERRQ(ierr);
1573   }
1574   for (i=0; i<A->rmap->n; i++) {
1575     a->diag[i] = a->i[i+1];
1576     for (j=a->i[i]; j<a->i[i+1]; j++) {
1577       if (a->j[j] == i) {
1578         a->diag[i] = j;
1579         break;
1580       }
1581     }
1582   }
1583   PetscFunctionReturn(0);
1584 }
1585 
1586 /*
1587      Checks for missing diagonals
1588 */
1589 #undef __FUNCT__
1590 #define __FUNCT__ "MatMissingDiagonal_SeqAIJ"
1591 PetscErrorCode MatMissingDiagonal_SeqAIJ(Mat A,PetscBool  *missing,PetscInt *d)
1592 {
1593   Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
1594   PetscInt   *diag,*jj = a->j,i;
1595 
1596   PetscFunctionBegin;
1597   *missing = PETSC_FALSE;
1598   if (A->rmap->n > 0 && !jj) {
1599     *missing = PETSC_TRUE;
1600     if (d) *d = 0;
1601     PetscInfo(A,"Matrix has no entries therefore is missing diagonal");
1602   } else {
1603     diag = a->diag;
1604     for (i=0; i<A->rmap->n; i++) {
1605       if (jj[diag[i]] != i) {
1606         *missing = PETSC_TRUE;
1607         if (d) *d = i;
1608         PetscInfo1(A,"Matrix is missing diagonal number %D",i);
1609         break;
1610       }
1611     }
1612   }
1613   PetscFunctionReturn(0);
1614 }
1615 
1616 #undef __FUNCT__
1617 #define __FUNCT__ "MatInvertDiagonal_SeqAIJ"
1618 PetscErrorCode  MatInvertDiagonal_SeqAIJ(Mat A,PetscScalar omega,PetscScalar fshift)
1619 {
1620   Mat_SeqAIJ     *a = (Mat_SeqAIJ*) A->data;
1621   PetscErrorCode ierr;
1622   PetscInt       i,*diag,m = A->rmap->n;
1623   MatScalar      *v = a->a;
1624   PetscScalar    *idiag,*mdiag;
1625 
1626   PetscFunctionBegin;
1627   if (a->idiagvalid) PetscFunctionReturn(0);
1628   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
1629   diag = a->diag;
1630   if (!a->idiag) {
1631     ierr = PetscMalloc3(m,PetscScalar,&a->idiag,m,PetscScalar,&a->mdiag,m,PetscScalar,&a->ssor_work);CHKERRQ(ierr);
1632     ierr = PetscLogObjectMemory((PetscObject)A, 3*m*sizeof(PetscScalar));CHKERRQ(ierr);
1633     v    = a->a;
1634   }
1635   mdiag = a->mdiag;
1636   idiag = a->idiag;
1637 
1638   if (omega == 1.0 && !PetscAbsScalar(fshift)) {
1639     for (i=0; i<m; i++) {
1640       mdiag[i] = v[diag[i]];
1641       if (!PetscAbsScalar(mdiag[i])) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Zero diagonal on row %D",i);
1642       idiag[i] = 1.0/v[diag[i]];
1643     }
1644     ierr = PetscLogFlops(m);CHKERRQ(ierr);
1645   } else {
1646     for (i=0; i<m; i++) {
1647       mdiag[i] = v[diag[i]];
1648       idiag[i] = omega/(fshift + v[diag[i]]);
1649     }
1650     ierr = PetscLogFlops(2.0*m);CHKERRQ(ierr);
1651   }
1652   a->idiagvalid = PETSC_TRUE;
1653   PetscFunctionReturn(0);
1654 }
1655 
1656 #include <../src/mat/impls/aij/seq/ftn-kernels/frelax.h>
1657 #undef __FUNCT__
1658 #define __FUNCT__ "MatSOR_SeqAIJ"
1659 PetscErrorCode MatSOR_SeqAIJ(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal fshift,PetscInt its,PetscInt lits,Vec xx)
1660 {
1661   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1662   PetscScalar       *x,d,sum,*t,scale;
1663   const MatScalar   *v = a->a,*idiag=0,*mdiag;
1664   const PetscScalar *b, *bs,*xb, *ts;
1665   PetscErrorCode    ierr;
1666   PetscInt          n = A->cmap->n,m = A->rmap->n,i;
1667   const PetscInt    *idx,*diag;
1668 
1669   PetscFunctionBegin;
1670   its = its*lits;
1671 
1672   if (fshift != a->fshift || omega != a->omega) a->idiagvalid = PETSC_FALSE; /* must recompute idiag[] */
1673   if (!a->idiagvalid) {ierr = MatInvertDiagonal_SeqAIJ(A,omega,fshift);CHKERRQ(ierr);}
1674   a->fshift = fshift;
1675   a->omega  = omega;
1676 
1677   diag  = a->diag;
1678   t     = a->ssor_work;
1679   idiag = a->idiag;
1680   mdiag = a->mdiag;
1681 
1682   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
1683   ierr = VecGetArrayRead(bb,&b);CHKERRQ(ierr);
1684   /* We count flops by assuming the upper triangular and lower triangular parts have the same number of nonzeros */
1685   if (flag == SOR_APPLY_UPPER) {
1686     /* apply (U + D/omega) to the vector */
1687     bs = b;
1688     for (i=0; i<m; i++) {
1689       d   = fshift + mdiag[i];
1690       n   = a->i[i+1] - diag[i] - 1;
1691       idx = a->j + diag[i] + 1;
1692       v   = a->a + diag[i] + 1;
1693       sum = b[i]*d/omega;
1694       PetscSparseDensePlusDot(sum,bs,v,idx,n);
1695       x[i] = sum;
1696     }
1697     ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1698     ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
1699     ierr = PetscLogFlops(a->nz);CHKERRQ(ierr);
1700     PetscFunctionReturn(0);
1701   }
1702 
1703   if (flag == SOR_APPLY_LOWER) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"SOR_APPLY_LOWER is not implemented");
1704   else if (flag & SOR_EISENSTAT) {
1705     /* Let  A = L + U + D; where L is lower trianglar,
1706     U is upper triangular, E = D/omega; This routine applies
1707 
1708             (L + E)^{-1} A (U + E)^{-1}
1709 
1710     to a vector efficiently using Eisenstat's trick.
1711     */
1712     scale = (2.0/omega) - 1.0;
1713 
1714     /*  x = (E + U)^{-1} b */
1715     for (i=m-1; i>=0; i--) {
1716       n   = a->i[i+1] - diag[i] - 1;
1717       idx = a->j + diag[i] + 1;
1718       v   = a->a + diag[i] + 1;
1719       sum = b[i];
1720       PetscSparseDenseMinusDot(sum,x,v,idx,n);
1721       x[i] = sum*idiag[i];
1722     }
1723 
1724     /*  t = b - (2*E - D)x */
1725     v = a->a;
1726     for (i=0; i<m; i++) t[i] = b[i] - scale*(v[*diag++])*x[i];
1727 
1728     /*  t = (E + L)^{-1}t */
1729     ts   = t;
1730     diag = a->diag;
1731     for (i=0; i<m; i++) {
1732       n   = diag[i] - a->i[i];
1733       idx = a->j + a->i[i];
1734       v   = a->a + a->i[i];
1735       sum = t[i];
1736       PetscSparseDenseMinusDot(sum,ts,v,idx,n);
1737       t[i] = sum*idiag[i];
1738       /*  x = x + t */
1739       x[i] += t[i];
1740     }
1741 
1742     ierr = PetscLogFlops(6.0*m-1 + 2.0*a->nz);CHKERRQ(ierr);
1743     ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1744     ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
1745     PetscFunctionReturn(0);
1746   }
1747   if (flag & SOR_ZERO_INITIAL_GUESS) {
1748     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {
1749       for (i=0; i<m; i++) {
1750         n   = diag[i] - a->i[i];
1751         idx = a->j + a->i[i];
1752         v   = a->a + a->i[i];
1753         sum = b[i];
1754         PetscSparseDenseMinusDot(sum,x,v,idx,n);
1755         t[i] = sum;
1756         x[i] = sum*idiag[i];
1757       }
1758       xb   = t;
1759       ierr = PetscLogFlops(a->nz);CHKERRQ(ierr);
1760     } else xb = b;
1761     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {
1762       for (i=m-1; i>=0; i--) {
1763         n   = a->i[i+1] - diag[i] - 1;
1764         idx = a->j + diag[i] + 1;
1765         v   = a->a + diag[i] + 1;
1766         sum = xb[i];
1767         PetscSparseDenseMinusDot(sum,x,v,idx,n);
1768         if (xb == b) {
1769           x[i] = sum*idiag[i];
1770         } else {
1771           x[i] = (1-omega)*x[i] + sum*idiag[i];
1772         }
1773       }
1774       ierr = PetscLogFlops(a->nz);CHKERRQ(ierr);
1775     }
1776     its--;
1777   }
1778   while (its--) {
1779     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {
1780       for (i=0; i<m; i++) {
1781         n   = a->i[i+1] - a->i[i];
1782         idx = a->j + a->i[i];
1783         v   = a->a + a->i[i];
1784         sum = b[i];
1785         PetscSparseDenseMinusDot(sum,x,v,idx,n);
1786         x[i] = (1. - omega)*x[i] + (sum + mdiag[i]*x[i])*idiag[i];
1787       }
1788       ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1789     }
1790     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {
1791       for (i=m-1; i>=0; i--) {
1792         n   = a->i[i+1] - a->i[i];
1793         idx = a->j + a->i[i];
1794         v   = a->a + a->i[i];
1795         sum = b[i];
1796         PetscSparseDenseMinusDot(sum,x,v,idx,n);
1797         x[i] = (1. - omega)*x[i] + (sum + mdiag[i]*x[i])*idiag[i];
1798       }
1799       ierr = PetscLogFlops(2.0*a->nz);CHKERRQ(ierr);
1800     }
1801   }
1802   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
1803   ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
1804   PetscFunctionReturn(0);
1805 }
1806 
1807 
1808 #undef __FUNCT__
1809 #define __FUNCT__ "MatGetInfo_SeqAIJ"
1810 PetscErrorCode MatGetInfo_SeqAIJ(Mat A,MatInfoType flag,MatInfo *info)
1811 {
1812   Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
1813 
1814   PetscFunctionBegin;
1815   info->block_size   = 1.0;
1816   info->nz_allocated = (double)a->maxnz;
1817   info->nz_used      = (double)a->nz;
1818   info->nz_unneeded  = (double)(a->maxnz - a->nz);
1819   info->assemblies   = (double)A->num_ass;
1820   info->mallocs      = (double)A->info.mallocs;
1821   info->memory       = ((PetscObject)A)->mem;
1822   if (A->factortype) {
1823     info->fill_ratio_given  = A->info.fill_ratio_given;
1824     info->fill_ratio_needed = A->info.fill_ratio_needed;
1825     info->factor_mallocs    = A->info.factor_mallocs;
1826   } else {
1827     info->fill_ratio_given  = 0;
1828     info->fill_ratio_needed = 0;
1829     info->factor_mallocs    = 0;
1830   }
1831   PetscFunctionReturn(0);
1832 }
1833 
1834 #undef __FUNCT__
1835 #define __FUNCT__ "MatZeroRows_SeqAIJ"
1836 PetscErrorCode MatZeroRows_SeqAIJ(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1837 {
1838   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1839   PetscInt          i,m = A->rmap->n - 1,d = 0;
1840   PetscErrorCode    ierr;
1841   const PetscScalar *xx;
1842   PetscScalar       *bb;
1843   PetscBool         missing;
1844 
1845   PetscFunctionBegin;
1846   if (x && b) {
1847     ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
1848     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
1849     for (i=0; i<N; i++) {
1850       if (rows[i] < 0 || rows[i] > m) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range", rows[i]);
1851       bb[rows[i]] = diag*xx[rows[i]];
1852     }
1853     ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
1854     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
1855   }
1856 
1857   if (a->keepnonzeropattern) {
1858     for (i=0; i<N; i++) {
1859       if (rows[i] < 0 || rows[i] > m) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range", rows[i]);
1860       ierr = PetscMemzero(&a->a[a->i[rows[i]]],a->ilen[rows[i]]*sizeof(PetscScalar));CHKERRQ(ierr);
1861     }
1862     if (diag != 0.0) {
1863       ierr = MatMissingDiagonal_SeqAIJ(A,&missing,&d);CHKERRQ(ierr);
1864       if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry in row %D",d);
1865       for (i=0; i<N; i++) {
1866         a->a[a->diag[rows[i]]] = diag;
1867       }
1868     }
1869     A->same_nonzero = PETSC_TRUE;
1870   } else {
1871     if (diag != 0.0) {
1872       for (i=0; i<N; i++) {
1873         if (rows[i] < 0 || rows[i] > m) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range", rows[i]);
1874         if (a->ilen[rows[i]] > 0) {
1875           a->ilen[rows[i]]    = 1;
1876           a->a[a->i[rows[i]]] = diag;
1877           a->j[a->i[rows[i]]] = rows[i];
1878         } else { /* in case row was completely empty */
1879           ierr = MatSetValues_SeqAIJ(A,1,&rows[i],1,&rows[i],&diag,INSERT_VALUES);CHKERRQ(ierr);
1880         }
1881       }
1882     } else {
1883       for (i=0; i<N; i++) {
1884         if (rows[i] < 0 || rows[i] > m) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range", rows[i]);
1885         a->ilen[rows[i]] = 0;
1886       }
1887     }
1888     A->same_nonzero = PETSC_FALSE;
1889   }
1890   ierr = MatAssemblyEnd_SeqAIJ(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 #undef __FUNCT__
1895 #define __FUNCT__ "MatZeroRowsColumns_SeqAIJ"
1896 PetscErrorCode MatZeroRowsColumns_SeqAIJ(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1897 {
1898   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1899   PetscInt          i,j,m = A->rmap->n - 1,d = 0;
1900   PetscErrorCode    ierr;
1901   PetscBool         missing,*zeroed,vecs = PETSC_FALSE;
1902   const PetscScalar *xx;
1903   PetscScalar       *bb;
1904 
1905   PetscFunctionBegin;
1906   if (x && b) {
1907     ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
1908     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
1909     vecs = PETSC_TRUE;
1910   }
1911   ierr = PetscMalloc(A->rmap->n*sizeof(PetscBool),&zeroed);CHKERRQ(ierr);
1912   ierr = PetscMemzero(zeroed,A->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1913   for (i=0; i<N; i++) {
1914     if (rows[i] < 0 || rows[i] > m) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"row %D out of range", rows[i]);
1915     ierr = PetscMemzero(&a->a[a->i[rows[i]]],a->ilen[rows[i]]*sizeof(PetscScalar));CHKERRQ(ierr);
1916 
1917     zeroed[rows[i]] = PETSC_TRUE;
1918   }
1919   for (i=0; i<A->rmap->n; i++) {
1920     if (!zeroed[i]) {
1921       for (j=a->i[i]; j<a->i[i+1]; j++) {
1922         if (zeroed[a->j[j]]) {
1923           if (vecs) bb[i] -= a->a[j]*xx[a->j[j]];
1924           a->a[j] = 0.0;
1925         }
1926       }
1927     } else if (vecs) bb[i] = diag*xx[i];
1928   }
1929   if (x && b) {
1930     ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
1931     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
1932   }
1933   ierr = PetscFree(zeroed);CHKERRQ(ierr);
1934   if (diag != 0.0) {
1935     ierr = MatMissingDiagonal_SeqAIJ(A,&missing,&d);CHKERRQ(ierr);
1936     if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry in row %D",d);
1937     for (i=0; i<N; i++) {
1938       a->a[a->diag[rows[i]]] = diag;
1939     }
1940   }
1941   A->same_nonzero = PETSC_TRUE;
1942   ierr = MatAssemblyEnd_SeqAIJ(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1943   PetscFunctionReturn(0);
1944 }
1945 
1946 #undef __FUNCT__
1947 #define __FUNCT__ "MatGetRow_SeqAIJ"
1948 PetscErrorCode MatGetRow_SeqAIJ(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
1949 {
1950   Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
1951   PetscInt   *itmp;
1952 
1953   PetscFunctionBegin;
1954   if (row < 0 || row >= A->rmap->n) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D out of range",row);
1955 
1956   *nz = a->i[row+1] - a->i[row];
1957   if (v) *v = a->a + a->i[row];
1958   if (idx) {
1959     itmp = a->j + a->i[row];
1960     if (*nz) *idx = itmp;
1961     else *idx = 0;
1962   }
1963   PetscFunctionReturn(0);
1964 }
1965 
1966 /* remove this function? */
1967 #undef __FUNCT__
1968 #define __FUNCT__ "MatRestoreRow_SeqAIJ"
1969 PetscErrorCode MatRestoreRow_SeqAIJ(Mat A,PetscInt row,PetscInt *nz,PetscInt **idx,PetscScalar **v)
1970 {
1971   PetscFunctionBegin;
1972   PetscFunctionReturn(0);
1973 }
1974 
1975 #undef __FUNCT__
1976 #define __FUNCT__ "MatNorm_SeqAIJ"
1977 PetscErrorCode MatNorm_SeqAIJ(Mat A,NormType type,PetscReal *nrm)
1978 {
1979   Mat_SeqAIJ     *a  = (Mat_SeqAIJ*)A->data;
1980   MatScalar      *v  = a->a;
1981   PetscReal      sum = 0.0;
1982   PetscErrorCode ierr;
1983   PetscInt       i,j;
1984 
1985   PetscFunctionBegin;
1986   if (type == NORM_FROBENIUS) {
1987     for (i=0; i<a->nz; i++) {
1988       sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1989     }
1990     *nrm = PetscSqrtReal(sum);
1991   } else if (type == NORM_1) {
1992     PetscReal *tmp;
1993     PetscInt  *jj = a->j;
1994     ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscReal),&tmp);CHKERRQ(ierr);
1995     ierr = PetscMemzero(tmp,A->cmap->n*sizeof(PetscReal));CHKERRQ(ierr);
1996     *nrm = 0.0;
1997     for (j=0; j<a->nz; j++) {
1998       tmp[*jj++] += PetscAbsScalar(*v);  v++;
1999     }
2000     for (j=0; j<A->cmap->n; j++) {
2001       if (tmp[j] > *nrm) *nrm = tmp[j];
2002     }
2003     ierr = PetscFree(tmp);CHKERRQ(ierr);
2004   } else if (type == NORM_INFINITY) {
2005     *nrm = 0.0;
2006     for (j=0; j<A->rmap->n; j++) {
2007       v   = a->a + a->i[j];
2008       sum = 0.0;
2009       for (i=0; i<a->i[j+1]-a->i[j]; i++) {
2010         sum += PetscAbsScalar(*v); v++;
2011       }
2012       if (sum > *nrm) *nrm = sum;
2013     }
2014   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for two norm");
2015   PetscFunctionReturn(0);
2016 }
2017 
2018 /* Merged from MatGetSymbolicTranspose_SeqAIJ() - replace MatGetSymbolicTranspose_SeqAIJ()? */
2019 #undef __FUNCT__
2020 #define __FUNCT__ "MatTransposeSymbolic_SeqAIJ"
2021 PetscErrorCode MatTransposeSymbolic_SeqAIJ(Mat A,Mat *B)
2022 {
2023   PetscErrorCode ierr;
2024   PetscInt       i,j,anzj;
2025   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data,*b;
2026   PetscInt       an=A->cmap->N,am=A->rmap->N;
2027   PetscInt       *ati,*atj,*atfill,*ai=a->i,*aj=a->j;
2028 
2029   PetscFunctionBegin;
2030   /* Allocate space for symbolic transpose info and work array */
2031   ierr = PetscMalloc((an+1)*sizeof(PetscInt),&ati);CHKERRQ(ierr);
2032   ierr = PetscMalloc(ai[am]*sizeof(PetscInt),&atj);CHKERRQ(ierr);
2033   ierr = PetscMalloc(an*sizeof(PetscInt),&atfill);CHKERRQ(ierr);
2034   ierr = PetscMemzero(ati,(an+1)*sizeof(PetscInt));CHKERRQ(ierr);
2035 
2036   /* Walk through aj and count ## of non-zeros in each row of A^T. */
2037   /* Note: offset by 1 for fast conversion into csr format. */
2038   for (i=0;i<ai[am];i++) ati[aj[i]+1] += 1;
2039   /* Form ati for csr format of A^T. */
2040   for (i=0;i<an;i++) ati[i+1] += ati[i];
2041 
2042   /* Copy ati into atfill so we have locations of the next free space in atj */
2043   ierr = PetscMemcpy(atfill,ati,an*sizeof(PetscInt));CHKERRQ(ierr);
2044 
2045   /* Walk through A row-wise and mark nonzero entries of A^T. */
2046   for (i=0;i<am;i++) {
2047     anzj = ai[i+1] - ai[i];
2048     for (j=0;j<anzj;j++) {
2049       atj[atfill[*aj]] = i;
2050       atfill[*aj++]   += 1;
2051     }
2052   }
2053 
2054   /* Clean up temporary space and complete requests. */
2055   ierr = PetscFree(atfill);CHKERRQ(ierr);
2056   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),an,am,ati,atj,NULL,B);CHKERRQ(ierr);
2057 
2058   (*B)->rmap->bs = A->cmap->bs;
2059   (*B)->cmap->bs = A->rmap->bs;
2060 
2061   b          = (Mat_SeqAIJ*)((*B)->data);
2062   b->free_a  = PETSC_FALSE;
2063   b->free_ij = PETSC_TRUE;
2064   b->nonew   = 0;
2065   PetscFunctionReturn(0);
2066 }
2067 
2068 #undef __FUNCT__
2069 #define __FUNCT__ "MatTranspose_SeqAIJ"
2070 PetscErrorCode MatTranspose_SeqAIJ(Mat A,MatReuse reuse,Mat *B)
2071 {
2072   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
2073   Mat            C;
2074   PetscErrorCode ierr;
2075   PetscInt       i,*aj = a->j,*ai = a->i,m = A->rmap->n,len,*col;
2076   MatScalar      *array = a->a;
2077 
2078   PetscFunctionBegin;
2079   if (reuse == MAT_REUSE_MATRIX && A == *B && m != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Square matrix only for in-place");
2080 
2081   if (reuse == MAT_INITIAL_MATRIX || *B == A) {
2082     ierr = PetscMalloc((1+A->cmap->n)*sizeof(PetscInt),&col);CHKERRQ(ierr);
2083     ierr = PetscMemzero(col,(1+A->cmap->n)*sizeof(PetscInt));CHKERRQ(ierr);
2084 
2085     for (i=0; i<ai[m]; i++) col[aj[i]] += 1;
2086     ierr = MatCreate(PetscObjectComm((PetscObject)A),&C);CHKERRQ(ierr);
2087     ierr = MatSetSizes(C,A->cmap->n,m,A->cmap->n,m);CHKERRQ(ierr);
2088     ierr = MatSetBlockSizes(C,A->cmap->bs,A->rmap->bs);CHKERRQ(ierr);
2089     ierr = MatSetType(C,((PetscObject)A)->type_name);CHKERRQ(ierr);
2090     ierr = MatSeqAIJSetPreallocation_SeqAIJ(C,0,col);CHKERRQ(ierr);
2091     ierr = PetscFree(col);CHKERRQ(ierr);
2092   } else {
2093     C = *B;
2094   }
2095 
2096   for (i=0; i<m; i++) {
2097     len    = ai[i+1]-ai[i];
2098     ierr   = MatSetValues_SeqAIJ(C,len,aj,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
2099     array += len;
2100     aj    += len;
2101   }
2102   ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2103   ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2104 
2105   if (reuse == MAT_INITIAL_MATRIX || *B != A) {
2106     *B = C;
2107   } else {
2108     ierr = MatHeaderMerge(A,C);CHKERRQ(ierr);
2109   }
2110   PetscFunctionReturn(0);
2111 }
2112 
2113 #undef __FUNCT__
2114 #define __FUNCT__ "MatIsTranspose_SeqAIJ"
2115 PetscErrorCode  MatIsTranspose_SeqAIJ(Mat A,Mat B,PetscReal tol,PetscBool  *f)
2116 {
2117   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*) A->data,*bij = (Mat_SeqAIJ*) A->data;
2118   PetscInt       *adx,*bdx,*aii,*bii,*aptr,*bptr;
2119   MatScalar      *va,*vb;
2120   PetscErrorCode ierr;
2121   PetscInt       ma,na,mb,nb, i;
2122 
2123   PetscFunctionBegin;
2124   bij = (Mat_SeqAIJ*) B->data;
2125 
2126   ierr = MatGetSize(A,&ma,&na);CHKERRQ(ierr);
2127   ierr = MatGetSize(B,&mb,&nb);CHKERRQ(ierr);
2128   if (ma!=nb || na!=mb) {
2129     *f = PETSC_FALSE;
2130     PetscFunctionReturn(0);
2131   }
2132   aii  = aij->i; bii = bij->i;
2133   adx  = aij->j; bdx = bij->j;
2134   va   = aij->a; vb = bij->a;
2135   ierr = PetscMalloc(ma*sizeof(PetscInt),&aptr);CHKERRQ(ierr);
2136   ierr = PetscMalloc(mb*sizeof(PetscInt),&bptr);CHKERRQ(ierr);
2137   for (i=0; i<ma; i++) aptr[i] = aii[i];
2138   for (i=0; i<mb; i++) bptr[i] = bii[i];
2139 
2140   *f = PETSC_TRUE;
2141   for (i=0; i<ma; i++) {
2142     while (aptr[i]<aii[i+1]) {
2143       PetscInt    idc,idr;
2144       PetscScalar vc,vr;
2145       /* column/row index/value */
2146       idc = adx[aptr[i]];
2147       idr = bdx[bptr[idc]];
2148       vc  = va[aptr[i]];
2149       vr  = vb[bptr[idc]];
2150       if (i!=idr || PetscAbsScalar(vc-vr) > tol) {
2151         *f = PETSC_FALSE;
2152         goto done;
2153       } else {
2154         aptr[i]++;
2155         if (B || i!=idc) bptr[idc]++;
2156       }
2157     }
2158   }
2159 done:
2160   ierr = PetscFree(aptr);CHKERRQ(ierr);
2161   ierr = PetscFree(bptr);CHKERRQ(ierr);
2162   PetscFunctionReturn(0);
2163 }
2164 
2165 #undef __FUNCT__
2166 #define __FUNCT__ "MatIsHermitianTranspose_SeqAIJ"
2167 PetscErrorCode  MatIsHermitianTranspose_SeqAIJ(Mat A,Mat B,PetscReal tol,PetscBool  *f)
2168 {
2169   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*) A->data,*bij = (Mat_SeqAIJ*) A->data;
2170   PetscInt       *adx,*bdx,*aii,*bii,*aptr,*bptr;
2171   MatScalar      *va,*vb;
2172   PetscErrorCode ierr;
2173   PetscInt       ma,na,mb,nb, i;
2174 
2175   PetscFunctionBegin;
2176   bij = (Mat_SeqAIJ*) B->data;
2177 
2178   ierr = MatGetSize(A,&ma,&na);CHKERRQ(ierr);
2179   ierr = MatGetSize(B,&mb,&nb);CHKERRQ(ierr);
2180   if (ma!=nb || na!=mb) {
2181     *f = PETSC_FALSE;
2182     PetscFunctionReturn(0);
2183   }
2184   aii  = aij->i; bii = bij->i;
2185   adx  = aij->j; bdx = bij->j;
2186   va   = aij->a; vb = bij->a;
2187   ierr = PetscMalloc(ma*sizeof(PetscInt),&aptr);CHKERRQ(ierr);
2188   ierr = PetscMalloc(mb*sizeof(PetscInt),&bptr);CHKERRQ(ierr);
2189   for (i=0; i<ma; i++) aptr[i] = aii[i];
2190   for (i=0; i<mb; i++) bptr[i] = bii[i];
2191 
2192   *f = PETSC_TRUE;
2193   for (i=0; i<ma; i++) {
2194     while (aptr[i]<aii[i+1]) {
2195       PetscInt    idc,idr;
2196       PetscScalar vc,vr;
2197       /* column/row index/value */
2198       idc = adx[aptr[i]];
2199       idr = bdx[bptr[idc]];
2200       vc  = va[aptr[i]];
2201       vr  = vb[bptr[idc]];
2202       if (i!=idr || PetscAbsScalar(vc-PetscConj(vr)) > tol) {
2203         *f = PETSC_FALSE;
2204         goto done;
2205       } else {
2206         aptr[i]++;
2207         if (B || i!=idc) bptr[idc]++;
2208       }
2209     }
2210   }
2211 done:
2212   ierr = PetscFree(aptr);CHKERRQ(ierr);
2213   ierr = PetscFree(bptr);CHKERRQ(ierr);
2214   PetscFunctionReturn(0);
2215 }
2216 
2217 #undef __FUNCT__
2218 #define __FUNCT__ "MatIsSymmetric_SeqAIJ"
2219 PetscErrorCode MatIsSymmetric_SeqAIJ(Mat A,PetscReal tol,PetscBool  *f)
2220 {
2221   PetscErrorCode ierr;
2222 
2223   PetscFunctionBegin;
2224   ierr = MatIsTranspose_SeqAIJ(A,A,tol,f);CHKERRQ(ierr);
2225   PetscFunctionReturn(0);
2226 }
2227 
2228 #undef __FUNCT__
2229 #define __FUNCT__ "MatIsHermitian_SeqAIJ"
2230 PetscErrorCode MatIsHermitian_SeqAIJ(Mat A,PetscReal tol,PetscBool  *f)
2231 {
2232   PetscErrorCode ierr;
2233 
2234   PetscFunctionBegin;
2235   ierr = MatIsHermitianTranspose_SeqAIJ(A,A,tol,f);CHKERRQ(ierr);
2236   PetscFunctionReturn(0);
2237 }
2238 
2239 #undef __FUNCT__
2240 #define __FUNCT__ "MatDiagonalScale_SeqAIJ"
2241 PetscErrorCode MatDiagonalScale_SeqAIJ(Mat A,Vec ll,Vec rr)
2242 {
2243   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
2244   PetscScalar    *l,*r,x;
2245   MatScalar      *v;
2246   PetscErrorCode ierr;
2247   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,M,nz = a->nz,*jj;
2248 
2249   PetscFunctionBegin;
2250   if (ll) {
2251     /* The local size is used so that VecMPI can be passed to this routine
2252        by MatDiagonalScale_MPIAIJ */
2253     ierr = VecGetLocalSize(ll,&m);CHKERRQ(ierr);
2254     if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vector wrong length");
2255     ierr = VecGetArray(ll,&l);CHKERRQ(ierr);
2256     v    = a->a;
2257     for (i=0; i<m; i++) {
2258       x = l[i];
2259       M = a->i[i+1] - a->i[i];
2260       for (j=0; j<M; j++) (*v++) *= x;
2261     }
2262     ierr = VecRestoreArray(ll,&l);CHKERRQ(ierr);
2263     ierr = PetscLogFlops(nz);CHKERRQ(ierr);
2264   }
2265   if (rr) {
2266     ierr = VecGetLocalSize(rr,&n);CHKERRQ(ierr);
2267     if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vector wrong length");
2268     ierr = VecGetArray(rr,&r);CHKERRQ(ierr);
2269     v    = a->a; jj = a->j;
2270     for (i=0; i<nz; i++) (*v++) *= r[*jj++];
2271     ierr = VecRestoreArray(rr,&r);CHKERRQ(ierr);
2272     ierr = PetscLogFlops(nz);CHKERRQ(ierr);
2273   }
2274   ierr = MatSeqAIJInvalidateDiagonal(A);CHKERRQ(ierr);
2275   PetscFunctionReturn(0);
2276 }
2277 
2278 #undef __FUNCT__
2279 #define __FUNCT__ "MatGetSubMatrix_SeqAIJ"
2280 PetscErrorCode MatGetSubMatrix_SeqAIJ(Mat A,IS isrow,IS iscol,PetscInt csize,MatReuse scall,Mat *B)
2281 {
2282   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data,*c;
2283   PetscErrorCode ierr;
2284   PetscInt       *smap,i,k,kstart,kend,oldcols = A->cmap->n,*lens;
2285   PetscInt       row,mat_i,*mat_j,tcol,first,step,*mat_ilen,sum,lensi;
2286   const PetscInt *irow,*icol;
2287   PetscInt       nrows,ncols;
2288   PetscInt       *starts,*j_new,*i_new,*aj = a->j,*ai = a->i,ii,*ailen = a->ilen;
2289   MatScalar      *a_new,*mat_a;
2290   Mat            C;
2291   PetscBool      stride,sorted;
2292 
2293   PetscFunctionBegin;
2294   ierr = ISSorted(isrow,&sorted);CHKERRQ(ierr);
2295   if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"ISrow is not sorted");
2296   ierr = ISSorted(iscol,&sorted);CHKERRQ(ierr);
2297   if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"IScol is not sorted");
2298 
2299   ierr = ISGetIndices(isrow,&irow);CHKERRQ(ierr);
2300   ierr = ISGetLocalSize(isrow,&nrows);CHKERRQ(ierr);
2301   ierr = ISGetLocalSize(iscol,&ncols);CHKERRQ(ierr);
2302 
2303   ierr = ISStrideGetInfo(iscol,&first,&step);CHKERRQ(ierr);
2304   ierr = PetscObjectTypeCompare((PetscObject)iscol,ISSTRIDE,&stride);CHKERRQ(ierr);
2305   if (stride && step == 1) {
2306     /* special case of contiguous rows */
2307     ierr = PetscMalloc2(nrows,PetscInt,&lens,nrows,PetscInt,&starts);CHKERRQ(ierr);
2308     /* loop over new rows determining lens and starting points */
2309     for (i=0; i<nrows; i++) {
2310       kstart = ai[irow[i]];
2311       kend   = kstart + ailen[irow[i]];
2312       for (k=kstart; k<kend; k++) {
2313         if (aj[k] >= first) {
2314           starts[i] = k;
2315           break;
2316         }
2317       }
2318       sum = 0;
2319       while (k < kend) {
2320         if (aj[k++] >= first+ncols) break;
2321         sum++;
2322       }
2323       lens[i] = sum;
2324     }
2325     /* create submatrix */
2326     if (scall == MAT_REUSE_MATRIX) {
2327       PetscInt n_cols,n_rows;
2328       ierr = MatGetSize(*B,&n_rows,&n_cols);CHKERRQ(ierr);
2329       if (n_rows != nrows || n_cols != ncols) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Reused submatrix wrong size");
2330       ierr = MatZeroEntries(*B);CHKERRQ(ierr);
2331       C    = *B;
2332     } else {
2333       PetscInt rbs,cbs;
2334       ierr = MatCreate(PetscObjectComm((PetscObject)A),&C);CHKERRQ(ierr);
2335       ierr = MatSetSizes(C,nrows,ncols,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
2336       ierr = ISGetBlockSize(isrow,&rbs);CHKERRQ(ierr);
2337       ierr = ISGetBlockSize(iscol,&cbs);CHKERRQ(ierr);
2338       ierr = MatSetBlockSizes(C,rbs,cbs);CHKERRQ(ierr);
2339       ierr = MatSetType(C,((PetscObject)A)->type_name);CHKERRQ(ierr);
2340       ierr = MatSeqAIJSetPreallocation_SeqAIJ(C,0,lens);CHKERRQ(ierr);
2341     }
2342     c = (Mat_SeqAIJ*)C->data;
2343 
2344     /* loop over rows inserting into submatrix */
2345     a_new = c->a;
2346     j_new = c->j;
2347     i_new = c->i;
2348 
2349     for (i=0; i<nrows; i++) {
2350       ii    = starts[i];
2351       lensi = lens[i];
2352       for (k=0; k<lensi; k++) {
2353         *j_new++ = aj[ii+k] - first;
2354       }
2355       ierr       = PetscMemcpy(a_new,a->a + starts[i],lensi*sizeof(PetscScalar));CHKERRQ(ierr);
2356       a_new     += lensi;
2357       i_new[i+1] = i_new[i] + lensi;
2358       c->ilen[i] = lensi;
2359     }
2360     ierr = PetscFree2(lens,starts);CHKERRQ(ierr);
2361   } else {
2362     ierr = ISGetIndices(iscol,&icol);CHKERRQ(ierr);
2363     ierr = PetscMalloc(oldcols*sizeof(PetscInt),&smap);CHKERRQ(ierr);
2364     ierr = PetscMemzero(smap,oldcols*sizeof(PetscInt));CHKERRQ(ierr);
2365     ierr = PetscMalloc((1+nrows)*sizeof(PetscInt),&lens);CHKERRQ(ierr);
2366     for (i=0; i<ncols; i++) {
2367 #if defined(PETSC_USE_DEBUG)
2368       if (icol[i] >= oldcols) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Requesting column beyond largest column icol[%D] %D <= A->cmap->n %D",i,icol[i],oldcols);
2369 #endif
2370       smap[icol[i]] = i+1;
2371     }
2372 
2373     /* determine lens of each row */
2374     for (i=0; i<nrows; i++) {
2375       kstart  = ai[irow[i]];
2376       kend    = kstart + a->ilen[irow[i]];
2377       lens[i] = 0;
2378       for (k=kstart; k<kend; k++) {
2379         if (smap[aj[k]]) {
2380           lens[i]++;
2381         }
2382       }
2383     }
2384     /* Create and fill new matrix */
2385     if (scall == MAT_REUSE_MATRIX) {
2386       PetscBool equal;
2387 
2388       c = (Mat_SeqAIJ*)((*B)->data);
2389       if ((*B)->rmap->n  != nrows || (*B)->cmap->n != ncols) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size");
2390       ierr = PetscMemcmp(c->ilen,lens,(*B)->rmap->n*sizeof(PetscInt),&equal);CHKERRQ(ierr);
2391       if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong no of nonzeros");
2392       ierr = PetscMemzero(c->ilen,(*B)->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
2393       C    = *B;
2394     } else {
2395       PetscInt rbs,cbs;
2396       ierr = MatCreate(PetscObjectComm((PetscObject)A),&C);CHKERRQ(ierr);
2397       ierr = MatSetSizes(C,nrows,ncols,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
2398       ierr = ISGetBlockSize(isrow,&rbs);CHKERRQ(ierr);
2399       ierr = ISGetBlockSize(iscol,&cbs);CHKERRQ(ierr);
2400       ierr = MatSetBlockSizes(C,rbs,cbs);CHKERRQ(ierr);
2401       ierr = MatSetType(C,((PetscObject)A)->type_name);CHKERRQ(ierr);
2402       ierr = MatSeqAIJSetPreallocation_SeqAIJ(C,0,lens);CHKERRQ(ierr);
2403     }
2404     c = (Mat_SeqAIJ*)(C->data);
2405     for (i=0; i<nrows; i++) {
2406       row      = irow[i];
2407       kstart   = ai[row];
2408       kend     = kstart + a->ilen[row];
2409       mat_i    = c->i[i];
2410       mat_j    = c->j + mat_i;
2411       mat_a    = c->a + mat_i;
2412       mat_ilen = c->ilen + i;
2413       for (k=kstart; k<kend; k++) {
2414         if ((tcol=smap[a->j[k]])) {
2415           *mat_j++ = tcol - 1;
2416           *mat_a++ = a->a[k];
2417           (*mat_ilen)++;
2418 
2419         }
2420       }
2421     }
2422     /* Free work space */
2423     ierr = ISRestoreIndices(iscol,&icol);CHKERRQ(ierr);
2424     ierr = PetscFree(smap);CHKERRQ(ierr);
2425     ierr = PetscFree(lens);CHKERRQ(ierr);
2426   }
2427   ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2428   ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2429 
2430   ierr = ISRestoreIndices(isrow,&irow);CHKERRQ(ierr);
2431   *B   = C;
2432   PetscFunctionReturn(0);
2433 }
2434 
2435 #undef __FUNCT__
2436 #define __FUNCT__ "MatGetMultiProcBlock_SeqAIJ"
2437 PetscErrorCode  MatGetMultiProcBlock_SeqAIJ(Mat mat,MPI_Comm subComm,MatReuse scall,Mat *subMat)
2438 {
2439   PetscErrorCode ierr;
2440   Mat            B;
2441 
2442   PetscFunctionBegin;
2443   if (scall == MAT_INITIAL_MATRIX) {
2444     ierr    = MatCreate(subComm,&B);CHKERRQ(ierr);
2445     ierr    = MatSetSizes(B,mat->rmap->n,mat->cmap->n,mat->rmap->n,mat->cmap->n);CHKERRQ(ierr);
2446     ierr    = MatSetBlockSizes(B,mat->rmap->bs,mat->cmap->bs);CHKERRQ(ierr);
2447     ierr    = MatSetType(B,MATSEQAIJ);CHKERRQ(ierr);
2448     ierr    = MatDuplicateNoCreate_SeqAIJ(B,mat,MAT_COPY_VALUES,PETSC_TRUE);CHKERRQ(ierr);
2449     *subMat = B;
2450   } else {
2451     ierr = MatCopy_SeqAIJ(mat,*subMat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
2452   }
2453   PetscFunctionReturn(0);
2454 }
2455 
2456 #undef __FUNCT__
2457 #define __FUNCT__ "MatILUFactor_SeqAIJ"
2458 PetscErrorCode MatILUFactor_SeqAIJ(Mat inA,IS row,IS col,const MatFactorInfo *info)
2459 {
2460   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)inA->data;
2461   PetscErrorCode ierr;
2462   Mat            outA;
2463   PetscBool      row_identity,col_identity;
2464 
2465   PetscFunctionBegin;
2466   if (info->levels != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only levels=0 supported for in-place ilu");
2467 
2468   ierr = ISIdentity(row,&row_identity);CHKERRQ(ierr);
2469   ierr = ISIdentity(col,&col_identity);CHKERRQ(ierr);
2470 
2471   outA             = inA;
2472   outA->factortype = MAT_FACTOR_LU;
2473 
2474   ierr = PetscObjectReference((PetscObject)row);CHKERRQ(ierr);
2475   ierr = ISDestroy(&a->row);CHKERRQ(ierr);
2476 
2477   a->row = row;
2478 
2479   ierr = PetscObjectReference((PetscObject)col);CHKERRQ(ierr);
2480   ierr = ISDestroy(&a->col);CHKERRQ(ierr);
2481 
2482   a->col = col;
2483 
2484   /* Create the inverse permutation so that it can be used in MatLUFactorNumeric() */
2485   ierr = ISDestroy(&a->icol);CHKERRQ(ierr);
2486   ierr = ISInvertPermutation(col,PETSC_DECIDE,&a->icol);CHKERRQ(ierr);
2487   ierr = PetscLogObjectParent((PetscObject)inA,(PetscObject)a->icol);CHKERRQ(ierr);
2488 
2489   if (!a->solve_work) { /* this matrix may have been factored before */
2490     ierr = PetscMalloc((inA->rmap->n+1)*sizeof(PetscScalar),&a->solve_work);CHKERRQ(ierr);
2491     ierr = PetscLogObjectMemory((PetscObject)inA, (inA->rmap->n+1)*sizeof(PetscScalar));CHKERRQ(ierr);
2492   }
2493 
2494   ierr = MatMarkDiagonal_SeqAIJ(inA);CHKERRQ(ierr);
2495   if (row_identity && col_identity) {
2496     ierr = MatLUFactorNumeric_SeqAIJ_inplace(outA,inA,info);CHKERRQ(ierr);
2497   } else {
2498     ierr = MatLUFactorNumeric_SeqAIJ_InplaceWithPerm(outA,inA,info);CHKERRQ(ierr);
2499   }
2500   PetscFunctionReturn(0);
2501 }
2502 
2503 #undef __FUNCT__
2504 #define __FUNCT__ "MatScale_SeqAIJ"
2505 PetscErrorCode MatScale_SeqAIJ(Mat inA,PetscScalar alpha)
2506 {
2507   Mat_SeqAIJ     *a     = (Mat_SeqAIJ*)inA->data;
2508   PetscScalar    oalpha = alpha;
2509   PetscErrorCode ierr;
2510   PetscBLASInt   one = 1,bnz;
2511 
2512   PetscFunctionBegin;
2513   ierr = PetscBLASIntCast(a->nz,&bnz);CHKERRQ(ierr);
2514   PetscStackCallBLAS("BLASscal",BLASscal_(&bnz,&oalpha,a->a,&one));
2515   ierr = PetscLogFlops(a->nz);CHKERRQ(ierr);
2516   ierr = MatSeqAIJInvalidateDiagonal(inA);CHKERRQ(ierr);
2517   PetscFunctionReturn(0);
2518 }
2519 
2520 #undef __FUNCT__
2521 #define __FUNCT__ "MatGetSubMatrices_SeqAIJ"
2522 PetscErrorCode MatGetSubMatrices_SeqAIJ(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
2523 {
2524   PetscErrorCode ierr;
2525   PetscInt       i;
2526 
2527   PetscFunctionBegin;
2528   if (scall == MAT_INITIAL_MATRIX) {
2529     ierr = PetscMalloc((n+1)*sizeof(Mat),B);CHKERRQ(ierr);
2530   }
2531 
2532   for (i=0; i<n; i++) {
2533     ierr = MatGetSubMatrix_SeqAIJ(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);CHKERRQ(ierr);
2534   }
2535   PetscFunctionReturn(0);
2536 }
2537 
2538 #undef __FUNCT__
2539 #define __FUNCT__ "MatIncreaseOverlap_SeqAIJ"
2540 PetscErrorCode MatIncreaseOverlap_SeqAIJ(Mat A,PetscInt is_max,IS is[],PetscInt ov)
2541 {
2542   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
2543   PetscErrorCode ierr;
2544   PetscInt       row,i,j,k,l,m,n,*nidx,isz,val;
2545   const PetscInt *idx;
2546   PetscInt       start,end,*ai,*aj;
2547   PetscBT        table;
2548 
2549   PetscFunctionBegin;
2550   m  = A->rmap->n;
2551   ai = a->i;
2552   aj = a->j;
2553 
2554   if (ov < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"illegal negative overlap value used");
2555 
2556   ierr = PetscMalloc((m+1)*sizeof(PetscInt),&nidx);CHKERRQ(ierr);
2557   ierr = PetscBTCreate(m,&table);CHKERRQ(ierr);
2558 
2559   for (i=0; i<is_max; i++) {
2560     /* Initialize the two local arrays */
2561     isz  = 0;
2562     ierr = PetscBTMemzero(m,table);CHKERRQ(ierr);
2563 
2564     /* Extract the indices, assume there can be duplicate entries */
2565     ierr = ISGetIndices(is[i],&idx);CHKERRQ(ierr);
2566     ierr = ISGetLocalSize(is[i],&n);CHKERRQ(ierr);
2567 
2568     /* Enter these into the temp arrays. I.e., mark table[row], enter row into new index */
2569     for (j=0; j<n; ++j) {
2570       if (!PetscBTLookupSet(table,idx[j])) nidx[isz++] = idx[j];
2571     }
2572     ierr = ISRestoreIndices(is[i],&idx);CHKERRQ(ierr);
2573     ierr = ISDestroy(&is[i]);CHKERRQ(ierr);
2574 
2575     k = 0;
2576     for (j=0; j<ov; j++) { /* for each overlap */
2577       n = isz;
2578       for (; k<n; k++) { /* do only those rows in nidx[k], which are not done yet */
2579         row   = nidx[k];
2580         start = ai[row];
2581         end   = ai[row+1];
2582         for (l = start; l<end; l++) {
2583           val = aj[l];
2584           if (!PetscBTLookupSet(table,val)) nidx[isz++] = val;
2585         }
2586       }
2587     }
2588     ierr = ISCreateGeneral(PETSC_COMM_SELF,isz,nidx,PETSC_COPY_VALUES,(is+i));CHKERRQ(ierr);
2589   }
2590   ierr = PetscBTDestroy(&table);CHKERRQ(ierr);
2591   ierr = PetscFree(nidx);CHKERRQ(ierr);
2592   PetscFunctionReturn(0);
2593 }
2594 
2595 /* -------------------------------------------------------------- */
2596 #undef __FUNCT__
2597 #define __FUNCT__ "MatPermute_SeqAIJ"
2598 PetscErrorCode MatPermute_SeqAIJ(Mat A,IS rowp,IS colp,Mat *B)
2599 {
2600   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
2601   PetscErrorCode ierr;
2602   PetscInt       i,nz = 0,m = A->rmap->n,n = A->cmap->n;
2603   const PetscInt *row,*col;
2604   PetscInt       *cnew,j,*lens;
2605   IS             icolp,irowp;
2606   PetscInt       *cwork = NULL;
2607   PetscScalar    *vwork = NULL;
2608 
2609   PetscFunctionBegin;
2610   ierr = ISInvertPermutation(rowp,PETSC_DECIDE,&irowp);CHKERRQ(ierr);
2611   ierr = ISGetIndices(irowp,&row);CHKERRQ(ierr);
2612   ierr = ISInvertPermutation(colp,PETSC_DECIDE,&icolp);CHKERRQ(ierr);
2613   ierr = ISGetIndices(icolp,&col);CHKERRQ(ierr);
2614 
2615   /* determine lengths of permuted rows */
2616   ierr = PetscMalloc((m+1)*sizeof(PetscInt),&lens);CHKERRQ(ierr);
2617   for (i=0; i<m; i++) lens[row[i]] = a->i[i+1] - a->i[i];
2618   ierr = MatCreate(PetscObjectComm((PetscObject)A),B);CHKERRQ(ierr);
2619   ierr = MatSetSizes(*B,m,n,m,n);CHKERRQ(ierr);
2620   ierr = MatSetBlockSizes(*B,A->rmap->bs,A->cmap->bs);CHKERRQ(ierr);
2621   ierr = MatSetType(*B,((PetscObject)A)->type_name);CHKERRQ(ierr);
2622   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*B,0,lens);CHKERRQ(ierr);
2623   ierr = PetscFree(lens);CHKERRQ(ierr);
2624 
2625   ierr = PetscMalloc(n*sizeof(PetscInt),&cnew);CHKERRQ(ierr);
2626   for (i=0; i<m; i++) {
2627     ierr = MatGetRow_SeqAIJ(A,i,&nz,&cwork,&vwork);CHKERRQ(ierr);
2628     for (j=0; j<nz; j++) cnew[j] = col[cwork[j]];
2629     ierr = MatSetValues_SeqAIJ(*B,1,&row[i],nz,cnew,vwork,INSERT_VALUES);CHKERRQ(ierr);
2630     ierr = MatRestoreRow_SeqAIJ(A,i,&nz,&cwork,&vwork);CHKERRQ(ierr);
2631   }
2632   ierr = PetscFree(cnew);CHKERRQ(ierr);
2633 
2634   (*B)->assembled = PETSC_FALSE;
2635 
2636   ierr = MatAssemblyBegin(*B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2637   ierr = MatAssemblyEnd(*B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2638   ierr = ISRestoreIndices(irowp,&row);CHKERRQ(ierr);
2639   ierr = ISRestoreIndices(icolp,&col);CHKERRQ(ierr);
2640   ierr = ISDestroy(&irowp);CHKERRQ(ierr);
2641   ierr = ISDestroy(&icolp);CHKERRQ(ierr);
2642   PetscFunctionReturn(0);
2643 }
2644 
2645 #undef __FUNCT__
2646 #define __FUNCT__ "MatCopy_SeqAIJ"
2647 PetscErrorCode MatCopy_SeqAIJ(Mat A,Mat B,MatStructure str)
2648 {
2649   PetscErrorCode ierr;
2650 
2651   PetscFunctionBegin;
2652   /* If the two matrices have the same copy implementation, use fast copy. */
2653   if (str == SAME_NONZERO_PATTERN && (A->ops->copy == B->ops->copy)) {
2654     Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
2655     Mat_SeqAIJ *b = (Mat_SeqAIJ*)B->data;
2656 
2657     if (a->i[A->rmap->n] != b->i[B->rmap->n]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Number of nonzeros in two matrices are different");
2658     ierr = PetscMemcpy(b->a,a->a,(a->i[A->rmap->n])*sizeof(PetscScalar));CHKERRQ(ierr);
2659   } else {
2660     ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr);
2661   }
2662   PetscFunctionReturn(0);
2663 }
2664 
2665 #undef __FUNCT__
2666 #define __FUNCT__ "MatSetUp_SeqAIJ"
2667 PetscErrorCode MatSetUp_SeqAIJ(Mat A)
2668 {
2669   PetscErrorCode ierr;
2670 
2671   PetscFunctionBegin;
2672   ierr =  MatSeqAIJSetPreallocation_SeqAIJ(A,PETSC_DEFAULT,0);CHKERRQ(ierr);
2673   PetscFunctionReturn(0);
2674 }
2675 
2676 #undef __FUNCT__
2677 #define __FUNCT__ "MatSeqAIJGetArray_SeqAIJ"
2678 PetscErrorCode MatSeqAIJGetArray_SeqAIJ(Mat A,PetscScalar *array[])
2679 {
2680   Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
2681 
2682   PetscFunctionBegin;
2683   *array = a->a;
2684   PetscFunctionReturn(0);
2685 }
2686 
2687 #undef __FUNCT__
2688 #define __FUNCT__ "MatSeqAIJRestoreArray_SeqAIJ"
2689 PetscErrorCode MatSeqAIJRestoreArray_SeqAIJ(Mat A,PetscScalar *array[])
2690 {
2691   PetscFunctionBegin;
2692   PetscFunctionReturn(0);
2693 }
2694 
2695 /* Optimize MatFDColoringApply_AIJ() by using array den2sp to skip calling MatSetValues() */
2696 /* #define JACOBIANCOLOROPT */
2697 #if defined(JACOBIANCOLOROPT)
2698 #include <petsctime.h>
2699 #endif
2700 #undef __FUNCT__
2701 #define __FUNCT__ "MatFDColoringApply_SeqAIJ"
2702 PetscErrorCode MatFDColoringApply_SeqAIJ(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
2703 {
2704   PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void*))coloring->f;
2705   PetscErrorCode ierr;
2706   PetscInt       k,l,row,col,N;
2707   PetscScalar    dx,*y,*xx,*w3_array;
2708   PetscScalar    *vscale_array;
2709   PetscReal      epsilon=coloring->error_rel,umin = coloring->umin,unorm;
2710   Vec            w1=coloring->w1,w2=coloring->w2,w3;
2711   void           *fctx=coloring->fctx;
2712   PetscBool      flg=PETSC_FALSE;
2713   Mat_SeqAIJ     *csp=(Mat_SeqAIJ*)J->data;
2714   PetscScalar    *ca=csp->a;
2715   const PetscInt ncolors=coloring->ncolors,*ncolumns=coloring->ncolumns,*nrows=coloring->nrows;
2716   //const PetscInt *colorforrow=coloring->colorforrow,*colorforcolumn=coloring->colorforcolumn;
2717   PetscInt       *den2sp=coloring->den2sp,*idx,idx_tmp;
2718   PetscInt       **columns=coloring->columns,ncolumns_k,nrows_k;
2719 #if defined(JACOBIANCOLOROPT)
2720   PetscLogDouble t0,t1,t_init=0.0,t_setvals=0.0,t_func=0.0,t_dx=0.0,t_kl=0.0,t00,t11;
2721 #endif
2722   PetscInt       nz;
2723 
2724   PetscFunctionBegin;
2725 #if defined(JACOBIANCOLOROPT)
2726     ierr = PetscTime(&t0);CHKERRQ(ierr);
2727 #endif
2728   ierr = MatSetUnfactored(J);CHKERRQ(ierr);
2729   ierr = PetscOptionsGetBool(NULL,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
2730   if (flg) {
2731     ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
2732   } else {
2733     PetscBool assembled;
2734     ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
2735     if (assembled) {
2736       ierr = MatZeroEntries(J);CHKERRQ(ierr);
2737     }
2738   }
2739 
2740   if (!coloring->vscale) {
2741     ierr = VecDuplicate(x1,&coloring->vscale);CHKERRQ(ierr);
2742   }
2743 
2744   if (coloring->htype[0] == 'w') { /* tacky test; need to make systematic if we add other approaches to computing h*/
2745     ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
2746   }
2747 #if defined(JACOBIANCOLOROPT)
2748     ierr = PetscTime(&t1);CHKERRQ(ierr);
2749     t_init += t1 - t0;
2750 #endif
2751 
2752   /* Set w1 = F(x1) */
2753 #if defined(JACOBIANCOLOROPT)
2754     ierr = PetscTime(&t0);CHKERRQ(ierr);
2755 #endif
2756   if (!coloring->fset) {
2757     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2758     ierr = (*f)(sctx,x1,w1,fctx);CHKERRQ(ierr);
2759     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2760   } else {
2761     coloring->fset = PETSC_FALSE;
2762   }
2763 #if defined(JACOBIANCOLOROPT)
2764     ierr = PetscTime(&t1);CHKERRQ(ierr);
2765     t_setvals += t1 - t0;
2766 #endif
2767 
2768 #if defined(JACOBIANCOLOROPT)
2769     ierr = PetscTime(&t0);CHKERRQ(ierr);
2770 #endif
2771   if (!coloring->w3) {
2772     ierr = VecDuplicate(x1,&coloring->w3);CHKERRQ(ierr);
2773     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w3);CHKERRQ(ierr);
2774   }
2775   w3 = coloring->w3;
2776 
2777   /* Compute scale factors: vscale = 1./dx = 1./(epsilon*xx) */
2778   ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);
2779   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2780   ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
2781   for (col=0; col<N; col++) {
2782     if (coloring->htype[0] == 'w') {
2783       dx = 1.0 + unorm;
2784     } else {
2785       dx = xx[col];
2786     }
2787     if (dx == (PetscScalar)0.0) dx = 1.0;
2788     if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2789     else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2790     dx               *= epsilon;
2791     vscale_array[col] = (PetscScalar)dx;
2792   }
2793 #if defined(JACOBIANCOLOROPT)
2794     ierr = PetscTime(&t1);CHKERRQ(ierr);
2795     t_init += t1 - t0;
2796 #endif
2797 
2798   idx = den2sp;
2799   nz  = 0;
2800   for (k=0; k<ncolors; k++) { /* loop over colors */
2801 #if defined(JACOBIANCOLOROPT)
2802     ierr = PetscTime(&t0);CHKERRQ(ierr);
2803 #endif
2804     coloring->currentcolor = k;
2805 
2806     /*
2807       Loop over each column associated with color
2808       adding the perturbation to the vector w3 = x1 + dx.
2809     */
2810     ierr = VecCopy(x1,w3);CHKERRQ(ierr);
2811     ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr);
2812     ncolumns_k = ncolumns[k];
2813     for (l=0; l<ncolumns_k; l++) { /* loop over columns */
2814       col = columns[k][l];
2815       w3_array[col] += vscale_array[col];
2816     }
2817     ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr);
2818 #if defined(JACOBIANCOLOROPT)
2819     ierr = PetscTime(&t1);CHKERRQ(ierr);
2820     t_dx += t1 - t0;
2821 #endif
2822 
2823     /*
2824       Evaluate function at w3 = x1 + dx (here dx is a vector of perturbations)
2825                            w2 = F(x1 + dx) - F(x1)
2826     */
2827 #if defined(JACOBIANCOLOROPT)
2828     ierr = PetscTime(&t0);CHKERRQ(ierr);
2829 #endif
2830     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2831     ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr);
2832     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2833 #if defined(JACOBIANCOLOROPT)
2834     ierr = PetscTime(&t1);CHKERRQ(ierr);
2835     t_func += t1 - t0;
2836 #endif
2837 
2838 #if defined(JACOBIANCOLOROPT)
2839     ierr = PetscTime(&t0);CHKERRQ(ierr);
2840 #endif
2841     ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr);
2842 
2843     /*
2844       Loop over rows of vector, putting w2/dx into Jacobian matrix
2845     */
2846     ierr = VecGetArray(w2,&y);CHKERRQ(ierr);
2847     nrows_k = nrows[k];
2848     for (l=0; l<nrows_k; l++) { /* loop over rows */
2849 #if defined(JACOBIANCOLOROPT)
2850     ierr = PetscTime(&t00);CHKERRQ(ierr);
2851 #endif
2852       row = coloring->rowcolden2sp3[3*nz];
2853       col = coloring->rowcolden2sp3[3*nz+1];
2854       idx_tmp = coloring->rowcolden2sp3[3*nz+2];
2855 #if defined(JACOBIANCOLOROPT)
2856       ierr = PetscTime(&t11);CHKERRQ(ierr);
2857       t_kl += t11 - t00;
2858 #endif
2859       //ca[idx[l]] = y[row]/vscale_array[col];
2860       ca[idx_tmp] = y[row]/vscale_array[col];
2861       nz++;
2862     }
2863     idx += nrows_k;
2864     ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr);
2865 
2866 #if defined(JACOBIANCOLOROPT)
2867     ierr = PetscTime(&t1);CHKERRQ(ierr);
2868     t_setvals += t1 - t0;
2869 #endif
2870   } /* endof for each color */
2871 #if defined(JACOBIANCOLOROPT)
2872   printf("     FDColorApply time: init %g + func %g + setvalues %g + dx %g= %g\n",t_init,t_func,t_setvals,t_dx,t_init+t_func+t_setvals+t_dx);
2873   printf("     FDColorApply time: kl %g\n",t_kl);
2874 #endif
2875   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2876   ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
2877 
2878   coloring->currentcolor = -1;
2879   PetscFunctionReturn(0);
2880 }
2881 /* --------------------------------------------------------*/
2882 
2883 #undef __FUNCT__
2884 #define __FUNCT__ "MatFDColoringApply_SeqAIJ_old"
2885 PetscErrorCode MatFDColoringApply_SeqAIJ_old(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
2886 {
2887   PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void*))coloring->f;
2888   PetscErrorCode ierr;
2889   PetscInt       k,N,start,end,l,row,col,srow,**vscaleforrow;
2890   PetscScalar    dx,*y,*xx,*w3_array;
2891   PetscScalar    *vscale_array;
2892   PetscReal      epsilon = coloring->error_rel,umin = coloring->umin;
2893   Vec            w1,w2,w3;
2894   void           *fctx = coloring->fctx;
2895   PetscBool      flg   = PETSC_FALSE;
2896 
2897   PetscFunctionBegin;
2898   printf("MatFDColoringApply_SeqAIJ ...\n");
2899   if (!coloring->w1) {
2900     ierr = VecDuplicate(x1,&coloring->w1);CHKERRQ(ierr);
2901     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w1);CHKERRQ(ierr);
2902     ierr = VecDuplicate(x1,&coloring->w2);CHKERRQ(ierr);
2903     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w2);CHKERRQ(ierr);
2904     ierr = VecDuplicate(x1,&coloring->w3);CHKERRQ(ierr);
2905     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w3);CHKERRQ(ierr);
2906   }
2907   w1 = coloring->w1; w2 = coloring->w2; w3 = coloring->w3;
2908 
2909   ierr = MatSetUnfactored(J);CHKERRQ(ierr);
2910   ierr = PetscOptionsGetBool(((PetscObject)coloring)->prefix,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
2911   if (flg) {
2912     ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
2913   } else {
2914     PetscBool assembled;
2915     ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
2916     if (assembled) {
2917       ierr = MatZeroEntries(J);CHKERRQ(ierr);
2918     }
2919   }
2920 
2921   ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
2922   ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
2923 
2924   if (!coloring->fset) {
2925     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2926     ierr = (*f)(sctx,x1,w1,fctx);CHKERRQ(ierr);
2927     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2928   } else {
2929     coloring->fset = PETSC_FALSE;
2930   }
2931 
2932   /*
2933       Compute all the scale factors and share with other processors
2934   */
2935   ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);xx = xx - start;
2936   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);vscale_array = vscale_array - start;
2937   for (k=0; k<coloring->ncolors; k++) {
2938     /*
2939        Loop over each column associated with color adding the
2940        perturbation to the vector w3.
2941     */
2942     for (l=0; l<coloring->ncolumns[k]; l++) {
2943       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
2944       dx  = xx[col];
2945       if (dx == 0.0) dx = 1.0;
2946       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2947       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2948       dx               *= epsilon;
2949       vscale_array[col] = 1.0/dx;
2950     }
2951   }
2952   vscale_array = vscale_array + start;
2953 
2954   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2955   ierr = VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2956   ierr = VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2957 
2958   /*  ierr = VecView(coloring->vscale,PETSC_VIEWER_STDOUT_WORLD);
2959       ierr = VecView(x1,PETSC_VIEWER_STDOUT_WORLD);*/
2960 
2961   if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
2962   else                        vscaleforrow = coloring->columnsforrow;
2963 
2964   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2965   /*
2966       Loop over each color
2967   */
2968   for (k=0; k<coloring->ncolors; k++) {
2969     coloring->currentcolor = k;
2970 
2971     ierr = VecCopy(x1,w3);CHKERRQ(ierr);
2972     ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr);w3_array = w3_array - start;
2973     /*
2974        Loop over each column associated with color adding the
2975        perturbation to the vector w3.
2976     */
2977     for (l=0; l<coloring->ncolumns[k]; l++) {
2978       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
2979       dx  = xx[col];
2980       if (dx == 0.0) dx = 1.0;
2981       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2982       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2983       dx *= epsilon;
2984       if (!PetscAbsScalar(dx)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed 0 differencing parameter");
2985       w3_array[col] += dx;
2986     }
2987     w3_array = w3_array + start; ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr);
2988 
2989     /*
2990        Evaluate function at x1 + dx (here dx is a vector of perturbations)
2991     */
2992 
2993     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2994     ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr);
2995     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2996     ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr);
2997 
2998     /*
2999        Loop over rows of vector, putting results into Jacobian matrix
3000     */
3001     ierr = VecGetArray(w2,&y);CHKERRQ(ierr);
3002     for (l=0; l<coloring->nrows[k]; l++) {
3003       row     = coloring->rows[k][l];
3004       col     = coloring->columnsforrow[k][l];
3005       y[row] *= vscale_array[vscaleforrow[k][l]];
3006       srow    = row + start;
3007       ierr    = MatSetValues_SeqAIJ(J,1,&srow,1,&col,y+row,INSERT_VALUES);CHKERRQ(ierr);
3008     }
3009     ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr);
3010   }
3011   coloring->currentcolor = k;
3012 
3013   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
3014   xx   = xx + start;
3015   ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
3016   ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3017   ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3018   PetscFunctionReturn(0);
3019 }
3020 
3021 /*
3022    Computes the number of nonzeros per row needed for preallocation when X and Y
3023    have different nonzero structure.
3024 */
3025 #undef __FUNCT__
3026 #define __FUNCT__ "MatAXPYGetPreallocation_SeqAIJ"
3027 PetscErrorCode MatAXPYGetPreallocation_SeqAIJ(Mat Y,Mat X,PetscInt *nnz)
3028 {
3029   PetscInt       i,m=Y->rmap->N;
3030   Mat_SeqAIJ     *x  = (Mat_SeqAIJ*)X->data;
3031   Mat_SeqAIJ     *y  = (Mat_SeqAIJ*)Y->data;
3032   const PetscInt *xi = x->i,*yi = y->i;
3033 
3034   PetscFunctionBegin;
3035   /* Set the number of nonzeros in the new matrix */
3036   for (i=0; i<m; i++) {
3037     PetscInt       j,k,nzx = xi[i+1] - xi[i],nzy = yi[i+1] - yi[i];
3038     const PetscInt *xj = x->j+xi[i],*yj = y->j+yi[i];
3039     nnz[i] = 0;
3040     for (j=0,k=0; j<nzx; j++) {                   /* Point in X */
3041       for (; k<nzy && yj[k]<xj[j]; k++) nnz[i]++; /* Catch up to X */
3042       if (k<nzy && yj[k]==xj[j]) k++;             /* Skip duplicate */
3043       nnz[i]++;
3044     }
3045     for (; k<nzy; k++) nnz[i]++;
3046   }
3047   PetscFunctionReturn(0);
3048 }
3049 
3050 #undef __FUNCT__
3051 #define __FUNCT__ "MatAXPY_SeqAIJ"
3052 PetscErrorCode MatAXPY_SeqAIJ(Mat Y,PetscScalar a,Mat X,MatStructure str)
3053 {
3054   PetscErrorCode ierr;
3055   PetscInt       i;
3056   Mat_SeqAIJ     *x = (Mat_SeqAIJ*)X->data,*y = (Mat_SeqAIJ*)Y->data;
3057   PetscBLASInt   one=1,bnz;
3058 
3059   PetscFunctionBegin;
3060   ierr = PetscBLASIntCast(x->nz,&bnz);CHKERRQ(ierr);
3061   if (str == SAME_NONZERO_PATTERN) {
3062     PetscScalar alpha = a;
3063     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&bnz,&alpha,x->a,&one,y->a,&one));
3064     ierr = MatSeqAIJInvalidateDiagonal(Y);CHKERRQ(ierr);
3065   } else if (str == SUBSET_NONZERO_PATTERN) { /* nonzeros of X is a subset of Y's */
3066     if (y->xtoy && y->XtoY != X) {
3067       ierr = PetscFree(y->xtoy);CHKERRQ(ierr);
3068       ierr = MatDestroy(&y->XtoY);CHKERRQ(ierr);
3069     }
3070     if (!y->xtoy) { /* get xtoy */
3071       ierr    = MatAXPYGetxtoy_Private(X->rmap->n,x->i,x->j,NULL, y->i,y->j,NULL, &y->xtoy);CHKERRQ(ierr);
3072       y->XtoY = X;
3073       ierr    = PetscObjectReference((PetscObject)X);CHKERRQ(ierr);
3074     }
3075     for (i=0; i<x->nz; i++) y->a[y->xtoy[i]] += a*(x->a[i]);
3076     ierr = PetscInfo3(Y,"ratio of nnz(X)/nnz(Y): %d/%d = %g\n",x->nz,y->nz,(double)(PetscReal)(x->nz)/(y->nz+1));CHKERRQ(ierr);
3077   } else {
3078     Mat      B;
3079     PetscInt *nnz;
3080     ierr = PetscMalloc(Y->rmap->N*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
3081     ierr = MatCreate(PetscObjectComm((PetscObject)Y),&B);CHKERRQ(ierr);
3082     ierr = PetscObjectSetName((PetscObject)B,((PetscObject)Y)->name);CHKERRQ(ierr);
3083     ierr = MatSetSizes(B,Y->rmap->n,Y->cmap->n,Y->rmap->N,Y->cmap->N);CHKERRQ(ierr);
3084     ierr = MatSetBlockSizes(B,Y->rmap->bs,Y->cmap->bs);CHKERRQ(ierr);
3085     ierr = MatSetType(B,(MatType) ((PetscObject)Y)->type_name);CHKERRQ(ierr);
3086     ierr = MatAXPYGetPreallocation_SeqAIJ(Y,X,nnz);CHKERRQ(ierr);
3087     ierr = MatSeqAIJSetPreallocation(B,0,nnz);CHKERRQ(ierr);
3088     ierr = MatAXPY_BasicWithPreallocation(B,Y,a,X,str);CHKERRQ(ierr);
3089     ierr = MatHeaderReplace(Y,B);CHKERRQ(ierr);
3090     ierr = PetscFree(nnz);CHKERRQ(ierr);
3091   }
3092   PetscFunctionReturn(0);
3093 }
3094 
3095 #undef __FUNCT__
3096 #define __FUNCT__ "MatConjugate_SeqAIJ"
3097 PetscErrorCode  MatConjugate_SeqAIJ(Mat mat)
3098 {
3099 #if defined(PETSC_USE_COMPLEX)
3100   Mat_SeqAIJ  *aij = (Mat_SeqAIJ*)mat->data;
3101   PetscInt    i,nz;
3102   PetscScalar *a;
3103 
3104   PetscFunctionBegin;
3105   nz = aij->nz;
3106   a  = aij->a;
3107   for (i=0; i<nz; i++) a[i] = PetscConj(a[i]);
3108 #else
3109   PetscFunctionBegin;
3110 #endif
3111   PetscFunctionReturn(0);
3112 }
3113 
3114 #undef __FUNCT__
3115 #define __FUNCT__ "MatGetRowMaxAbs_SeqAIJ"
3116 PetscErrorCode MatGetRowMaxAbs_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3117 {
3118   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3119   PetscErrorCode ierr;
3120   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3121   PetscReal      atmp;
3122   PetscScalar    *x;
3123   MatScalar      *aa;
3124 
3125   PetscFunctionBegin;
3126   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3127   aa = a->a;
3128   ai = a->i;
3129   aj = a->j;
3130 
3131   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3132   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3133   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3134   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3135   for (i=0; i<m; i++) {
3136     ncols = ai[1] - ai[0]; ai++;
3137     x[i]  = 0.0;
3138     for (j=0; j<ncols; j++) {
3139       atmp = PetscAbsScalar(*aa);
3140       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = *aj;}
3141       aa++; aj++;
3142     }
3143   }
3144   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3145   PetscFunctionReturn(0);
3146 }
3147 
3148 #undef __FUNCT__
3149 #define __FUNCT__ "MatGetRowMax_SeqAIJ"
3150 PetscErrorCode MatGetRowMax_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3151 {
3152   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3153   PetscErrorCode ierr;
3154   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3155   PetscScalar    *x;
3156   MatScalar      *aa;
3157 
3158   PetscFunctionBegin;
3159   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3160   aa = a->a;
3161   ai = a->i;
3162   aj = a->j;
3163 
3164   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3165   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3166   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3167   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3168   for (i=0; i<m; i++) {
3169     ncols = ai[1] - ai[0]; ai++;
3170     if (ncols == A->cmap->n) { /* row is dense */
3171       x[i] = *aa; if (idx) idx[i] = 0;
3172     } else {  /* row is sparse so already KNOW maximum is 0.0 or higher */
3173       x[i] = 0.0;
3174       if (idx) {
3175         idx[i] = 0; /* in case ncols is zero */
3176         for (j=0;j<ncols;j++) { /* find first implicit 0.0 in the row */
3177           if (aj[j] > j) {
3178             idx[i] = j;
3179             break;
3180           }
3181         }
3182       }
3183     }
3184     for (j=0; j<ncols; j++) {
3185       if (PetscRealPart(x[i]) < PetscRealPart(*aa)) {x[i] = *aa; if (idx) idx[i] = *aj;}
3186       aa++; aj++;
3187     }
3188   }
3189   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3190   PetscFunctionReturn(0);
3191 }
3192 
3193 #undef __FUNCT__
3194 #define __FUNCT__ "MatGetRowMinAbs_SeqAIJ"
3195 PetscErrorCode MatGetRowMinAbs_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3196 {
3197   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3198   PetscErrorCode ierr;
3199   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3200   PetscReal      atmp;
3201   PetscScalar    *x;
3202   MatScalar      *aa;
3203 
3204   PetscFunctionBegin;
3205   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3206   aa = a->a;
3207   ai = a->i;
3208   aj = a->j;
3209 
3210   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3211   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3212   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3213   if (n != A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector, %d vs. %d rows", A->rmap->n, n);
3214   for (i=0; i<m; i++) {
3215     ncols = ai[1] - ai[0]; ai++;
3216     if (ncols) {
3217       /* Get first nonzero */
3218       for (j = 0; j < ncols; j++) {
3219         atmp = PetscAbsScalar(aa[j]);
3220         if (atmp > 1.0e-12) {
3221           x[i] = atmp;
3222           if (idx) idx[i] = aj[j];
3223           break;
3224         }
3225       }
3226       if (j == ncols) {x[i] = PetscAbsScalar(*aa); if (idx) idx[i] = *aj;}
3227     } else {
3228       x[i] = 0.0; if (idx) idx[i] = 0;
3229     }
3230     for (j = 0; j < ncols; j++) {
3231       atmp = PetscAbsScalar(*aa);
3232       if (atmp > 1.0e-12 && PetscAbsScalar(x[i]) > atmp) {x[i] = atmp; if (idx) idx[i] = *aj;}
3233       aa++; aj++;
3234     }
3235   }
3236   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3237   PetscFunctionReturn(0);
3238 }
3239 
3240 #undef __FUNCT__
3241 #define __FUNCT__ "MatGetRowMin_SeqAIJ"
3242 PetscErrorCode MatGetRowMin_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3243 {
3244   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3245   PetscErrorCode ierr;
3246   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3247   PetscScalar    *x;
3248   MatScalar      *aa;
3249 
3250   PetscFunctionBegin;
3251   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3252   aa = a->a;
3253   ai = a->i;
3254   aj = a->j;
3255 
3256   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3257   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3258   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3259   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3260   for (i=0; i<m; i++) {
3261     ncols = ai[1] - ai[0]; ai++;
3262     if (ncols == A->cmap->n) { /* row is dense */
3263       x[i] = *aa; if (idx) idx[i] = 0;
3264     } else {  /* row is sparse so already KNOW minimum is 0.0 or lower */
3265       x[i] = 0.0;
3266       if (idx) {   /* find first implicit 0.0 in the row */
3267         idx[i] = 0; /* in case ncols is zero */
3268         for (j=0; j<ncols; j++) {
3269           if (aj[j] > j) {
3270             idx[i] = j;
3271             break;
3272           }
3273         }
3274       }
3275     }
3276     for (j=0; j<ncols; j++) {
3277       if (PetscRealPart(x[i]) > PetscRealPart(*aa)) {x[i] = *aa; if (idx) idx[i] = *aj;}
3278       aa++; aj++;
3279     }
3280   }
3281   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3282   PetscFunctionReturn(0);
3283 }
3284 
3285 #include <petscblaslapack.h>
3286 #include <petsc-private/kernels/blockinvert.h>
3287 
3288 #undef __FUNCT__
3289 #define __FUNCT__ "MatInvertBlockDiagonal_SeqAIJ"
3290 PetscErrorCode  MatInvertBlockDiagonal_SeqAIJ(Mat A,const PetscScalar **values)
3291 {
3292   Mat_SeqAIJ     *a = (Mat_SeqAIJ*) A->data;
3293   PetscErrorCode ierr;
3294   PetscInt       i,bs = A->rmap->bs,mbs = A->rmap->n/A->rmap->bs,ipvt[5],bs2 = bs*bs,*v_pivots,ij[7],*IJ,j;
3295   MatScalar      *diag,work[25],*v_work;
3296   PetscReal      shift = 0.0;
3297 
3298   PetscFunctionBegin;
3299   if (a->ibdiagvalid) {
3300     if (values) *values = a->ibdiag;
3301     PetscFunctionReturn(0);
3302   }
3303   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
3304   if (!a->ibdiag) {
3305     ierr = PetscMalloc(bs2*mbs*sizeof(PetscScalar),&a->ibdiag);CHKERRQ(ierr);
3306     ierr = PetscLogObjectMemory((PetscObject)A,bs2*mbs*sizeof(PetscScalar));CHKERRQ(ierr);
3307   }
3308   diag = a->ibdiag;
3309   if (values) *values = a->ibdiag;
3310   /* factor and invert each block */
3311   switch (bs) {
3312   case 1:
3313     for (i=0; i<mbs; i++) {
3314       ierr    = MatGetValues(A,1,&i,1,&i,diag+i);CHKERRQ(ierr);
3315       diag[i] = (PetscScalar)1.0 / (diag[i] + shift);
3316     }
3317     break;
3318   case 2:
3319     for (i=0; i<mbs; i++) {
3320       ij[0] = 2*i; ij[1] = 2*i + 1;
3321       ierr  = MatGetValues(A,2,ij,2,ij,diag);CHKERRQ(ierr);
3322       ierr  = PetscKernel_A_gets_inverse_A_2(diag,shift);CHKERRQ(ierr);
3323       ierr  = PetscKernel_A_gets_transpose_A_2(diag);CHKERRQ(ierr);
3324       diag += 4;
3325     }
3326     break;
3327   case 3:
3328     for (i=0; i<mbs; i++) {
3329       ij[0] = 3*i; ij[1] = 3*i + 1; ij[2] = 3*i + 2;
3330       ierr  = MatGetValues(A,3,ij,3,ij,diag);CHKERRQ(ierr);
3331       ierr  = PetscKernel_A_gets_inverse_A_3(diag,shift);CHKERRQ(ierr);
3332       ierr  = PetscKernel_A_gets_transpose_A_3(diag);CHKERRQ(ierr);
3333       diag += 9;
3334     }
3335     break;
3336   case 4:
3337     for (i=0; i<mbs; i++) {
3338       ij[0] = 4*i; ij[1] = 4*i + 1; ij[2] = 4*i + 2; ij[3] = 4*i + 3;
3339       ierr  = MatGetValues(A,4,ij,4,ij,diag);CHKERRQ(ierr);
3340       ierr  = PetscKernel_A_gets_inverse_A_4(diag,shift);CHKERRQ(ierr);
3341       ierr  = PetscKernel_A_gets_transpose_A_4(diag);CHKERRQ(ierr);
3342       diag += 16;
3343     }
3344     break;
3345   case 5:
3346     for (i=0; i<mbs; i++) {
3347       ij[0] = 5*i; ij[1] = 5*i + 1; ij[2] = 5*i + 2; ij[3] = 5*i + 3; ij[4] = 5*i + 4;
3348       ierr  = MatGetValues(A,5,ij,5,ij,diag);CHKERRQ(ierr);
3349       ierr  = PetscKernel_A_gets_inverse_A_5(diag,ipvt,work,shift);CHKERRQ(ierr);
3350       ierr  = PetscKernel_A_gets_transpose_A_5(diag);CHKERRQ(ierr);
3351       diag += 25;
3352     }
3353     break;
3354   case 6:
3355     for (i=0; i<mbs; i++) {
3356       ij[0] = 6*i; ij[1] = 6*i + 1; ij[2] = 6*i + 2; ij[3] = 6*i + 3; ij[4] = 6*i + 4; ij[5] = 6*i + 5;
3357       ierr  = MatGetValues(A,6,ij,6,ij,diag);CHKERRQ(ierr);
3358       ierr  = PetscKernel_A_gets_inverse_A_6(diag,shift);CHKERRQ(ierr);
3359       ierr  = PetscKernel_A_gets_transpose_A_6(diag);CHKERRQ(ierr);
3360       diag += 36;
3361     }
3362     break;
3363   case 7:
3364     for (i=0; i<mbs; i++) {
3365       ij[0] = 7*i; ij[1] = 7*i + 1; ij[2] = 7*i + 2; ij[3] = 7*i + 3; ij[4] = 7*i + 4; ij[5] = 7*i + 5; ij[5] = 7*i + 6;
3366       ierr  = MatGetValues(A,7,ij,7,ij,diag);CHKERRQ(ierr);
3367       ierr  = PetscKernel_A_gets_inverse_A_7(diag,shift);CHKERRQ(ierr);
3368       ierr  = PetscKernel_A_gets_transpose_A_7(diag);CHKERRQ(ierr);
3369       diag += 49;
3370     }
3371     break;
3372   default:
3373     ierr = PetscMalloc3(bs,MatScalar,&v_work,bs,PetscInt,&v_pivots,bs,PetscInt,&IJ);CHKERRQ(ierr);
3374     for (i=0; i<mbs; i++) {
3375       for (j=0; j<bs; j++) {
3376         IJ[j] = bs*i + j;
3377       }
3378       ierr  = MatGetValues(A,bs,IJ,bs,IJ,diag);CHKERRQ(ierr);
3379       ierr  = PetscKernel_A_gets_inverse_A(bs,diag,v_pivots,v_work);CHKERRQ(ierr);
3380       ierr  = PetscKernel_A_gets_transpose_A_N(diag,bs);CHKERRQ(ierr);
3381       diag += bs2;
3382     }
3383     ierr = PetscFree3(v_work,v_pivots,IJ);CHKERRQ(ierr);
3384   }
3385   a->ibdiagvalid = PETSC_TRUE;
3386   PetscFunctionReturn(0);
3387 }
3388 
3389 #undef __FUNCT__
3390 #define __FUNCT__ "MatSetRandom_SeqAIJ"
3391 static PetscErrorCode  MatSetRandom_SeqAIJ(Mat x,PetscRandom rctx)
3392 {
3393   PetscErrorCode ierr;
3394   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)x->data;
3395   PetscScalar    a;
3396   PetscInt       m,n,i,j,col;
3397 
3398   PetscFunctionBegin;
3399   if (!x->assembled) {
3400     ierr = MatGetSize(x,&m,&n);CHKERRQ(ierr);
3401     for (i=0; i<m; i++) {
3402       for (j=0; j<aij->imax[i]; j++) {
3403         ierr = PetscRandomGetValue(rctx,&a);CHKERRQ(ierr);
3404         col  = (PetscInt)(n*PetscRealPart(a));
3405         ierr = MatSetValues(x,1,&i,1,&col,&a,ADD_VALUES);CHKERRQ(ierr);
3406       }
3407     }
3408   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet coded");
3409   ierr = MatAssemblyBegin(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3410   ierr = MatAssemblyEnd(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3411   PetscFunctionReturn(0);
3412 }
3413 
3414 extern PetscErrorCode  MatFDColoringApply_AIJ(Mat,MatFDColoring,Vec,MatStructure*,void*);
3415 /* -------------------------------------------------------------------*/
3416 static struct _MatOps MatOps_Values = { MatSetValues_SeqAIJ,
3417                                         MatGetRow_SeqAIJ,
3418                                         MatRestoreRow_SeqAIJ,
3419                                         MatMult_SeqAIJ,
3420                                 /*  4*/ MatMultAdd_SeqAIJ,
3421                                         MatMultTranspose_SeqAIJ,
3422                                         MatMultTransposeAdd_SeqAIJ,
3423                                         0,
3424                                         0,
3425                                         0,
3426                                 /* 10*/ 0,
3427                                         MatLUFactor_SeqAIJ,
3428                                         0,
3429                                         MatSOR_SeqAIJ,
3430                                         MatTranspose_SeqAIJ,
3431                                 /*1 5*/ MatGetInfo_SeqAIJ,
3432                                         MatEqual_SeqAIJ,
3433                                         MatGetDiagonal_SeqAIJ,
3434                                         MatDiagonalScale_SeqAIJ,
3435                                         MatNorm_SeqAIJ,
3436                                 /* 20*/ 0,
3437                                         MatAssemblyEnd_SeqAIJ,
3438                                         MatSetOption_SeqAIJ,
3439                                         MatZeroEntries_SeqAIJ,
3440                                 /* 24*/ MatZeroRows_SeqAIJ,
3441                                         0,
3442                                         0,
3443                                         0,
3444                                         0,
3445                                 /* 29*/ MatSetUp_SeqAIJ,
3446                                         0,
3447                                         0,
3448                                         0,
3449                                         0,
3450                                 /* 34*/ MatDuplicate_SeqAIJ,
3451                                         0,
3452                                         0,
3453                                         MatILUFactor_SeqAIJ,
3454                                         0,
3455                                 /* 39*/ MatAXPY_SeqAIJ,
3456                                         MatGetSubMatrices_SeqAIJ,
3457                                         MatIncreaseOverlap_SeqAIJ,
3458                                         MatGetValues_SeqAIJ,
3459                                         MatCopy_SeqAIJ,
3460                                 /* 44*/ MatGetRowMax_SeqAIJ,
3461                                         MatScale_SeqAIJ,
3462                                         0,
3463                                         MatDiagonalSet_SeqAIJ,
3464                                         MatZeroRowsColumns_SeqAIJ,
3465                                 /* 49*/ MatSetRandom_SeqAIJ,
3466                                         MatGetRowIJ_SeqAIJ,
3467                                         MatRestoreRowIJ_SeqAIJ,
3468                                         MatGetColumnIJ_SeqAIJ,
3469                                         MatRestoreColumnIJ_SeqAIJ,
3470                                 /* 54*/ MatFDColoringCreate_SeqAIJ,
3471                                         0,
3472                                         0,
3473                                         MatPermute_SeqAIJ,
3474                                         0,
3475                                 /* 59*/ 0,
3476                                         MatDestroy_SeqAIJ,
3477                                         MatView_SeqAIJ,
3478                                         0,
3479                                         MatMatMatMult_SeqAIJ_SeqAIJ_SeqAIJ,
3480                                 /* 64*/ MatMatMatMultSymbolic_SeqAIJ_SeqAIJ_SeqAIJ,
3481                                         MatMatMatMultNumeric_SeqAIJ_SeqAIJ_SeqAIJ,
3482                                         0,
3483                                         0,
3484                                         0,
3485                                 /* 69*/ MatGetRowMaxAbs_SeqAIJ,
3486                                         MatGetRowMinAbs_SeqAIJ,
3487                                         0,
3488                                         MatSetColoring_SeqAIJ,
3489                                         0,
3490                                 /* 74*/ MatSetValuesAdifor_SeqAIJ,
3491                                         MatFDColoringApply_AIJ,
3492                                         0,
3493                                         0,
3494                                         0,
3495                                 /* 79*/ MatFindZeroDiagonals_SeqAIJ,
3496                                         0,
3497                                         0,
3498                                         0,
3499                                         MatLoad_SeqAIJ,
3500                                 /* 84*/ MatIsSymmetric_SeqAIJ,
3501                                         MatIsHermitian_SeqAIJ,
3502                                         0,
3503                                         0,
3504                                         0,
3505                                 /* 89*/ MatMatMult_SeqAIJ_SeqAIJ,
3506                                         MatMatMultSymbolic_SeqAIJ_SeqAIJ,
3507                                         MatMatMultNumeric_SeqAIJ_SeqAIJ,
3508                                         MatPtAP_SeqAIJ_SeqAIJ,
3509                                         MatPtAPSymbolic_SeqAIJ_SeqAIJ_DenseAxpy,
3510                                 /* 94*/ MatPtAPNumeric_SeqAIJ_SeqAIJ,
3511                                         MatMatTransposeMult_SeqAIJ_SeqAIJ,
3512                                         MatMatTransposeMultSymbolic_SeqAIJ_SeqAIJ,
3513                                         MatMatTransposeMultNumeric_SeqAIJ_SeqAIJ,
3514                                         0,
3515                                 /* 99*/ 0,
3516                                         0,
3517                                         0,
3518                                         MatConjugate_SeqAIJ,
3519                                         0,
3520                                 /*104*/ MatSetValuesRow_SeqAIJ,
3521                                         MatRealPart_SeqAIJ,
3522                                         MatImaginaryPart_SeqAIJ,
3523                                         0,
3524                                         0,
3525                                 /*109*/ MatMatSolve_SeqAIJ,
3526                                         0,
3527                                         MatGetRowMin_SeqAIJ,
3528                                         0,
3529                                         MatMissingDiagonal_SeqAIJ,
3530                                 /*114*/ 0,
3531                                         0,
3532                                         0,
3533                                         0,
3534                                         0,
3535                                 /*119*/ 0,
3536                                         0,
3537                                         0,
3538                                         0,
3539                                         MatGetMultiProcBlock_SeqAIJ,
3540                                 /*124*/ MatFindNonzeroRows_SeqAIJ,
3541                                         MatGetColumnNorms_SeqAIJ,
3542                                         MatInvertBlockDiagonal_SeqAIJ,
3543                                         0,
3544                                         0,
3545                                 /*129*/ 0,
3546                                         MatTransposeMatMult_SeqAIJ_SeqAIJ,
3547                                         MatTransposeMatMultSymbolic_SeqAIJ_SeqAIJ,
3548                                         MatTransposeMatMultNumeric_SeqAIJ_SeqAIJ,
3549                                         MatTransposeColoringCreate_SeqAIJ,
3550                                 /*134*/ MatTransColoringApplySpToDen_SeqAIJ,
3551                                         MatTransColoringApplyDenToSp_SeqAIJ,
3552                                         MatRARt_SeqAIJ_SeqAIJ,
3553                                         MatRARtSymbolic_SeqAIJ_SeqAIJ,
3554                                         MatRARtNumeric_SeqAIJ_SeqAIJ,
3555                                  /*139*/0,
3556                                         0
3557 };
3558 
3559 #undef __FUNCT__
3560 #define __FUNCT__ "MatSeqAIJSetColumnIndices_SeqAIJ"
3561 PetscErrorCode  MatSeqAIJSetColumnIndices_SeqAIJ(Mat mat,PetscInt *indices)
3562 {
3563   Mat_SeqAIJ *aij = (Mat_SeqAIJ*)mat->data;
3564   PetscInt   i,nz,n;
3565 
3566   PetscFunctionBegin;
3567   nz = aij->maxnz;
3568   n  = mat->rmap->n;
3569   for (i=0; i<nz; i++) {
3570     aij->j[i] = indices[i];
3571   }
3572   aij->nz = nz;
3573   for (i=0; i<n; i++) {
3574     aij->ilen[i] = aij->imax[i];
3575   }
3576   PetscFunctionReturn(0);
3577 }
3578 
3579 #undef __FUNCT__
3580 #define __FUNCT__ "MatSeqAIJSetColumnIndices"
3581 /*@
3582     MatSeqAIJSetColumnIndices - Set the column indices for all the rows
3583        in the matrix.
3584 
3585   Input Parameters:
3586 +  mat - the SeqAIJ matrix
3587 -  indices - the column indices
3588 
3589   Level: advanced
3590 
3591   Notes:
3592     This can be called if you have precomputed the nonzero structure of the
3593   matrix and want to provide it to the matrix object to improve the performance
3594   of the MatSetValues() operation.
3595 
3596     You MUST have set the correct numbers of nonzeros per row in the call to
3597   MatCreateSeqAIJ(), and the columns indices MUST be sorted.
3598 
3599     MUST be called before any calls to MatSetValues();
3600 
3601     The indices should start with zero, not one.
3602 
3603 @*/
3604 PetscErrorCode  MatSeqAIJSetColumnIndices(Mat mat,PetscInt *indices)
3605 {
3606   PetscErrorCode ierr;
3607 
3608   PetscFunctionBegin;
3609   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3610   PetscValidPointer(indices,2);
3611   ierr = PetscUseMethod(mat,"MatSeqAIJSetColumnIndices_C",(Mat,PetscInt*),(mat,indices));CHKERRQ(ierr);
3612   PetscFunctionReturn(0);
3613 }
3614 
3615 /* ----------------------------------------------------------------------------------------*/
3616 
3617 #undef __FUNCT__
3618 #define __FUNCT__ "MatStoreValues_SeqAIJ"
3619 PetscErrorCode  MatStoreValues_SeqAIJ(Mat mat)
3620 {
3621   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)mat->data;
3622   PetscErrorCode ierr;
3623   size_t         nz = aij->i[mat->rmap->n];
3624 
3625   PetscFunctionBegin;
3626   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3627 
3628   /* allocate space for values if not already there */
3629   if (!aij->saved_values) {
3630     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&aij->saved_values);CHKERRQ(ierr);
3631     ierr = PetscLogObjectMemory((PetscObject)mat,(nz+1)*sizeof(PetscScalar));CHKERRQ(ierr);
3632   }
3633 
3634   /* copy values over */
3635   ierr = PetscMemcpy(aij->saved_values,aij->a,nz*sizeof(PetscScalar));CHKERRQ(ierr);
3636   PetscFunctionReturn(0);
3637 }
3638 
3639 #undef __FUNCT__
3640 #define __FUNCT__ "MatStoreValues"
3641 /*@
3642     MatStoreValues - Stashes a copy of the matrix values; this allows, for
3643        example, reuse of the linear part of a Jacobian, while recomputing the
3644        nonlinear portion.
3645 
3646    Collect on Mat
3647 
3648   Input Parameters:
3649 .  mat - the matrix (currently only AIJ matrices support this option)
3650 
3651   Level: advanced
3652 
3653   Common Usage, with SNESSolve():
3654 $    Create Jacobian matrix
3655 $    Set linear terms into matrix
3656 $    Apply boundary conditions to matrix, at this time matrix must have
3657 $      final nonzero structure (i.e. setting the nonlinear terms and applying
3658 $      boundary conditions again will not change the nonzero structure
3659 $    ierr = MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
3660 $    ierr = MatStoreValues(mat);
3661 $    Call SNESSetJacobian() with matrix
3662 $    In your Jacobian routine
3663 $      ierr = MatRetrieveValues(mat);
3664 $      Set nonlinear terms in matrix
3665 
3666   Common Usage without SNESSolve(), i.e. when you handle nonlinear solve yourself:
3667 $    // build linear portion of Jacobian
3668 $    ierr = MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
3669 $    ierr = MatStoreValues(mat);
3670 $    loop over nonlinear iterations
3671 $       ierr = MatRetrieveValues(mat);
3672 $       // call MatSetValues(mat,...) to set nonliner portion of Jacobian
3673 $       // call MatAssemblyBegin/End() on matrix
3674 $       Solve linear system with Jacobian
3675 $    endloop
3676 
3677   Notes:
3678     Matrix must already be assemblied before calling this routine
3679     Must set the matrix option MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE); before
3680     calling this routine.
3681 
3682     When this is called multiple times it overwrites the previous set of stored values
3683     and does not allocated additional space.
3684 
3685 .seealso: MatRetrieveValues()
3686 
3687 @*/
3688 PetscErrorCode  MatStoreValues(Mat mat)
3689 {
3690   PetscErrorCode ierr;
3691 
3692   PetscFunctionBegin;
3693   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3694   if (!mat->assembled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
3695   if (mat->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3696   ierr = PetscUseMethod(mat,"MatStoreValues_C",(Mat),(mat));CHKERRQ(ierr);
3697   PetscFunctionReturn(0);
3698 }
3699 
3700 #undef __FUNCT__
3701 #define __FUNCT__ "MatRetrieveValues_SeqAIJ"
3702 PetscErrorCode  MatRetrieveValues_SeqAIJ(Mat mat)
3703 {
3704   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)mat->data;
3705   PetscErrorCode ierr;
3706   PetscInt       nz = aij->i[mat->rmap->n];
3707 
3708   PetscFunctionBegin;
3709   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3710   if (!aij->saved_values) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatStoreValues(A);first");
3711   /* copy values over */
3712   ierr = PetscMemcpy(aij->a,aij->saved_values,nz*sizeof(PetscScalar));CHKERRQ(ierr);
3713   PetscFunctionReturn(0);
3714 }
3715 
3716 #undef __FUNCT__
3717 #define __FUNCT__ "MatRetrieveValues"
3718 /*@
3719     MatRetrieveValues - Retrieves the copy of the matrix values; this allows, for
3720        example, reuse of the linear part of a Jacobian, while recomputing the
3721        nonlinear portion.
3722 
3723    Collect on Mat
3724 
3725   Input Parameters:
3726 .  mat - the matrix (currently on AIJ matrices support this option)
3727 
3728   Level: advanced
3729 
3730 .seealso: MatStoreValues()
3731 
3732 @*/
3733 PetscErrorCode  MatRetrieveValues(Mat mat)
3734 {
3735   PetscErrorCode ierr;
3736 
3737   PetscFunctionBegin;
3738   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3739   if (!mat->assembled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
3740   if (mat->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3741   ierr = PetscUseMethod(mat,"MatRetrieveValues_C",(Mat),(mat));CHKERRQ(ierr);
3742   PetscFunctionReturn(0);
3743 }
3744 
3745 
3746 /* --------------------------------------------------------------------------------*/
3747 #undef __FUNCT__
3748 #define __FUNCT__ "MatCreateSeqAIJ"
3749 /*@C
3750    MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format
3751    (the default parallel PETSc format).  For good matrix assembly performance
3752    the user should preallocate the matrix storage by setting the parameter nz
3753    (or the array nnz).  By setting these parameters accurately, performance
3754    during matrix assembly can be increased by more than a factor of 50.
3755 
3756    Collective on MPI_Comm
3757 
3758    Input Parameters:
3759 +  comm - MPI communicator, set to PETSC_COMM_SELF
3760 .  m - number of rows
3761 .  n - number of columns
3762 .  nz - number of nonzeros per row (same for all rows)
3763 -  nnz - array containing the number of nonzeros in the various rows
3764          (possibly different for each row) or NULL
3765 
3766    Output Parameter:
3767 .  A - the matrix
3768 
3769    It is recommended that one use the MatCreate(), MatSetType() and/or MatSetFromOptions(),
3770    MatXXXXSetPreallocation() paradgm instead of this routine directly.
3771    [MatXXXXSetPreallocation() is, for example, MatSeqAIJSetPreallocation]
3772 
3773    Notes:
3774    If nnz is given then nz is ignored
3775 
3776    The AIJ format (also called the Yale sparse matrix format or
3777    compressed row storage), is fully compatible with standard Fortran 77
3778    storage.  That is, the stored row and column indices can begin at
3779    either one (as in Fortran) or zero.  See the users' manual for details.
3780 
3781    Specify the preallocated storage with either nz or nnz (not both).
3782    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
3783    allocation.  For large problems you MUST preallocate memory or you
3784    will get TERRIBLE performance, see the users' manual chapter on matrices.
3785 
3786    By default, this format uses inodes (identical nodes) when possible, to
3787    improve numerical efficiency of matrix-vector products and solves. We
3788    search for consecutive rows with the same nonzero structure, thereby
3789    reusing matrix information to achieve increased efficiency.
3790 
3791    Options Database Keys:
3792 +  -mat_no_inode  - Do not use inodes
3793 -  -mat_inode_limit <limit> - Sets inode limit (max limit=5)
3794 
3795    Level: intermediate
3796 
3797 .seealso: MatCreate(), MatCreateAIJ(), MatSetValues(), MatSeqAIJSetColumnIndices(), MatCreateSeqAIJWithArrays()
3798 
3799 @*/
3800 PetscErrorCode  MatCreateSeqAIJ(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt nz,const PetscInt nnz[],Mat *A)
3801 {
3802   PetscErrorCode ierr;
3803 
3804   PetscFunctionBegin;
3805   ierr = MatCreate(comm,A);CHKERRQ(ierr);
3806   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
3807   ierr = MatSetType(*A,MATSEQAIJ);CHKERRQ(ierr);
3808   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*A,nz,nnz);CHKERRQ(ierr);
3809   PetscFunctionReturn(0);
3810 }
3811 
3812 #undef __FUNCT__
3813 #define __FUNCT__ "MatSeqAIJSetPreallocation"
3814 /*@C
3815    MatSeqAIJSetPreallocation - For good matrix assembly performance
3816    the user should preallocate the matrix storage by setting the parameter nz
3817    (or the array nnz).  By setting these parameters accurately, performance
3818    during matrix assembly can be increased by more than a factor of 50.
3819 
3820    Collective on MPI_Comm
3821 
3822    Input Parameters:
3823 +  B - The matrix-free
3824 .  nz - number of nonzeros per row (same for all rows)
3825 -  nnz - array containing the number of nonzeros in the various rows
3826          (possibly different for each row) or NULL
3827 
3828    Notes:
3829      If nnz is given then nz is ignored
3830 
3831     The AIJ format (also called the Yale sparse matrix format or
3832    compressed row storage), is fully compatible with standard Fortran 77
3833    storage.  That is, the stored row and column indices can begin at
3834    either one (as in Fortran) or zero.  See the users' manual for details.
3835 
3836    Specify the preallocated storage with either nz or nnz (not both).
3837    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
3838    allocation.  For large problems you MUST preallocate memory or you
3839    will get TERRIBLE performance, see the users' manual chapter on matrices.
3840 
3841    You can call MatGetInfo() to get information on how effective the preallocation was;
3842    for example the fields mallocs,nz_allocated,nz_used,nz_unneeded;
3843    You can also run with the option -info and look for messages with the string
3844    malloc in them to see if additional memory allocation was needed.
3845 
3846    Developers: Use nz of MAT_SKIP_ALLOCATION to not allocate any space for the matrix
3847    entries or columns indices
3848 
3849    By default, this format uses inodes (identical nodes) when possible, to
3850    improve numerical efficiency of matrix-vector products and solves. We
3851    search for consecutive rows with the same nonzero structure, thereby
3852    reusing matrix information to achieve increased efficiency.
3853 
3854    Options Database Keys:
3855 +  -mat_no_inode  - Do not use inodes
3856 .  -mat_inode_limit <limit> - Sets inode limit (max limit=5)
3857 -  -mat_aij_oneindex - Internally use indexing starting at 1
3858         rather than 0.  Note that when calling MatSetValues(),
3859         the user still MUST index entries starting at 0!
3860 
3861    Level: intermediate
3862 
3863 .seealso: MatCreate(), MatCreateAIJ(), MatSetValues(), MatSeqAIJSetColumnIndices(), MatCreateSeqAIJWithArrays(), MatGetInfo()
3864 
3865 @*/
3866 PetscErrorCode  MatSeqAIJSetPreallocation(Mat B,PetscInt nz,const PetscInt nnz[])
3867 {
3868   PetscErrorCode ierr;
3869 
3870   PetscFunctionBegin;
3871   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
3872   PetscValidType(B,1);
3873   ierr = PetscTryMethod(B,"MatSeqAIJSetPreallocation_C",(Mat,PetscInt,const PetscInt[]),(B,nz,nnz));CHKERRQ(ierr);
3874   PetscFunctionReturn(0);
3875 }
3876 
3877 #undef __FUNCT__
3878 #define __FUNCT__ "MatSeqAIJSetPreallocation_SeqAIJ"
3879 PetscErrorCode  MatSeqAIJSetPreallocation_SeqAIJ(Mat B,PetscInt nz,const PetscInt *nnz)
3880 {
3881   Mat_SeqAIJ     *b;
3882   PetscBool      skipallocation = PETSC_FALSE,realalloc = PETSC_FALSE;
3883   PetscErrorCode ierr;
3884   PetscInt       i;
3885 
3886   PetscFunctionBegin;
3887   if (nz >= 0 || nnz) realalloc = PETSC_TRUE;
3888   if (nz == MAT_SKIP_ALLOCATION) {
3889     skipallocation = PETSC_TRUE;
3890     nz             = 0;
3891   }
3892 
3893   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
3894   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
3895 
3896   if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
3897   if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %d",nz);
3898   if (nnz) {
3899     for (i=0; i<B->rmap->n; i++) {
3900       if (nnz[i] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be less than 0: local row %d value %d",i,nnz[i]);
3901       if (nnz[i] > B->cmap->n) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be greater than row length: local row %d value %d rowlength %d",i,nnz[i],B->cmap->n);
3902     }
3903   }
3904 
3905   B->preallocated = PETSC_TRUE;
3906 
3907   b = (Mat_SeqAIJ*)B->data;
3908 
3909   if (!skipallocation) {
3910     if (!b->imax) {
3911       ierr = PetscMalloc2(B->rmap->n,PetscInt,&b->imax,B->rmap->n,PetscInt,&b->ilen);CHKERRQ(ierr);
3912       ierr = PetscLogObjectMemory((PetscObject)B,2*B->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
3913     }
3914     if (!nnz) {
3915       if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 10;
3916       else if (nz < 0) nz = 1;
3917       for (i=0; i<B->rmap->n; i++) b->imax[i] = nz;
3918       nz = nz*B->rmap->n;
3919     } else {
3920       nz = 0;
3921       for (i=0; i<B->rmap->n; i++) {b->imax[i] = nnz[i]; nz += nnz[i];}
3922     }
3923     /* b->ilen will count nonzeros in each row so far. */
3924     for (i=0; i<B->rmap->n; i++) b->ilen[i] = 0;
3925 
3926     /* allocate the matrix space */
3927     ierr    = MatSeqXAIJFreeAIJ(B,&b->a,&b->j,&b->i);CHKERRQ(ierr);
3928     ierr    = PetscMalloc3(nz,PetscScalar,&b->a,nz,PetscInt,&b->j,B->rmap->n+1,PetscInt,&b->i);CHKERRQ(ierr);
3929     ierr    = PetscLogObjectMemory((PetscObject)B,(B->rmap->n+1)*sizeof(PetscInt)+nz*(sizeof(PetscScalar)+sizeof(PetscInt)));CHKERRQ(ierr);
3930     b->i[0] = 0;
3931     for (i=1; i<B->rmap->n+1; i++) {
3932       b->i[i] = b->i[i-1] + b->imax[i-1];
3933     }
3934     b->singlemalloc = PETSC_TRUE;
3935     b->free_a       = PETSC_TRUE;
3936     b->free_ij      = PETSC_TRUE;
3937 #if defined(PETSC_THREADCOMM_ACTIVE)
3938     ierr = MatZeroEntries_SeqAIJ(B);CHKERRQ(ierr);
3939 #endif
3940   } else {
3941     b->free_a  = PETSC_FALSE;
3942     b->free_ij = PETSC_FALSE;
3943   }
3944 
3945   b->nz               = 0;
3946   b->maxnz            = nz;
3947   B->info.nz_unneeded = (double)b->maxnz;
3948   if (realalloc) {
3949     ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3950   }
3951   PetscFunctionReturn(0);
3952 }
3953 
3954 #undef  __FUNCT__
3955 #define __FUNCT__  "MatSeqAIJSetPreallocationCSR"
3956 /*@
3957    MatSeqAIJSetPreallocationCSR - Allocates memory for a sparse sequential matrix in AIJ format.
3958 
3959    Input Parameters:
3960 +  B - the matrix
3961 .  i - the indices into j for the start of each row (starts with zero)
3962 .  j - the column indices for each row (starts with zero) these must be sorted for each row
3963 -  v - optional values in the matrix
3964 
3965    Level: developer
3966 
3967    The i,j,v values are COPIED with this routine; to avoid the copy use MatCreateSeqAIJWithArrays()
3968 
3969 .keywords: matrix, aij, compressed row, sparse, sequential
3970 
3971 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatSeqAIJSetPreallocation(), MatCreateSeqAIJ(), SeqAIJ
3972 @*/
3973 PetscErrorCode MatSeqAIJSetPreallocationCSR(Mat B,const PetscInt i[],const PetscInt j[],const PetscScalar v[])
3974 {
3975   PetscErrorCode ierr;
3976 
3977   PetscFunctionBegin;
3978   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
3979   PetscValidType(B,1);
3980   ierr = PetscTryMethod(B,"MatSeqAIJSetPreallocationCSR_C",(Mat,const PetscInt[],const PetscInt[],const PetscScalar[]),(B,i,j,v));CHKERRQ(ierr);
3981   PetscFunctionReturn(0);
3982 }
3983 
3984 #undef  __FUNCT__
3985 #define __FUNCT__  "MatSeqAIJSetPreallocationCSR_SeqAIJ"
3986 PetscErrorCode  MatSeqAIJSetPreallocationCSR_SeqAIJ(Mat B,const PetscInt Ii[],const PetscInt J[],const PetscScalar v[])
3987 {
3988   PetscInt       i;
3989   PetscInt       m,n;
3990   PetscInt       nz;
3991   PetscInt       *nnz, nz_max = 0;
3992   PetscScalar    *values;
3993   PetscErrorCode ierr;
3994 
3995   PetscFunctionBegin;
3996   if (Ii[0]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Ii[0] must be 0 it is %D", Ii[0]);
3997 
3998   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
3999   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
4000 
4001   ierr = MatGetSize(B, &m, &n);CHKERRQ(ierr);
4002   ierr = PetscMalloc((m+1) * sizeof(PetscInt), &nnz);CHKERRQ(ierr);
4003   for (i = 0; i < m; i++) {
4004     nz     = Ii[i+1]- Ii[i];
4005     nz_max = PetscMax(nz_max, nz);
4006     if (nz < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Local row %D has a negative number of columns %D", i, nnz);
4007     nnz[i] = nz;
4008   }
4009   ierr = MatSeqAIJSetPreallocation(B, 0, nnz);CHKERRQ(ierr);
4010   ierr = PetscFree(nnz);CHKERRQ(ierr);
4011 
4012   if (v) {
4013     values = (PetscScalar*) v;
4014   } else {
4015     ierr = PetscMalloc(nz_max*sizeof(PetscScalar), &values);CHKERRQ(ierr);
4016     ierr = PetscMemzero(values, nz_max*sizeof(PetscScalar));CHKERRQ(ierr);
4017   }
4018 
4019   for (i = 0; i < m; i++) {
4020     nz   = Ii[i+1] - Ii[i];
4021     ierr = MatSetValues_SeqAIJ(B, 1, &i, nz, J+Ii[i], values + (v ? Ii[i] : 0), INSERT_VALUES);CHKERRQ(ierr);
4022   }
4023 
4024   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4025   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4026 
4027   if (!v) {
4028     ierr = PetscFree(values);CHKERRQ(ierr);
4029   }
4030   ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
4031   PetscFunctionReturn(0);
4032 }
4033 
4034 #include <../src/mat/impls/dense/seq/dense.h>
4035 #include <petsc-private/kernels/petscaxpy.h>
4036 
4037 #undef __FUNCT__
4038 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqAIJ"
4039 /*
4040     Computes (B'*A')' since computing B*A directly is untenable
4041 
4042                n                       p                          p
4043         (              )       (              )         (                  )
4044       m (      A       )  *  n (       B      )   =   m (         C        )
4045         (              )       (              )         (                  )
4046 
4047 */
4048 PetscErrorCode MatMatMultNumeric_SeqDense_SeqAIJ(Mat A,Mat B,Mat C)
4049 {
4050   PetscErrorCode    ierr;
4051   Mat_SeqDense      *sub_a = (Mat_SeqDense*)A->data;
4052   Mat_SeqAIJ        *sub_b = (Mat_SeqAIJ*)B->data;
4053   Mat_SeqDense      *sub_c = (Mat_SeqDense*)C->data;
4054   PetscInt          i,n,m,q,p;
4055   const PetscInt    *ii,*idx;
4056   const PetscScalar *b,*a,*a_q;
4057   PetscScalar       *c,*c_q;
4058 
4059   PetscFunctionBegin;
4060   m    = A->rmap->n;
4061   n    = A->cmap->n;
4062   p    = B->cmap->n;
4063   a    = sub_a->v;
4064   b    = sub_b->a;
4065   c    = sub_c->v;
4066   ierr = PetscMemzero(c,m*p*sizeof(PetscScalar));CHKERRQ(ierr);
4067 
4068   ii  = sub_b->i;
4069   idx = sub_b->j;
4070   for (i=0; i<n; i++) {
4071     q = ii[i+1] - ii[i];
4072     while (q-->0) {
4073       c_q = c + m*(*idx);
4074       a_q = a + m*i;
4075       PetscKernelAXPY(c_q,*b,a_q,m);
4076       idx++;
4077       b++;
4078     }
4079   }
4080   PetscFunctionReturn(0);
4081 }
4082 
4083 #undef __FUNCT__
4084 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqAIJ"
4085 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqAIJ(Mat A,Mat B,PetscReal fill,Mat *C)
4086 {
4087   PetscErrorCode ierr;
4088   PetscInt       m=A->rmap->n,n=B->cmap->n;
4089   Mat            Cmat;
4090 
4091   PetscFunctionBegin;
4092   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);
4093   ierr = MatCreate(PetscObjectComm((PetscObject)A),&Cmat);CHKERRQ(ierr);
4094   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
4095   ierr = MatSetBlockSizes(Cmat,A->rmap->bs,B->cmap->bs);CHKERRQ(ierr);
4096   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
4097   ierr = MatSeqDenseSetPreallocation(Cmat,NULL);CHKERRQ(ierr);
4098 
4099   Cmat->ops->matmultnumeric = MatMatMultNumeric_SeqDense_SeqAIJ;
4100 
4101   *C = Cmat;
4102   PetscFunctionReturn(0);
4103 }
4104 
4105 /* ----------------------------------------------------------------*/
4106 #undef __FUNCT__
4107 #define __FUNCT__ "MatMatMult_SeqDense_SeqAIJ"
4108 PetscErrorCode MatMatMult_SeqDense_SeqAIJ(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
4109 {
4110   PetscErrorCode ierr;
4111 
4112   PetscFunctionBegin;
4113   if (scall == MAT_INITIAL_MATRIX) {
4114     ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
4115     ierr = MatMatMultSymbolic_SeqDense_SeqAIJ(A,B,fill,C);CHKERRQ(ierr);
4116     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
4117   }
4118   ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
4119   ierr = MatMatMultNumeric_SeqDense_SeqAIJ(A,B,*C);CHKERRQ(ierr);
4120   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
4121   PetscFunctionReturn(0);
4122 }
4123 
4124 
4125 /*MC
4126    MATSEQAIJ - MATSEQAIJ = "seqaij" - A matrix type to be used for sequential sparse matrices,
4127    based on compressed sparse row format.
4128 
4129    Options Database Keys:
4130 . -mat_type seqaij - sets the matrix type to "seqaij" during a call to MatSetFromOptions()
4131 
4132   Level: beginner
4133 
4134 .seealso: MatCreateSeqAIJ(), MatSetFromOptions(), MatSetType(), MatCreate(), MatType
4135 M*/
4136 
4137 /*MC
4138    MATAIJ - MATAIJ = "aij" - A matrix type to be used for sparse matrices.
4139 
4140    This matrix type is identical to MATSEQAIJ when constructed with a single process communicator,
4141    and MATMPIAIJ otherwise.  As a result, for single process communicators,
4142   MatSeqAIJSetPreallocation is supported, and similarly MatMPIAIJSetPreallocation is supported
4143   for communicators controlling multiple processes.  It is recommended that you call both of
4144   the above preallocation routines for simplicity.
4145 
4146    Options Database Keys:
4147 . -mat_type aij - sets the matrix type to "aij" during a call to MatSetFromOptions()
4148 
4149   Developer Notes: Subclasses include MATAIJCUSP, MATAIJPERM, MATAIJCRL, and also automatically switches over to use inodes when
4150    enough exist.
4151 
4152   Level: beginner
4153 
4154 .seealso: MatCreateAIJ(), MatCreateSeqAIJ(), MATSEQAIJ,MATMPIAIJ
4155 M*/
4156 
4157 /*MC
4158    MATAIJCRL - MATAIJCRL = "aijcrl" - A matrix type to be used for sparse matrices.
4159 
4160    This matrix type is identical to MATSEQAIJCRL when constructed with a single process communicator,
4161    and MATMPIAIJCRL otherwise.  As a result, for single process communicators,
4162    MatSeqAIJSetPreallocation() is supported, and similarly MatMPIAIJSetPreallocation() is supported
4163   for communicators controlling multiple processes.  It is recommended that you call both of
4164   the above preallocation routines for simplicity.
4165 
4166    Options Database Keys:
4167 . -mat_type aijcrl - sets the matrix type to "aijcrl" during a call to MatSetFromOptions()
4168 
4169   Level: beginner
4170 
4171 .seealso: MatCreateMPIAIJCRL,MATSEQAIJCRL,MATMPIAIJCRL, MATSEQAIJCRL, MATMPIAIJCRL
4172 M*/
4173 
4174 #if defined(PETSC_HAVE_PASTIX)
4175 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_pastix(Mat,MatFactorType,Mat*);
4176 #endif
4177 #if defined(PETSC_HAVE_ESSL) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_REAL_SINGLE) && !defined(PETSC_USE_REAL___FLOAT128)
4178 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_essl(Mat,MatFactorType,Mat*);
4179 #endif
4180 PETSC_EXTERN PetscErrorCode MatConvert_SeqAIJ_SeqAIJCRL(Mat,MatType,MatReuse,Mat*);
4181 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_petsc(Mat,MatFactorType,Mat*);
4182 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_bas(Mat,MatFactorType,Mat*);
4183 extern PetscErrorCode  MatGetFactorAvailable_seqaij_petsc(Mat,MatFactorType,PetscBool*);
4184 #if defined(PETSC_HAVE_MUMPS)
4185 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_mumps(Mat,MatFactorType,Mat*);
4186 #endif
4187 #if defined(PETSC_HAVE_SUPERLU)
4188 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_superlu(Mat,MatFactorType,Mat*);
4189 #endif
4190 #if defined(PETSC_HAVE_SUPERLU_DIST)
4191 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_superlu_dist(Mat,MatFactorType,Mat*);
4192 #endif
4193 #if defined(PETSC_HAVE_UMFPACK)
4194 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_umfpack(Mat,MatFactorType,Mat*);
4195 #endif
4196 #if defined(PETSC_HAVE_CHOLMOD)
4197 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_cholmod(Mat,MatFactorType,Mat*);
4198 #endif
4199 #if defined(PETSC_HAVE_LUSOL)
4200 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_lusol(Mat,MatFactorType,Mat*);
4201 #endif
4202 #if defined(PETSC_HAVE_MATLAB_ENGINE)
4203 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_matlab(Mat,MatFactorType,Mat*);
4204 extern PetscErrorCode  MatlabEnginePut_SeqAIJ(PetscObject,void*);
4205 extern PetscErrorCode  MatlabEngineGet_SeqAIJ(PetscObject,void*);
4206 #endif
4207 #if defined(PETSC_HAVE_CLIQUE)
4208 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_clique(Mat,MatFactorType,Mat*);
4209 #endif
4210 
4211 
4212 #undef __FUNCT__
4213 #define __FUNCT__ "MatSeqAIJGetArray"
4214 /*@C
4215    MatSeqAIJGetArray - gives access to the array where the data for a SeqSeqAIJ matrix is stored
4216 
4217    Not Collective
4218 
4219    Input Parameter:
4220 .  mat - a MATSEQDENSE matrix
4221 
4222    Output Parameter:
4223 .   array - pointer to the data
4224 
4225    Level: intermediate
4226 
4227 .seealso: MatSeqAIJRestoreArray(), MatSeqAIJGetArrayF90()
4228 @*/
4229 PetscErrorCode  MatSeqAIJGetArray(Mat A,PetscScalar **array)
4230 {
4231   PetscErrorCode ierr;
4232 
4233   PetscFunctionBegin;
4234   ierr = PetscUseMethod(A,"MatSeqAIJGetArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
4235   PetscFunctionReturn(0);
4236 }
4237 
4238 #undef __FUNCT__
4239 #define __FUNCT__ "MatSeqAIJRestoreArray"
4240 /*@C
4241    MatSeqAIJRestoreArray - returns access to the array where the data for a SeqSeqAIJ matrix is stored obtained by MatSeqAIJGetArray()
4242 
4243    Not Collective
4244 
4245    Input Parameters:
4246 .  mat - a MATSEQDENSE matrix
4247 .  array - pointer to the data
4248 
4249    Level: intermediate
4250 
4251 .seealso: MatSeqAIJGetArray(), MatSeqAIJRestoreArrayF90()
4252 @*/
4253 PetscErrorCode  MatSeqAIJRestoreArray(Mat A,PetscScalar **array)
4254 {
4255   PetscErrorCode ierr;
4256 
4257   PetscFunctionBegin;
4258   ierr = PetscUseMethod(A,"MatSeqAIJRestoreArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
4259   PetscFunctionReturn(0);
4260 }
4261 
4262 #undef __FUNCT__
4263 #define __FUNCT__ "MatCreate_SeqAIJ"
4264 PETSC_EXTERN PetscErrorCode MatCreate_SeqAIJ(Mat B)
4265 {
4266   Mat_SeqAIJ     *b;
4267   PetscErrorCode ierr;
4268   PetscMPIInt    size;
4269 
4270   PetscFunctionBegin;
4271   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)B),&size);CHKERRQ(ierr);
4272   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Comm must be of size 1");
4273 
4274   ierr = PetscNewLog(B,Mat_SeqAIJ,&b);CHKERRQ(ierr);
4275 
4276   B->data = (void*)b;
4277 
4278   ierr = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
4279 
4280   b->row                = 0;
4281   b->col                = 0;
4282   b->icol               = 0;
4283   b->reallocs           = 0;
4284   b->ignorezeroentries  = PETSC_FALSE;
4285   b->roworiented        = PETSC_TRUE;
4286   b->nonew              = 0;
4287   b->diag               = 0;
4288   b->solve_work         = 0;
4289   B->spptr              = 0;
4290   b->saved_values       = 0;
4291   b->idiag              = 0;
4292   b->mdiag              = 0;
4293   b->ssor_work          = 0;
4294   b->omega              = 1.0;
4295   b->fshift             = 0.0;
4296   b->idiagvalid         = PETSC_FALSE;
4297   b->ibdiagvalid        = PETSC_FALSE;
4298   b->keepnonzeropattern = PETSC_FALSE;
4299   b->xtoy               = 0;
4300   b->XtoY               = 0;
4301   B->same_nonzero       = PETSC_FALSE;
4302 
4303   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr);
4304   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJGetArray_C",MatSeqAIJGetArray_SeqAIJ);CHKERRQ(ierr);
4305   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJRestoreArray_C",MatSeqAIJRestoreArray_SeqAIJ);CHKERRQ(ierr);
4306 
4307 #if defined(PETSC_HAVE_MATLAB_ENGINE)
4308   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_matlab_C",MatGetFactor_seqaij_matlab);CHKERRQ(ierr);
4309   ierr = PetscObjectComposeFunction((PetscObject)B,"PetscMatlabEnginePut_C",MatlabEnginePut_SeqAIJ);CHKERRQ(ierr);
4310   ierr = PetscObjectComposeFunction((PetscObject)B,"PetscMatlabEngineGet_C",MatlabEngineGet_SeqAIJ);CHKERRQ(ierr);
4311 #endif
4312 #if defined(PETSC_HAVE_PASTIX)
4313   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_pastix_C",MatGetFactor_seqaij_pastix);CHKERRQ(ierr);
4314 #endif
4315 #if defined(PETSC_HAVE_ESSL) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_REAL_SINGLE) && !defined(PETSC_USE_REAL___FLOAT128)
4316   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_essl_C",MatGetFactor_seqaij_essl);CHKERRQ(ierr);
4317 #endif
4318 #if defined(PETSC_HAVE_SUPERLU)
4319   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_superlu_C",MatGetFactor_seqaij_superlu);CHKERRQ(ierr);
4320 #endif
4321 #if defined(PETSC_HAVE_SUPERLU_DIST)
4322   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_superlu_dist_C",MatGetFactor_seqaij_superlu_dist);CHKERRQ(ierr);
4323 #endif
4324 #if defined(PETSC_HAVE_MUMPS)
4325   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_mumps_C",MatGetFactor_aij_mumps);CHKERRQ(ierr);
4326 #endif
4327 #if defined(PETSC_HAVE_UMFPACK)
4328   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_umfpack_C",MatGetFactor_seqaij_umfpack);CHKERRQ(ierr);
4329 #endif
4330 #if defined(PETSC_HAVE_CHOLMOD)
4331   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_cholmod_C",MatGetFactor_seqaij_cholmod);CHKERRQ(ierr);
4332 #endif
4333 #if defined(PETSC_HAVE_LUSOL)
4334   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_lusol_C",MatGetFactor_seqaij_lusol);CHKERRQ(ierr);
4335 #endif
4336 #if defined(PETSC_HAVE_CLIQUE)
4337   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_clique_C",MatGetFactor_aij_clique);CHKERRQ(ierr);
4338 #endif
4339 
4340   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_petsc_C",MatGetFactor_seqaij_petsc);CHKERRQ(ierr);
4341   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactorAvailable_petsc_C",MatGetFactorAvailable_seqaij_petsc);CHKERRQ(ierr);
4342   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_bas_C",MatGetFactor_seqaij_bas);CHKERRQ(ierr);
4343   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetColumnIndices_C",MatSeqAIJSetColumnIndices_SeqAIJ);CHKERRQ(ierr);
4344   ierr = PetscObjectComposeFunction((PetscObject)B,"MatStoreValues_C",MatStoreValues_SeqAIJ);CHKERRQ(ierr);
4345   ierr = PetscObjectComposeFunction((PetscObject)B,"MatRetrieveValues_C",MatRetrieveValues_SeqAIJ);CHKERRQ(ierr);
4346   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqsbaij_C",MatConvert_SeqAIJ_SeqSBAIJ);CHKERRQ(ierr);
4347   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqbaij_C",MatConvert_SeqAIJ_SeqBAIJ);CHKERRQ(ierr);
4348   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqaijperm_C",MatConvert_SeqAIJ_SeqAIJPERM);CHKERRQ(ierr);
4349   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqaijcrl_C",MatConvert_SeqAIJ_SeqAIJCRL);CHKERRQ(ierr);
4350   ierr = PetscObjectComposeFunction((PetscObject)B,"MatIsTranspose_C",MatIsTranspose_SeqAIJ);CHKERRQ(ierr);
4351   ierr = PetscObjectComposeFunction((PetscObject)B,"MatIsHermitianTranspose_C",MatIsTranspose_SeqAIJ);CHKERRQ(ierr);
4352   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetPreallocation_C",MatSeqAIJSetPreallocation_SeqAIJ);CHKERRQ(ierr);
4353   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetPreallocationCSR_C",MatSeqAIJSetPreallocationCSR_SeqAIJ);CHKERRQ(ierr);
4354   ierr = PetscObjectComposeFunction((PetscObject)B,"MatReorderForNonzeroDiagonal_C",MatReorderForNonzeroDiagonal_SeqAIJ);CHKERRQ(ierr);
4355   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMult_seqdense_seqaij_C",MatMatMult_SeqDense_SeqAIJ);CHKERRQ(ierr);
4356   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultSymbolic_seqdense_seqaij_C",MatMatMultSymbolic_SeqDense_SeqAIJ);CHKERRQ(ierr);
4357   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultNumeric_seqdense_seqaij_C",MatMatMultNumeric_SeqDense_SeqAIJ);CHKERRQ(ierr);
4358   ierr = MatCreate_SeqAIJ_Inode(B);CHKERRQ(ierr);
4359   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr);
4360   PetscFunctionReturn(0);
4361 }
4362 
4363 #undef __FUNCT__
4364 #define __FUNCT__ "MatDuplicateNoCreate_SeqAIJ"
4365 /*
4366     Given a matrix generated with MatGetFactor() duplicates all the information in A into B
4367 */
4368 PetscErrorCode MatDuplicateNoCreate_SeqAIJ(Mat C,Mat A,MatDuplicateOption cpvalues,PetscBool mallocmatspace)
4369 {
4370   Mat_SeqAIJ     *c,*a = (Mat_SeqAIJ*)A->data;
4371   PetscErrorCode ierr;
4372   PetscInt       i,m = A->rmap->n;
4373 
4374   PetscFunctionBegin;
4375   c = (Mat_SeqAIJ*)C->data;
4376 
4377   C->factortype = A->factortype;
4378   c->row        = 0;
4379   c->col        = 0;
4380   c->icol       = 0;
4381   c->reallocs   = 0;
4382 
4383   C->assembled = PETSC_TRUE;
4384 
4385   ierr = PetscLayoutReference(A->rmap,&C->rmap);CHKERRQ(ierr);
4386   ierr = PetscLayoutReference(A->cmap,&C->cmap);CHKERRQ(ierr);
4387 
4388   ierr = PetscMalloc2(m,PetscInt,&c->imax,m,PetscInt,&c->ilen);CHKERRQ(ierr);
4389   ierr = PetscLogObjectMemory((PetscObject)C, 2*m*sizeof(PetscInt));CHKERRQ(ierr);
4390   for (i=0; i<m; i++) {
4391     c->imax[i] = a->imax[i];
4392     c->ilen[i] = a->ilen[i];
4393   }
4394 
4395   /* allocate the matrix space */
4396   if (mallocmatspace) {
4397     ierr = PetscMalloc3(a->i[m],PetscScalar,&c->a,a->i[m],PetscInt,&c->j,m+1,PetscInt,&c->i);CHKERRQ(ierr);
4398     ierr = PetscLogObjectMemory((PetscObject)C, a->i[m]*(sizeof(PetscScalar)+sizeof(PetscInt))+(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4399 
4400     c->singlemalloc = PETSC_TRUE;
4401 
4402     ierr = PetscMemcpy(c->i,a->i,(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4403     if (m > 0) {
4404       ierr = PetscMemcpy(c->j,a->j,(a->i[m])*sizeof(PetscInt));CHKERRQ(ierr);
4405       if (cpvalues == MAT_COPY_VALUES) {
4406         ierr = PetscMemcpy(c->a,a->a,(a->i[m])*sizeof(PetscScalar));CHKERRQ(ierr);
4407       } else {
4408         ierr = PetscMemzero(c->a,(a->i[m])*sizeof(PetscScalar));CHKERRQ(ierr);
4409       }
4410     }
4411   }
4412 
4413   c->ignorezeroentries = a->ignorezeroentries;
4414   c->roworiented       = a->roworiented;
4415   c->nonew             = a->nonew;
4416   if (a->diag) {
4417     ierr = PetscMalloc((m+1)*sizeof(PetscInt),&c->diag);CHKERRQ(ierr);
4418     ierr = PetscLogObjectMemory((PetscObject)C,(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4419     for (i=0; i<m; i++) {
4420       c->diag[i] = a->diag[i];
4421     }
4422   } else c->diag = 0;
4423 
4424   c->solve_work         = 0;
4425   c->saved_values       = 0;
4426   c->idiag              = 0;
4427   c->ssor_work          = 0;
4428   c->keepnonzeropattern = a->keepnonzeropattern;
4429   c->free_a             = PETSC_TRUE;
4430   c->free_ij            = PETSC_TRUE;
4431   c->xtoy               = 0;
4432   c->XtoY               = 0;
4433 
4434   c->rmax         = a->rmax;
4435   c->nz           = a->nz;
4436   c->maxnz        = a->nz;       /* Since we allocate exactly the right amount */
4437   C->preallocated = PETSC_TRUE;
4438 
4439   c->compressedrow.use   = a->compressedrow.use;
4440   c->compressedrow.nrows = a->compressedrow.nrows;
4441   c->compressedrow.check = a->compressedrow.check;
4442   if (a->compressedrow.use) {
4443     i    = a->compressedrow.nrows;
4444     ierr = PetscMalloc2(i+1,PetscInt,&c->compressedrow.i,i,PetscInt,&c->compressedrow.rindex);CHKERRQ(ierr);
4445     ierr = PetscMemcpy(c->compressedrow.i,a->compressedrow.i,(i+1)*sizeof(PetscInt));CHKERRQ(ierr);
4446     ierr = PetscMemcpy(c->compressedrow.rindex,a->compressedrow.rindex,i*sizeof(PetscInt));CHKERRQ(ierr);
4447   } else {
4448     c->compressedrow.use    = PETSC_FALSE;
4449     c->compressedrow.i      = NULL;
4450     c->compressedrow.rindex = NULL;
4451   }
4452   C->same_nonzero = A->same_nonzero;
4453 
4454   ierr = MatDuplicate_SeqAIJ_Inode(A,cpvalues,&C);CHKERRQ(ierr);
4455   ierr = PetscFunctionListDuplicate(((PetscObject)A)->qlist,&((PetscObject)C)->qlist);CHKERRQ(ierr);
4456   PetscFunctionReturn(0);
4457 }
4458 
4459 #undef __FUNCT__
4460 #define __FUNCT__ "MatDuplicate_SeqAIJ"
4461 PetscErrorCode MatDuplicate_SeqAIJ(Mat A,MatDuplicateOption cpvalues,Mat *B)
4462 {
4463   PetscErrorCode ierr;
4464 
4465   PetscFunctionBegin;
4466   ierr = MatCreate(PetscObjectComm((PetscObject)A),B);CHKERRQ(ierr);
4467   ierr = MatSetSizes(*B,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
4468   ierr = MatSetBlockSizes(*B,A->rmap->bs,A->cmap->bs);CHKERRQ(ierr);
4469   ierr = MatSetType(*B,((PetscObject)A)->type_name);CHKERRQ(ierr);
4470   ierr = MatDuplicateNoCreate_SeqAIJ(*B,A,cpvalues,PETSC_TRUE);CHKERRQ(ierr);
4471   PetscFunctionReturn(0);
4472 }
4473 
4474 #undef __FUNCT__
4475 #define __FUNCT__ "MatLoad_SeqAIJ"
4476 PetscErrorCode MatLoad_SeqAIJ(Mat newMat, PetscViewer viewer)
4477 {
4478   Mat_SeqAIJ     *a;
4479   PetscErrorCode ierr;
4480   PetscInt       i,sum,nz,header[4],*rowlengths = 0,M,N,rows,cols;
4481   int            fd;
4482   PetscMPIInt    size;
4483   MPI_Comm       comm;
4484   PetscInt       bs = 1;
4485 
4486   PetscFunctionBegin;
4487   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
4488   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4489   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"view must have one processor");
4490 
4491   ierr = PetscOptionsBegin(comm,NULL,"Options for loading SEQAIJ matrix","Mat");CHKERRQ(ierr);
4492   ierr = PetscOptionsInt("-matload_block_size","Set the blocksize used to store the matrix","MatLoad",bs,&bs,NULL);CHKERRQ(ierr);
4493   ierr = PetscOptionsEnd();CHKERRQ(ierr);
4494   if (bs > 1) {ierr = MatSetBlockSize(newMat,bs);CHKERRQ(ierr);}
4495 
4496   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
4497   ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr);
4498   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"not matrix object in file");
4499   M = header[1]; N = header[2]; nz = header[3];
4500 
4501   if (nz < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Matrix stored in special format on disk,cannot load as SeqAIJ");
4502 
4503   /* read in row lengths */
4504   ierr = PetscMalloc(M*sizeof(PetscInt),&rowlengths);CHKERRQ(ierr);
4505   ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr);
4506 
4507   /* check if sum of rowlengths is same as nz */
4508   for (i=0,sum=0; i< M; i++) sum +=rowlengths[i];
4509   if (sum != nz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"Inconsistant matrix data in file. no-nonzeros = %d, sum-row-lengths = %d\n",nz,sum);
4510 
4511   /* set global size if not set already*/
4512   if (newMat->rmap->n < 0 && newMat->rmap->N < 0 && newMat->cmap->n < 0 && newMat->cmap->N < 0) {
4513     ierr = MatSetSizes(newMat,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
4514   } else {
4515     /* if sizes and type are already set, check if the vector global sizes are correct */
4516     ierr = MatGetSize(newMat,&rows,&cols);CHKERRQ(ierr);
4517     if (rows < 0 && cols < 0) { /* user might provide local size instead of global size */
4518       ierr = MatGetLocalSize(newMat,&rows,&cols);CHKERRQ(ierr);
4519     }
4520     if (M != rows ||  N != cols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,rows,cols);
4521   }
4522   ierr = MatSeqAIJSetPreallocation_SeqAIJ(newMat,0,rowlengths);CHKERRQ(ierr);
4523   a    = (Mat_SeqAIJ*)newMat->data;
4524 
4525   ierr = PetscBinaryRead(fd,a->j,nz,PETSC_INT);CHKERRQ(ierr);
4526 
4527   /* read in nonzero values */
4528   ierr = PetscBinaryRead(fd,a->a,nz,PETSC_SCALAR);CHKERRQ(ierr);
4529 
4530   /* set matrix "i" values */
4531   a->i[0] = 0;
4532   for (i=1; i<= M; i++) {
4533     a->i[i]      = a->i[i-1] + rowlengths[i-1];
4534     a->ilen[i-1] = rowlengths[i-1];
4535   }
4536   ierr = PetscFree(rowlengths);CHKERRQ(ierr);
4537 
4538   ierr = MatAssemblyBegin(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4539   ierr = MatAssemblyEnd(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4540   PetscFunctionReturn(0);
4541 }
4542 
4543 #undef __FUNCT__
4544 #define __FUNCT__ "MatEqual_SeqAIJ"
4545 PetscErrorCode MatEqual_SeqAIJ(Mat A,Mat B,PetscBool * flg)
4546 {
4547   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data,*b = (Mat_SeqAIJ*)B->data;
4548   PetscErrorCode ierr;
4549 #if defined(PETSC_USE_COMPLEX)
4550   PetscInt k;
4551 #endif
4552 
4553   PetscFunctionBegin;
4554   /* If the  matrix dimensions are not equal,or no of nonzeros */
4555   if ((A->rmap->n != B->rmap->n) || (A->cmap->n != B->cmap->n) ||(a->nz != b->nz)) {
4556     *flg = PETSC_FALSE;
4557     PetscFunctionReturn(0);
4558   }
4559 
4560   /* if the a->i are the same */
4561   ierr = PetscMemcmp(a->i,b->i,(A->rmap->n+1)*sizeof(PetscInt),flg);CHKERRQ(ierr);
4562   if (!*flg) PetscFunctionReturn(0);
4563 
4564   /* if a->j are the same */
4565   ierr = PetscMemcmp(a->j,b->j,(a->nz)*sizeof(PetscInt),flg);CHKERRQ(ierr);
4566   if (!*flg) PetscFunctionReturn(0);
4567 
4568   /* if a->a are the same */
4569 #if defined(PETSC_USE_COMPLEX)
4570   for (k=0; k<a->nz; k++) {
4571     if (PetscRealPart(a->a[k]) != PetscRealPart(b->a[k]) || PetscImaginaryPart(a->a[k]) != PetscImaginaryPart(b->a[k])) {
4572       *flg = PETSC_FALSE;
4573       PetscFunctionReturn(0);
4574     }
4575   }
4576 #else
4577   ierr = PetscMemcmp(a->a,b->a,(a->nz)*sizeof(PetscScalar),flg);CHKERRQ(ierr);
4578 #endif
4579   PetscFunctionReturn(0);
4580 }
4581 
4582 #undef __FUNCT__
4583 #define __FUNCT__ "MatCreateSeqAIJWithArrays"
4584 /*@
4585      MatCreateSeqAIJWithArrays - Creates an sequential AIJ matrix using matrix elements (in CSR format)
4586               provided by the user.
4587 
4588       Collective on MPI_Comm
4589 
4590    Input Parameters:
4591 +   comm - must be an MPI communicator of size 1
4592 .   m - number of rows
4593 .   n - number of columns
4594 .   i - row indices
4595 .   j - column indices
4596 -   a - matrix values
4597 
4598    Output Parameter:
4599 .   mat - the matrix
4600 
4601    Level: intermediate
4602 
4603    Notes:
4604        The i, j, and a arrays are not copied by this routine, the user must free these arrays
4605     once the matrix is destroyed and not before
4606 
4607        You cannot set new nonzero locations into this matrix, that will generate an error.
4608 
4609        The i and j indices are 0 based
4610 
4611        The format which is used for the sparse matrix input, is equivalent to a
4612     row-major ordering.. i.e for the following matrix, the input data expected is
4613     as shown:
4614 
4615         1 0 0
4616         2 0 3
4617         4 5 6
4618 
4619         i =  {0,1,3,6}  [size = nrow+1  = 3+1]
4620         j =  {0,0,2,0,1,2}  [size = nz = 6]; values must be sorted for each row
4621         v =  {1,2,3,4,5,6}  [size = nz = 6]
4622 
4623 
4624 .seealso: MatCreate(), MatCreateAIJ(), MatCreateSeqAIJ(), MatCreateMPIAIJWithArrays(), MatMPIAIJSetPreallocationCSR()
4625 
4626 @*/
4627 PetscErrorCode  MatCreateSeqAIJWithArrays(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat)
4628 {
4629   PetscErrorCode ierr;
4630   PetscInt       ii;
4631   Mat_SeqAIJ     *aij;
4632 #if defined(PETSC_USE_DEBUG)
4633   PetscInt jj;
4634 #endif
4635 
4636   PetscFunctionBegin;
4637   if (i[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i (row indices) must start with 0");
4638   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
4639   ierr = MatSetSizes(*mat,m,n,m,n);CHKERRQ(ierr);
4640   /* ierr = MatSetBlockSizes(*mat,,);CHKERRQ(ierr); */
4641   ierr = MatSetType(*mat,MATSEQAIJ);CHKERRQ(ierr);
4642   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*mat,MAT_SKIP_ALLOCATION,0);CHKERRQ(ierr);
4643   aij  = (Mat_SeqAIJ*)(*mat)->data;
4644   ierr = PetscMalloc2(m,PetscInt,&aij->imax,m,PetscInt,&aij->ilen);CHKERRQ(ierr);
4645 
4646   aij->i            = i;
4647   aij->j            = j;
4648   aij->a            = a;
4649   aij->singlemalloc = PETSC_FALSE;
4650   aij->nonew        = -1;             /*this indicates that inserting a new value in the matrix that generates a new nonzero is an error*/
4651   aij->free_a       = PETSC_FALSE;
4652   aij->free_ij      = PETSC_FALSE;
4653 
4654   for (ii=0; ii<m; ii++) {
4655     aij->ilen[ii] = aij->imax[ii] = i[ii+1] - i[ii];
4656 #if defined(PETSC_USE_DEBUG)
4657     if (i[ii+1] - i[ii] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row length in i (row indices) row = %d length = %d",ii,i[ii+1] - i[ii]);
4658     for (jj=i[ii]+1; jj<i[ii+1]; jj++) {
4659       if (j[jj] < j[jj-1]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column entry number %D (actual colum %D) in row %D is not sorted",jj-i[ii],j[jj],ii);
4660       if (j[jj] == j[jj]-1) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column entry number %D (actual colum %D) in row %D is identical to previous entry",jj-i[ii],j[jj],ii);
4661     }
4662 #endif
4663   }
4664 #if defined(PETSC_USE_DEBUG)
4665   for (ii=0; ii<aij->i[m]; ii++) {
4666     if (j[ii] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column index at location = %d index = %d",ii,j[ii]);
4667     if (j[ii] > n - 1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column index to large at location = %d index = %d",ii,j[ii]);
4668   }
4669 #endif
4670 
4671   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4672   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4673   PetscFunctionReturn(0);
4674 }
4675 #undef __FUNCT__
4676 #define __FUNCT__ "MatCreateSeqAIJFromTriple"
4677 /*@C
4678      MatCreateSeqAIJFromTriple - Creates an sequential AIJ matrix using matrix elements (in COO format)
4679               provided by the user.
4680 
4681       Collective on MPI_Comm
4682 
4683    Input Parameters:
4684 +   comm - must be an MPI communicator of size 1
4685 .   m   - number of rows
4686 .   n   - number of columns
4687 .   i   - row indices
4688 .   j   - column indices
4689 .   a   - matrix values
4690 .   nz  - number of nonzeros
4691 -   idx - 0 or 1 based
4692 
4693    Output Parameter:
4694 .   mat - the matrix
4695 
4696    Level: intermediate
4697 
4698    Notes:
4699        The i and j indices are 0 based
4700 
4701        The format which is used for the sparse matrix input, is equivalent to a
4702     row-major ordering.. i.e for the following matrix, the input data expected is
4703     as shown:
4704 
4705         1 0 0
4706         2 0 3
4707         4 5 6
4708 
4709         i =  {0,1,1,2,2,2}
4710         j =  {0,0,2,0,1,2}
4711         v =  {1,2,3,4,5,6}
4712 
4713 
4714 .seealso: MatCreate(), MatCreateAIJ(), MatCreateSeqAIJ(), MatCreateSeqAIJWithArrays(), MatMPIAIJSetPreallocationCSR()
4715 
4716 @*/
4717 PetscErrorCode  MatCreateSeqAIJFromTriple(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat,PetscInt nz,PetscBool idx)
4718 {
4719   PetscErrorCode ierr;
4720   PetscInt       ii, *nnz, one = 1,row,col;
4721 
4722 
4723   PetscFunctionBegin;
4724   ierr = PetscMalloc(m*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
4725   ierr = PetscMemzero(nnz,m*sizeof(PetscInt));CHKERRQ(ierr);
4726   for (ii = 0; ii < nz; ii++) {
4727     nnz[i[ii]] += 1;
4728   }
4729   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
4730   ierr = MatSetSizes(*mat,m,n,m,n);CHKERRQ(ierr);
4731   /* ierr = MatSetBlockSizes(*mat,,);CHKERRQ(ierr); */
4732   ierr = MatSetType(*mat,MATSEQAIJ);CHKERRQ(ierr);
4733   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*mat,0,nnz);CHKERRQ(ierr);
4734   for (ii = 0; ii < nz; ii++) {
4735     if (idx) {
4736       row = i[ii] - 1;
4737       col = j[ii] - 1;
4738     } else {
4739       row = i[ii];
4740       col = j[ii];
4741     }
4742     ierr = MatSetValues(*mat,one,&row,one,&col,&a[ii],ADD_VALUES);CHKERRQ(ierr);
4743   }
4744   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4745   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4746   ierr = PetscFree(nnz);CHKERRQ(ierr);
4747   PetscFunctionReturn(0);
4748 }
4749 
4750 #undef __FUNCT__
4751 #define __FUNCT__ "MatSetColoring_SeqAIJ"
4752 PetscErrorCode MatSetColoring_SeqAIJ(Mat A,ISColoring coloring)
4753 {
4754   PetscErrorCode ierr;
4755   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
4756 
4757   PetscFunctionBegin;
4758   if (coloring->ctype == IS_COLORING_GLOBAL) {
4759     ierr        = ISColoringReference(coloring);CHKERRQ(ierr);
4760     a->coloring = coloring;
4761   } else if (coloring->ctype == IS_COLORING_GHOSTED) {
4762     PetscInt        i,*larray;
4763     ISColoring      ocoloring;
4764     ISColoringValue *colors;
4765 
4766     /* set coloring for diagonal portion */
4767     ierr = PetscMalloc(A->cmap->n*sizeof(PetscInt),&larray);CHKERRQ(ierr);
4768     for (i=0; i<A->cmap->n; i++) larray[i] = i;
4769     ierr = ISGlobalToLocalMappingApply(A->cmap->mapping,IS_GTOLM_MASK,A->cmap->n,larray,NULL,larray);CHKERRQ(ierr);
4770     ierr = PetscMalloc(A->cmap->n*sizeof(ISColoringValue),&colors);CHKERRQ(ierr);
4771     for (i=0; i<A->cmap->n; i++) colors[i] = coloring->colors[larray[i]];
4772     ierr        = PetscFree(larray);CHKERRQ(ierr);
4773     ierr        = ISColoringCreate(PETSC_COMM_SELF,coloring->n,A->cmap->n,colors,&ocoloring);CHKERRQ(ierr);
4774     a->coloring = ocoloring;
4775   }
4776   PetscFunctionReturn(0);
4777 }
4778 
4779 #undef __FUNCT__
4780 #define __FUNCT__ "MatSetValuesAdifor_SeqAIJ"
4781 PetscErrorCode MatSetValuesAdifor_SeqAIJ(Mat A,PetscInt nl,void *advalues)
4782 {
4783   Mat_SeqAIJ      *a      = (Mat_SeqAIJ*)A->data;
4784   PetscInt        m       = A->rmap->n,*ii = a->i,*jj = a->j,nz,i,j;
4785   MatScalar       *v      = a->a;
4786   PetscScalar     *values = (PetscScalar*)advalues;
4787   ISColoringValue *color;
4788 
4789   PetscFunctionBegin;
4790   if (!a->coloring) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Coloring not set for matrix");
4791   color = a->coloring->colors;
4792   /* loop over rows */
4793   for (i=0; i<m; i++) {
4794     nz = ii[i+1] - ii[i];
4795     /* loop over columns putting computed value into matrix */
4796     for (j=0; j<nz; j++) *v++ = values[color[*jj++]];
4797     values += nl; /* jump to next row of derivatives */
4798   }
4799   PetscFunctionReturn(0);
4800 }
4801 
4802 #undef __FUNCT__
4803 #define __FUNCT__ "MatSeqAIJInvalidateDiagonal"
4804 PetscErrorCode MatSeqAIJInvalidateDiagonal(Mat A)
4805 {
4806   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
4807   PetscErrorCode ierr;
4808 
4809   PetscFunctionBegin;
4810   a->idiagvalid  = PETSC_FALSE;
4811   a->ibdiagvalid = PETSC_FALSE;
4812 
4813   ierr = MatSeqAIJInvalidateDiagonal_Inode(A);CHKERRQ(ierr);
4814   PetscFunctionReturn(0);
4815 }
4816 
4817 /*
4818     Special version for direct calls from Fortran
4819 */
4820 #include <petsc-private/fortranimpl.h>
4821 #if defined(PETSC_HAVE_FORTRAN_CAPS)
4822 #define matsetvaluesseqaij_ MATSETVALUESSEQAIJ
4823 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
4824 #define matsetvaluesseqaij_ matsetvaluesseqaij
4825 #endif
4826 
4827 /* Change these macros so can be used in void function */
4828 #undef CHKERRQ
4829 #define CHKERRQ(ierr) CHKERRABORT(PetscObjectComm((PetscObject)A),ierr)
4830 #undef SETERRQ2
4831 #define SETERRQ2(comm,ierr,b,c,d) CHKERRABORT(comm,ierr)
4832 #undef SETERRQ3
4833 #define SETERRQ3(comm,ierr,b,c,d,e) CHKERRABORT(comm,ierr)
4834 
4835 #undef __FUNCT__
4836 #define __FUNCT__ "matsetvaluesseqaij_"
4837 PETSC_EXTERN void PETSC_STDCALL matsetvaluesseqaij_(Mat *AA,PetscInt *mm,const PetscInt im[],PetscInt *nn,const PetscInt in[],const PetscScalar v[],InsertMode *isis, PetscErrorCode *_ierr)
4838 {
4839   Mat            A  = *AA;
4840   PetscInt       m  = *mm, n = *nn;
4841   InsertMode     is = *isis;
4842   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
4843   PetscInt       *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax,N;
4844   PetscInt       *imax,*ai,*ailen;
4845   PetscErrorCode ierr;
4846   PetscInt       *aj,nonew = a->nonew,lastcol = -1;
4847   MatScalar      *ap,value,*aa;
4848   PetscBool      ignorezeroentries = a->ignorezeroentries;
4849   PetscBool      roworiented       = a->roworiented;
4850 
4851   PetscFunctionBegin;
4852   MatCheckPreallocated(A,1);
4853   imax  = a->imax;
4854   ai    = a->i;
4855   ailen = a->ilen;
4856   aj    = a->j;
4857   aa    = a->a;
4858 
4859   for (k=0; k<m; k++) { /* loop over added rows */
4860     row = im[k];
4861     if (row < 0) continue;
4862 #if defined(PETSC_USE_DEBUG)
4863     if (row >= A->rmap->n) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Row too large");
4864 #endif
4865     rp   = aj + ai[row]; ap = aa + ai[row];
4866     rmax = imax[row]; nrow = ailen[row];
4867     low  = 0;
4868     high = nrow;
4869     for (l=0; l<n; l++) { /* loop over added columns */
4870       if (in[l] < 0) continue;
4871 #if defined(PETSC_USE_DEBUG)
4872       if (in[l] >= A->cmap->n) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Column too large");
4873 #endif
4874       col = in[l];
4875       if (roworiented) value = v[l + k*n];
4876       else value = v[k + l*m];
4877 
4878       if (value == 0.0 && ignorezeroentries && (is == ADD_VALUES)) continue;
4879 
4880       if (col <= lastcol) low = 0;
4881       else high = nrow;
4882       lastcol = col;
4883       while (high-low > 5) {
4884         t = (low+high)/2;
4885         if (rp[t] > col) high = t;
4886         else             low  = t;
4887       }
4888       for (i=low; i<high; i++) {
4889         if (rp[i] > col) break;
4890         if (rp[i] == col) {
4891           if (is == ADD_VALUES) ap[i] += value;
4892           else                  ap[i] = value;
4893           goto noinsert;
4894         }
4895       }
4896       if (value == 0.0 && ignorezeroentries) goto noinsert;
4897       if (nonew == 1) goto noinsert;
4898       if (nonew == -1) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero in the matrix");
4899       MatSeqXAIJReallocateAIJ(A,A->rmap->n,1,nrow,row,col,rmax,aa,ai,aj,rp,ap,imax,nonew,MatScalar);
4900       N = nrow++ - 1; a->nz++; high++;
4901       /* shift up all the later entries in this row */
4902       for (ii=N; ii>=i; ii--) {
4903         rp[ii+1] = rp[ii];
4904         ap[ii+1] = ap[ii];
4905       }
4906       rp[i] = col;
4907       ap[i] = value;
4908 noinsert:;
4909       low = i + 1;
4910     }
4911     ailen[row] = nrow;
4912   }
4913   A->same_nonzero = PETSC_FALSE;
4914   PetscFunctionReturnVoid();
4915 }
4916 
4917 
4918