xref: /petsc/src/mat/impls/aij/seq/aij.c (revision 5922145e7ebc6091e16361dcc49b5893d9bf9399)
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,start,end,l,row,col,**vscaleforrow;
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   PetscInt       ctype   = coloring->ctype,N,col_start=0,col_end=0;
2714   Vec            x1_tmp;
2715   Mat_SeqAIJ     *csp = (Mat_SeqAIJ*)J->data;
2716   PetscInt       *den2sp=coloring->den2sp,*idx=den2sp;
2717   PetscScalar    *ca=csp->a;
2718   const PetscInt ncolors=coloring->ncolors,*ncolumns=coloring->ncolumns,*nrows=coloring->nrows;
2719   PetscInt       **rows=coloring->rows,**columns=coloring->columns,ncolumns_k,nrows_k;
2720 #if defined(JACOBIANCOLOROPT)
2721   PetscLogDouble t0,t1,time_setvalues=0.0;
2722 #endif
2723 
2724   PetscFunctionBegin;
2725   ierr = MatSetUnfactored(J);CHKERRQ(ierr);
2726   ierr = PetscOptionsGetBool(NULL,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
2727   if (flg) {
2728     ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
2729   } else {
2730     PetscBool assembled;
2731     ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
2732     if (assembled) {
2733       ierr = MatZeroEntries(J);CHKERRQ(ierr);
2734     }
2735   }
2736 
2737   x1_tmp = x1;
2738   if (!coloring->vscale) {
2739     ierr = VecDuplicate(x1_tmp,&coloring->vscale);CHKERRQ(ierr);
2740   }
2741 
2742   if (coloring->htype[0] == 'w') { /* tacky test; need to make systematic if we add other approaches to computing h*/
2743     ierr = VecNorm(x1_tmp,NORM_2,&unorm);CHKERRQ(ierr);
2744   }
2745   ierr = VecGetOwnershipRange(w1,&start,&end);CHKERRQ(ierr); /* OwnershipRange is used by ghosted x! */
2746 
2747   /* Set w1 = F(x1) */
2748   if (!coloring->fset) {
2749     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2750     ierr = (*f)(sctx,x1_tmp,w1,fctx);CHKERRQ(ierr);
2751     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2752   } else {
2753     coloring->fset = PETSC_FALSE;
2754   }
2755 
2756   if (!coloring->w3) {
2757     ierr = VecDuplicate(x1_tmp,&coloring->w3);CHKERRQ(ierr);
2758     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w3);CHKERRQ(ierr);
2759   }
2760   w3 = coloring->w3;
2761 
2762   /* Compute all the local scale factors, including ghost points */
2763   ierr = VecGetLocalSize(x1_tmp,&N);CHKERRQ(ierr);
2764   ierr = VecGetArray(x1_tmp,&xx);CHKERRQ(ierr);
2765   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2766   if (ctype == IS_COLORING_GHOSTED) {
2767     col_start = 0; col_end = N;
2768   } else if (ctype == IS_COLORING_GLOBAL) {
2769     xx           = xx - start;
2770     vscale_array = vscale_array - start;
2771     col_start    = start; col_end = N + start;
2772   }
2773   for (col=col_start; col<col_end; col++) {
2774     /* Loop over each local column, vscale[col] = 1./(epsilon*dx[col]) */
2775     if (coloring->htype[0] == 'w') {
2776       dx = 1.0 + unorm;
2777     } else {
2778       dx = xx[col];
2779     }
2780     if (dx == (PetscScalar)0.0) dx = 1.0;
2781     if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2782     else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2783     dx               *= epsilon;
2784     vscale_array[col] = (PetscScalar)1.0/dx;
2785   }
2786   if (ctype == IS_COLORING_GLOBAL) vscale_array = vscale_array + start;
2787   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2788   if (ctype == IS_COLORING_GLOBAL) {
2789     ierr = VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2790     ierr = VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2791   }
2792 
2793   if (coloring->vscaleforrow) {
2794     vscaleforrow = coloring->vscaleforrow;
2795   } else SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_NULL,"Null Object: coloring->vscaleforrow");
2796 
2797   /*
2798     Loop over each color
2799   */
2800   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2801   for (k=0; k<ncolors; k++) { /* loop over colors */
2802     coloring->currentcolor = k;
2803 
2804     ierr = VecCopy(x1_tmp,w3);CHKERRQ(ierr);
2805     ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr);
2806     if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array - start;
2807     /*
2808       Loop over each column associated with color
2809       adding the perturbation to the vector w3.
2810     */
2811     ncolumns_k = ncolumns[k];
2812     for (l=0; l<ncolumns_k; l++) { /* loop over columns */
2813       col = columns[k][l];    /* local column of the matrix we are probing for */
2814       if (coloring->htype[0] == 'w') {
2815         dx = 1.0 + unorm;
2816       } else {
2817         dx = xx[col];
2818       }
2819       if (dx == (PetscScalar)0.0) dx = 1.0;
2820       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2821       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2822       dx            *= epsilon;
2823       if (!PetscAbsScalar(dx)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed 0 differencing parameter");
2824       w3_array[col] += dx;
2825     }
2826     if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array + start;
2827     ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr);
2828 
2829     /*
2830       Evaluate function at w3 = x1 + dx (here dx is a vector of perturbations)
2831                            w2 = F(x1 + dx) - F(x1)
2832     */
2833     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2834     ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr);
2835     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2836     ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr);
2837 
2838     /*
2839       Loop over rows of vector, putting results into Jacobian matrix
2840     */
2841 #if defined(JACOBIANCOLOROPT)
2842     ierr = PetscTime(&t0);CHKERRQ(ierr);
2843 #endif
2844     ierr = VecGetArray(w2,&y);CHKERRQ(ierr);
2845     nrows_k = nrows[k];
2846     for (l=0; l<nrows_k; l++) { /* loop over rows */
2847       row     = rows[k][l]; /* local row index */
2848       y[row] *= vscale_array[vscaleforrow[k][l]];
2849       ca[idx[l]] = y[row];
2850     }
2851     idx += nrows_k;
2852     ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr);
2853 #if defined(JACOBIANCOLOROPT)
2854     ierr = PetscTime(&t1);CHKERRQ(ierr);
2855     time_setvalues += t1-t0;
2856 #endif
2857   } /* endof for each color */
2858 #if defined(JACOBIANCOLOROPT)
2859   printf("     MatFDColoringApply_SeqAIJ: time_setvalues %g\n",time_setvalues);
2860 #endif
2861   if (ctype == IS_COLORING_GLOBAL) xx = xx + start;
2862   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2863   ierr = VecRestoreArray(x1_tmp,&xx);CHKERRQ(ierr);
2864 
2865   coloring->currentcolor = -1;
2866   PetscFunctionReturn(0);
2867 }
2868 /* --------------------------------------------------------*/
2869 
2870 #undef __FUNCT__
2871 #define __FUNCT__ "MatFDColoringApply_SeqAIJ_old"
2872 PetscErrorCode MatFDColoringApply_SeqAIJ_old(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
2873 {
2874   PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void*))coloring->f;
2875   PetscErrorCode ierr;
2876   PetscInt       k,N,start,end,l,row,col,srow,**vscaleforrow;
2877   PetscScalar    dx,*y,*xx,*w3_array;
2878   PetscScalar    *vscale_array;
2879   PetscReal      epsilon = coloring->error_rel,umin = coloring->umin;
2880   Vec            w1,w2,w3;
2881   void           *fctx = coloring->fctx;
2882   PetscBool      flg   = PETSC_FALSE;
2883 
2884   PetscFunctionBegin;
2885   printf("MatFDColoringApply_SeqAIJ ...\n");
2886   if (!coloring->w1) {
2887     ierr = VecDuplicate(x1,&coloring->w1);CHKERRQ(ierr);
2888     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w1);CHKERRQ(ierr);
2889     ierr = VecDuplicate(x1,&coloring->w2);CHKERRQ(ierr);
2890     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w2);CHKERRQ(ierr);
2891     ierr = VecDuplicate(x1,&coloring->w3);CHKERRQ(ierr);
2892     ierr = PetscLogObjectParent((PetscObject)coloring,(PetscObject)coloring->w3);CHKERRQ(ierr);
2893   }
2894   w1 = coloring->w1; w2 = coloring->w2; w3 = coloring->w3;
2895 
2896   ierr = MatSetUnfactored(J);CHKERRQ(ierr);
2897   ierr = PetscOptionsGetBool(((PetscObject)coloring)->prefix,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
2898   if (flg) {
2899     ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
2900   } else {
2901     PetscBool assembled;
2902     ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
2903     if (assembled) {
2904       ierr = MatZeroEntries(J);CHKERRQ(ierr);
2905     }
2906   }
2907 
2908   ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
2909   ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
2910 
2911   if (!coloring->fset) {
2912     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2913     ierr = (*f)(sctx,x1,w1,fctx);CHKERRQ(ierr);
2914     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2915   } else {
2916     coloring->fset = PETSC_FALSE;
2917   }
2918 
2919   /*
2920       Compute all the scale factors and share with other processors
2921   */
2922   ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);xx = xx - start;
2923   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);vscale_array = vscale_array - start;
2924   for (k=0; k<coloring->ncolors; k++) {
2925     /*
2926        Loop over each column associated with color adding the
2927        perturbation to the vector w3.
2928     */
2929     for (l=0; l<coloring->ncolumns[k]; l++) {
2930       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
2931       dx  = xx[col];
2932       if (dx == 0.0) dx = 1.0;
2933       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2934       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2935       dx               *= epsilon;
2936       vscale_array[col] = 1.0/dx;
2937     }
2938   }
2939   vscale_array = vscale_array + start;
2940 
2941   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2942   ierr = VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2943   ierr = VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2944 
2945   /*  ierr = VecView(coloring->vscale,PETSC_VIEWER_STDOUT_WORLD);
2946       ierr = VecView(x1,PETSC_VIEWER_STDOUT_WORLD);*/
2947 
2948   if (coloring->vscaleforrow) vscaleforrow = coloring->vscaleforrow;
2949   else                        vscaleforrow = coloring->columnsforrow;
2950 
2951   ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
2952   /*
2953       Loop over each color
2954   */
2955   for (k=0; k<coloring->ncolors; k++) {
2956     coloring->currentcolor = k;
2957 
2958     ierr = VecCopy(x1,w3);CHKERRQ(ierr);
2959     ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr);w3_array = w3_array - start;
2960     /*
2961        Loop over each column associated with color adding the
2962        perturbation to the vector w3.
2963     */
2964     for (l=0; l<coloring->ncolumns[k]; l++) {
2965       col = coloring->columns[k][l];    /* column of the matrix we are probing for */
2966       dx  = xx[col];
2967       if (dx == 0.0) dx = 1.0;
2968       if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0)     dx = umin;
2969       else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
2970       dx *= epsilon;
2971       if (!PetscAbsScalar(dx)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed 0 differencing parameter");
2972       w3_array[col] += dx;
2973     }
2974     w3_array = w3_array + start; ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr);
2975 
2976     /*
2977        Evaluate function at x1 + dx (here dx is a vector of perturbations)
2978     */
2979 
2980     ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2981     ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr);
2982     ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
2983     ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr);
2984 
2985     /*
2986        Loop over rows of vector, putting results into Jacobian matrix
2987     */
2988     ierr = VecGetArray(w2,&y);CHKERRQ(ierr);
2989     for (l=0; l<coloring->nrows[k]; l++) {
2990       row     = coloring->rows[k][l];
2991       col     = coloring->columnsforrow[k][l];
2992       y[row] *= vscale_array[vscaleforrow[k][l]];
2993       srow    = row + start;
2994       ierr    = MatSetValues_SeqAIJ(J,1,&srow,1,&col,y+row,INSERT_VALUES);CHKERRQ(ierr);
2995     }
2996     ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr);
2997   }
2998   coloring->currentcolor = k;
2999 
3000   ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
3001   xx   = xx + start;
3002   ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
3003   ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3004   ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3005   PetscFunctionReturn(0);
3006 }
3007 
3008 /*
3009    Computes the number of nonzeros per row needed for preallocation when X and Y
3010    have different nonzero structure.
3011 */
3012 #undef __FUNCT__
3013 #define __FUNCT__ "MatAXPYGetPreallocation_SeqAIJ"
3014 PetscErrorCode MatAXPYGetPreallocation_SeqAIJ(Mat Y,Mat X,PetscInt *nnz)
3015 {
3016   PetscInt       i,m=Y->rmap->N;
3017   Mat_SeqAIJ     *x  = (Mat_SeqAIJ*)X->data;
3018   Mat_SeqAIJ     *y  = (Mat_SeqAIJ*)Y->data;
3019   const PetscInt *xi = x->i,*yi = y->i;
3020 
3021   PetscFunctionBegin;
3022   /* Set the number of nonzeros in the new matrix */
3023   for (i=0; i<m; i++) {
3024     PetscInt       j,k,nzx = xi[i+1] - xi[i],nzy = yi[i+1] - yi[i];
3025     const PetscInt *xj = x->j+xi[i],*yj = y->j+yi[i];
3026     nnz[i] = 0;
3027     for (j=0,k=0; j<nzx; j++) {                   /* Point in X */
3028       for (; k<nzy && yj[k]<xj[j]; k++) nnz[i]++; /* Catch up to X */
3029       if (k<nzy && yj[k]==xj[j]) k++;             /* Skip duplicate */
3030       nnz[i]++;
3031     }
3032     for (; k<nzy; k++) nnz[i]++;
3033   }
3034   PetscFunctionReturn(0);
3035 }
3036 
3037 #undef __FUNCT__
3038 #define __FUNCT__ "MatAXPY_SeqAIJ"
3039 PetscErrorCode MatAXPY_SeqAIJ(Mat Y,PetscScalar a,Mat X,MatStructure str)
3040 {
3041   PetscErrorCode ierr;
3042   PetscInt       i;
3043   Mat_SeqAIJ     *x = (Mat_SeqAIJ*)X->data,*y = (Mat_SeqAIJ*)Y->data;
3044   PetscBLASInt   one=1,bnz;
3045 
3046   PetscFunctionBegin;
3047   ierr = PetscBLASIntCast(x->nz,&bnz);CHKERRQ(ierr);
3048   if (str == SAME_NONZERO_PATTERN) {
3049     PetscScalar alpha = a;
3050     PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&bnz,&alpha,x->a,&one,y->a,&one));
3051     ierr = MatSeqAIJInvalidateDiagonal(Y);CHKERRQ(ierr);
3052   } else if (str == SUBSET_NONZERO_PATTERN) { /* nonzeros of X is a subset of Y's */
3053     if (y->xtoy && y->XtoY != X) {
3054       ierr = PetscFree(y->xtoy);CHKERRQ(ierr);
3055       ierr = MatDestroy(&y->XtoY);CHKERRQ(ierr);
3056     }
3057     if (!y->xtoy) { /* get xtoy */
3058       ierr    = MatAXPYGetxtoy_Private(X->rmap->n,x->i,x->j,NULL, y->i,y->j,NULL, &y->xtoy);CHKERRQ(ierr);
3059       y->XtoY = X;
3060       ierr    = PetscObjectReference((PetscObject)X);CHKERRQ(ierr);
3061     }
3062     for (i=0; i<x->nz; i++) y->a[y->xtoy[i]] += a*(x->a[i]);
3063     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);
3064   } else {
3065     Mat      B;
3066     PetscInt *nnz;
3067     ierr = PetscMalloc(Y->rmap->N*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
3068     ierr = MatCreate(PetscObjectComm((PetscObject)Y),&B);CHKERRQ(ierr);
3069     ierr = PetscObjectSetName((PetscObject)B,((PetscObject)Y)->name);CHKERRQ(ierr);
3070     ierr = MatSetSizes(B,Y->rmap->n,Y->cmap->n,Y->rmap->N,Y->cmap->N);CHKERRQ(ierr);
3071     ierr = MatSetBlockSizes(B,Y->rmap->bs,Y->cmap->bs);CHKERRQ(ierr);
3072     ierr = MatSetType(B,(MatType) ((PetscObject)Y)->type_name);CHKERRQ(ierr);
3073     ierr = MatAXPYGetPreallocation_SeqAIJ(Y,X,nnz);CHKERRQ(ierr);
3074     ierr = MatSeqAIJSetPreallocation(B,0,nnz);CHKERRQ(ierr);
3075     ierr = MatAXPY_BasicWithPreallocation(B,Y,a,X,str);CHKERRQ(ierr);
3076     ierr = MatHeaderReplace(Y,B);CHKERRQ(ierr);
3077     ierr = PetscFree(nnz);CHKERRQ(ierr);
3078   }
3079   PetscFunctionReturn(0);
3080 }
3081 
3082 #undef __FUNCT__
3083 #define __FUNCT__ "MatConjugate_SeqAIJ"
3084 PetscErrorCode  MatConjugate_SeqAIJ(Mat mat)
3085 {
3086 #if defined(PETSC_USE_COMPLEX)
3087   Mat_SeqAIJ  *aij = (Mat_SeqAIJ*)mat->data;
3088   PetscInt    i,nz;
3089   PetscScalar *a;
3090 
3091   PetscFunctionBegin;
3092   nz = aij->nz;
3093   a  = aij->a;
3094   for (i=0; i<nz; i++) a[i] = PetscConj(a[i]);
3095 #else
3096   PetscFunctionBegin;
3097 #endif
3098   PetscFunctionReturn(0);
3099 }
3100 
3101 #undef __FUNCT__
3102 #define __FUNCT__ "MatGetRowMaxAbs_SeqAIJ"
3103 PetscErrorCode MatGetRowMaxAbs_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3104 {
3105   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3106   PetscErrorCode ierr;
3107   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3108   PetscReal      atmp;
3109   PetscScalar    *x;
3110   MatScalar      *aa;
3111 
3112   PetscFunctionBegin;
3113   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3114   aa = a->a;
3115   ai = a->i;
3116   aj = a->j;
3117 
3118   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3119   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3120   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3121   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3122   for (i=0; i<m; i++) {
3123     ncols = ai[1] - ai[0]; ai++;
3124     x[i]  = 0.0;
3125     for (j=0; j<ncols; j++) {
3126       atmp = PetscAbsScalar(*aa);
3127       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = *aj;}
3128       aa++; aj++;
3129     }
3130   }
3131   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3132   PetscFunctionReturn(0);
3133 }
3134 
3135 #undef __FUNCT__
3136 #define __FUNCT__ "MatGetRowMax_SeqAIJ"
3137 PetscErrorCode MatGetRowMax_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3138 {
3139   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3140   PetscErrorCode ierr;
3141   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3142   PetscScalar    *x;
3143   MatScalar      *aa;
3144 
3145   PetscFunctionBegin;
3146   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3147   aa = a->a;
3148   ai = a->i;
3149   aj = a->j;
3150 
3151   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3152   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3153   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3154   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3155   for (i=0; i<m; i++) {
3156     ncols = ai[1] - ai[0]; ai++;
3157     if (ncols == A->cmap->n) { /* row is dense */
3158       x[i] = *aa; if (idx) idx[i] = 0;
3159     } else {  /* row is sparse so already KNOW maximum is 0.0 or higher */
3160       x[i] = 0.0;
3161       if (idx) {
3162         idx[i] = 0; /* in case ncols is zero */
3163         for (j=0;j<ncols;j++) { /* find first implicit 0.0 in the row */
3164           if (aj[j] > j) {
3165             idx[i] = j;
3166             break;
3167           }
3168         }
3169       }
3170     }
3171     for (j=0; j<ncols; j++) {
3172       if (PetscRealPart(x[i]) < PetscRealPart(*aa)) {x[i] = *aa; if (idx) idx[i] = *aj;}
3173       aa++; aj++;
3174     }
3175   }
3176   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3177   PetscFunctionReturn(0);
3178 }
3179 
3180 #undef __FUNCT__
3181 #define __FUNCT__ "MatGetRowMinAbs_SeqAIJ"
3182 PetscErrorCode MatGetRowMinAbs_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3183 {
3184   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3185   PetscErrorCode ierr;
3186   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3187   PetscReal      atmp;
3188   PetscScalar    *x;
3189   MatScalar      *aa;
3190 
3191   PetscFunctionBegin;
3192   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3193   aa = a->a;
3194   ai = a->i;
3195   aj = a->j;
3196 
3197   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3198   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3199   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3200   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);
3201   for (i=0; i<m; i++) {
3202     ncols = ai[1] - ai[0]; ai++;
3203     if (ncols) {
3204       /* Get first nonzero */
3205       for (j = 0; j < ncols; j++) {
3206         atmp = PetscAbsScalar(aa[j]);
3207         if (atmp > 1.0e-12) {
3208           x[i] = atmp;
3209           if (idx) idx[i] = aj[j];
3210           break;
3211         }
3212       }
3213       if (j == ncols) {x[i] = PetscAbsScalar(*aa); if (idx) idx[i] = *aj;}
3214     } else {
3215       x[i] = 0.0; if (idx) idx[i] = 0;
3216     }
3217     for (j = 0; j < ncols; j++) {
3218       atmp = PetscAbsScalar(*aa);
3219       if (atmp > 1.0e-12 && PetscAbsScalar(x[i]) > atmp) {x[i] = atmp; if (idx) idx[i] = *aj;}
3220       aa++; aj++;
3221     }
3222   }
3223   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3224   PetscFunctionReturn(0);
3225 }
3226 
3227 #undef __FUNCT__
3228 #define __FUNCT__ "MatGetRowMin_SeqAIJ"
3229 PetscErrorCode MatGetRowMin_SeqAIJ(Mat A,Vec v,PetscInt idx[])
3230 {
3231   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
3232   PetscErrorCode ierr;
3233   PetscInt       i,j,m = A->rmap->n,*ai,*aj,ncols,n;
3234   PetscScalar    *x;
3235   MatScalar      *aa;
3236 
3237   PetscFunctionBegin;
3238   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3239   aa = a->a;
3240   ai = a->i;
3241   aj = a->j;
3242 
3243   ierr = VecSet(v,0.0);CHKERRQ(ierr);
3244   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
3245   ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
3246   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
3247   for (i=0; i<m; i++) {
3248     ncols = ai[1] - ai[0]; ai++;
3249     if (ncols == A->cmap->n) { /* row is dense */
3250       x[i] = *aa; if (idx) idx[i] = 0;
3251     } else {  /* row is sparse so already KNOW minimum is 0.0 or lower */
3252       x[i] = 0.0;
3253       if (idx) {   /* find first implicit 0.0 in the row */
3254         idx[i] = 0; /* in case ncols is zero */
3255         for (j=0; j<ncols; j++) {
3256           if (aj[j] > j) {
3257             idx[i] = j;
3258             break;
3259           }
3260         }
3261       }
3262     }
3263     for (j=0; j<ncols; j++) {
3264       if (PetscRealPart(x[i]) > PetscRealPart(*aa)) {x[i] = *aa; if (idx) idx[i] = *aj;}
3265       aa++; aj++;
3266     }
3267   }
3268   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
3269   PetscFunctionReturn(0);
3270 }
3271 
3272 #include <petscblaslapack.h>
3273 #include <petsc-private/kernels/blockinvert.h>
3274 
3275 #undef __FUNCT__
3276 #define __FUNCT__ "MatInvertBlockDiagonal_SeqAIJ"
3277 PetscErrorCode  MatInvertBlockDiagonal_SeqAIJ(Mat A,const PetscScalar **values)
3278 {
3279   Mat_SeqAIJ     *a = (Mat_SeqAIJ*) A->data;
3280   PetscErrorCode ierr;
3281   PetscInt       i,bs = A->rmap->bs,mbs = A->rmap->n/A->rmap->bs,ipvt[5],bs2 = bs*bs,*v_pivots,ij[7],*IJ,j;
3282   MatScalar      *diag,work[25],*v_work;
3283   PetscReal      shift = 0.0;
3284 
3285   PetscFunctionBegin;
3286   if (a->ibdiagvalid) {
3287     if (values) *values = a->ibdiag;
3288     PetscFunctionReturn(0);
3289   }
3290   ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
3291   if (!a->ibdiag) {
3292     ierr = PetscMalloc(bs2*mbs*sizeof(PetscScalar),&a->ibdiag);CHKERRQ(ierr);
3293     ierr = PetscLogObjectMemory((PetscObject)A,bs2*mbs*sizeof(PetscScalar));CHKERRQ(ierr);
3294   }
3295   diag = a->ibdiag;
3296   if (values) *values = a->ibdiag;
3297   /* factor and invert each block */
3298   switch (bs) {
3299   case 1:
3300     for (i=0; i<mbs; i++) {
3301       ierr    = MatGetValues(A,1,&i,1,&i,diag+i);CHKERRQ(ierr);
3302       diag[i] = (PetscScalar)1.0 / (diag[i] + shift);
3303     }
3304     break;
3305   case 2:
3306     for (i=0; i<mbs; i++) {
3307       ij[0] = 2*i; ij[1] = 2*i + 1;
3308       ierr  = MatGetValues(A,2,ij,2,ij,diag);CHKERRQ(ierr);
3309       ierr  = PetscKernel_A_gets_inverse_A_2(diag,shift);CHKERRQ(ierr);
3310       ierr  = PetscKernel_A_gets_transpose_A_2(diag);CHKERRQ(ierr);
3311       diag += 4;
3312     }
3313     break;
3314   case 3:
3315     for (i=0; i<mbs; i++) {
3316       ij[0] = 3*i; ij[1] = 3*i + 1; ij[2] = 3*i + 2;
3317       ierr  = MatGetValues(A,3,ij,3,ij,diag);CHKERRQ(ierr);
3318       ierr  = PetscKernel_A_gets_inverse_A_3(diag,shift);CHKERRQ(ierr);
3319       ierr  = PetscKernel_A_gets_transpose_A_3(diag);CHKERRQ(ierr);
3320       diag += 9;
3321     }
3322     break;
3323   case 4:
3324     for (i=0; i<mbs; i++) {
3325       ij[0] = 4*i; ij[1] = 4*i + 1; ij[2] = 4*i + 2; ij[3] = 4*i + 3;
3326       ierr  = MatGetValues(A,4,ij,4,ij,diag);CHKERRQ(ierr);
3327       ierr  = PetscKernel_A_gets_inverse_A_4(diag,shift);CHKERRQ(ierr);
3328       ierr  = PetscKernel_A_gets_transpose_A_4(diag);CHKERRQ(ierr);
3329       diag += 16;
3330     }
3331     break;
3332   case 5:
3333     for (i=0; i<mbs; i++) {
3334       ij[0] = 5*i; ij[1] = 5*i + 1; ij[2] = 5*i + 2; ij[3] = 5*i + 3; ij[4] = 5*i + 4;
3335       ierr  = MatGetValues(A,5,ij,5,ij,diag);CHKERRQ(ierr);
3336       ierr  = PetscKernel_A_gets_inverse_A_5(diag,ipvt,work,shift);CHKERRQ(ierr);
3337       ierr  = PetscKernel_A_gets_transpose_A_5(diag);CHKERRQ(ierr);
3338       diag += 25;
3339     }
3340     break;
3341   case 6:
3342     for (i=0; i<mbs; i++) {
3343       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;
3344       ierr  = MatGetValues(A,6,ij,6,ij,diag);CHKERRQ(ierr);
3345       ierr  = PetscKernel_A_gets_inverse_A_6(diag,shift);CHKERRQ(ierr);
3346       ierr  = PetscKernel_A_gets_transpose_A_6(diag);CHKERRQ(ierr);
3347       diag += 36;
3348     }
3349     break;
3350   case 7:
3351     for (i=0; i<mbs; i++) {
3352       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;
3353       ierr  = MatGetValues(A,7,ij,7,ij,diag);CHKERRQ(ierr);
3354       ierr  = PetscKernel_A_gets_inverse_A_7(diag,shift);CHKERRQ(ierr);
3355       ierr  = PetscKernel_A_gets_transpose_A_7(diag);CHKERRQ(ierr);
3356       diag += 49;
3357     }
3358     break;
3359   default:
3360     ierr = PetscMalloc3(bs,MatScalar,&v_work,bs,PetscInt,&v_pivots,bs,PetscInt,&IJ);CHKERRQ(ierr);
3361     for (i=0; i<mbs; i++) {
3362       for (j=0; j<bs; j++) {
3363         IJ[j] = bs*i + j;
3364       }
3365       ierr  = MatGetValues(A,bs,IJ,bs,IJ,diag);CHKERRQ(ierr);
3366       ierr  = PetscKernel_A_gets_inverse_A(bs,diag,v_pivots,v_work);CHKERRQ(ierr);
3367       ierr  = PetscKernel_A_gets_transpose_A_N(diag,bs);CHKERRQ(ierr);
3368       diag += bs2;
3369     }
3370     ierr = PetscFree3(v_work,v_pivots,IJ);CHKERRQ(ierr);
3371   }
3372   a->ibdiagvalid = PETSC_TRUE;
3373   PetscFunctionReturn(0);
3374 }
3375 
3376 #undef __FUNCT__
3377 #define __FUNCT__ "MatSetRandom_SeqAIJ"
3378 static PetscErrorCode  MatSetRandom_SeqAIJ(Mat x,PetscRandom rctx)
3379 {
3380   PetscErrorCode ierr;
3381   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)x->data;
3382   PetscScalar    a;
3383   PetscInt       m,n,i,j,col;
3384 
3385   PetscFunctionBegin;
3386   if (!x->assembled) {
3387     ierr = MatGetSize(x,&m,&n);CHKERRQ(ierr);
3388     for (i=0; i<m; i++) {
3389       for (j=0; j<aij->imax[i]; j++) {
3390         ierr = PetscRandomGetValue(rctx,&a);CHKERRQ(ierr);
3391         col  = (PetscInt)(n*PetscRealPart(a));
3392         ierr = MatSetValues(x,1,&i,1,&col,&a,ADD_VALUES);CHKERRQ(ierr);
3393       }
3394     }
3395   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet coded");
3396   ierr = MatAssemblyBegin(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3397   ierr = MatAssemblyEnd(x,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3398   PetscFunctionReturn(0);
3399 }
3400 
3401 extern PetscErrorCode  MatFDColoringApply_AIJ(Mat,MatFDColoring,Vec,MatStructure*,void*);
3402 /* -------------------------------------------------------------------*/
3403 static struct _MatOps MatOps_Values = { MatSetValues_SeqAIJ,
3404                                         MatGetRow_SeqAIJ,
3405                                         MatRestoreRow_SeqAIJ,
3406                                         MatMult_SeqAIJ,
3407                                 /*  4*/ MatMultAdd_SeqAIJ,
3408                                         MatMultTranspose_SeqAIJ,
3409                                         MatMultTransposeAdd_SeqAIJ,
3410                                         0,
3411                                         0,
3412                                         0,
3413                                 /* 10*/ 0,
3414                                         MatLUFactor_SeqAIJ,
3415                                         0,
3416                                         MatSOR_SeqAIJ,
3417                                         MatTranspose_SeqAIJ,
3418                                 /*1 5*/ MatGetInfo_SeqAIJ,
3419                                         MatEqual_SeqAIJ,
3420                                         MatGetDiagonal_SeqAIJ,
3421                                         MatDiagonalScale_SeqAIJ,
3422                                         MatNorm_SeqAIJ,
3423                                 /* 20*/ 0,
3424                                         MatAssemblyEnd_SeqAIJ,
3425                                         MatSetOption_SeqAIJ,
3426                                         MatZeroEntries_SeqAIJ,
3427                                 /* 24*/ MatZeroRows_SeqAIJ,
3428                                         0,
3429                                         0,
3430                                         0,
3431                                         0,
3432                                 /* 29*/ MatSetUp_SeqAIJ,
3433                                         0,
3434                                         0,
3435                                         0,
3436                                         0,
3437                                 /* 34*/ MatDuplicate_SeqAIJ,
3438                                         0,
3439                                         0,
3440                                         MatILUFactor_SeqAIJ,
3441                                         0,
3442                                 /* 39*/ MatAXPY_SeqAIJ,
3443                                         MatGetSubMatrices_SeqAIJ,
3444                                         MatIncreaseOverlap_SeqAIJ,
3445                                         MatGetValues_SeqAIJ,
3446                                         MatCopy_SeqAIJ,
3447                                 /* 44*/ MatGetRowMax_SeqAIJ,
3448                                         MatScale_SeqAIJ,
3449                                         0,
3450                                         MatDiagonalSet_SeqAIJ,
3451                                         MatZeroRowsColumns_SeqAIJ,
3452                                 /* 49*/ MatSetRandom_SeqAIJ,
3453                                         MatGetRowIJ_SeqAIJ,
3454                                         MatRestoreRowIJ_SeqAIJ,
3455                                         MatGetColumnIJ_SeqAIJ,
3456                                         MatRestoreColumnIJ_SeqAIJ,
3457                                 /* 54*/ MatFDColoringCreate_SeqAIJ,
3458                                         0,
3459                                         0,
3460                                         MatPermute_SeqAIJ,
3461                                         0,
3462                                 /* 59*/ 0,
3463                                         MatDestroy_SeqAIJ,
3464                                         MatView_SeqAIJ,
3465                                         0,
3466                                         MatMatMatMult_SeqAIJ_SeqAIJ_SeqAIJ,
3467                                 /* 64*/ MatMatMatMultSymbolic_SeqAIJ_SeqAIJ_SeqAIJ,
3468                                         MatMatMatMultNumeric_SeqAIJ_SeqAIJ_SeqAIJ,
3469                                         0,
3470                                         0,
3471                                         0,
3472                                 /* 69*/ MatGetRowMaxAbs_SeqAIJ,
3473                                         MatGetRowMinAbs_SeqAIJ,
3474                                         0,
3475                                         MatSetColoring_SeqAIJ,
3476                                         0,
3477                                 /* 74*/ MatSetValuesAdifor_SeqAIJ,
3478                                         MatFDColoringApply_AIJ,
3479                                         0,
3480                                         0,
3481                                         0,
3482                                 /* 79*/ MatFindZeroDiagonals_SeqAIJ,
3483                                         0,
3484                                         0,
3485                                         0,
3486                                         MatLoad_SeqAIJ,
3487                                 /* 84*/ MatIsSymmetric_SeqAIJ,
3488                                         MatIsHermitian_SeqAIJ,
3489                                         0,
3490                                         0,
3491                                         0,
3492                                 /* 89*/ MatMatMult_SeqAIJ_SeqAIJ,
3493                                         MatMatMultSymbolic_SeqAIJ_SeqAIJ,
3494                                         MatMatMultNumeric_SeqAIJ_SeqAIJ,
3495                                         MatPtAP_SeqAIJ_SeqAIJ,
3496                                         MatPtAPSymbolic_SeqAIJ_SeqAIJ_DenseAxpy,
3497                                 /* 94*/ MatPtAPNumeric_SeqAIJ_SeqAIJ,
3498                                         MatMatTransposeMult_SeqAIJ_SeqAIJ,
3499                                         MatMatTransposeMultSymbolic_SeqAIJ_SeqAIJ,
3500                                         MatMatTransposeMultNumeric_SeqAIJ_SeqAIJ,
3501                                         0,
3502                                 /* 99*/ 0,
3503                                         0,
3504                                         0,
3505                                         MatConjugate_SeqAIJ,
3506                                         0,
3507                                 /*104*/ MatSetValuesRow_SeqAIJ,
3508                                         MatRealPart_SeqAIJ,
3509                                         MatImaginaryPart_SeqAIJ,
3510                                         0,
3511                                         0,
3512                                 /*109*/ MatMatSolve_SeqAIJ,
3513                                         0,
3514                                         MatGetRowMin_SeqAIJ,
3515                                         0,
3516                                         MatMissingDiagonal_SeqAIJ,
3517                                 /*114*/ 0,
3518                                         0,
3519                                         0,
3520                                         0,
3521                                         0,
3522                                 /*119*/ 0,
3523                                         0,
3524                                         0,
3525                                         0,
3526                                         MatGetMultiProcBlock_SeqAIJ,
3527                                 /*124*/ MatFindNonzeroRows_SeqAIJ,
3528                                         MatGetColumnNorms_SeqAIJ,
3529                                         MatInvertBlockDiagonal_SeqAIJ,
3530                                         0,
3531                                         0,
3532                                 /*129*/ 0,
3533                                         MatTransposeMatMult_SeqAIJ_SeqAIJ,
3534                                         MatTransposeMatMultSymbolic_SeqAIJ_SeqAIJ,
3535                                         MatTransposeMatMultNumeric_SeqAIJ_SeqAIJ,
3536                                         MatTransposeColoringCreate_SeqAIJ,
3537                                 /*134*/ MatTransColoringApplySpToDen_SeqAIJ,
3538                                         MatTransColoringApplyDenToSp_SeqAIJ,
3539                                         MatRARt_SeqAIJ_SeqAIJ,
3540                                         MatRARtSymbolic_SeqAIJ_SeqAIJ,
3541                                         MatRARtNumeric_SeqAIJ_SeqAIJ,
3542                                  /*139*/0,
3543                                         0
3544 };
3545 
3546 #undef __FUNCT__
3547 #define __FUNCT__ "MatSeqAIJSetColumnIndices_SeqAIJ"
3548 PetscErrorCode  MatSeqAIJSetColumnIndices_SeqAIJ(Mat mat,PetscInt *indices)
3549 {
3550   Mat_SeqAIJ *aij = (Mat_SeqAIJ*)mat->data;
3551   PetscInt   i,nz,n;
3552 
3553   PetscFunctionBegin;
3554   nz = aij->maxnz;
3555   n  = mat->rmap->n;
3556   for (i=0; i<nz; i++) {
3557     aij->j[i] = indices[i];
3558   }
3559   aij->nz = nz;
3560   for (i=0; i<n; i++) {
3561     aij->ilen[i] = aij->imax[i];
3562   }
3563   PetscFunctionReturn(0);
3564 }
3565 
3566 #undef __FUNCT__
3567 #define __FUNCT__ "MatSeqAIJSetColumnIndices"
3568 /*@
3569     MatSeqAIJSetColumnIndices - Set the column indices for all the rows
3570        in the matrix.
3571 
3572   Input Parameters:
3573 +  mat - the SeqAIJ matrix
3574 -  indices - the column indices
3575 
3576   Level: advanced
3577 
3578   Notes:
3579     This can be called if you have precomputed the nonzero structure of the
3580   matrix and want to provide it to the matrix object to improve the performance
3581   of the MatSetValues() operation.
3582 
3583     You MUST have set the correct numbers of nonzeros per row in the call to
3584   MatCreateSeqAIJ(), and the columns indices MUST be sorted.
3585 
3586     MUST be called before any calls to MatSetValues();
3587 
3588     The indices should start with zero, not one.
3589 
3590 @*/
3591 PetscErrorCode  MatSeqAIJSetColumnIndices(Mat mat,PetscInt *indices)
3592 {
3593   PetscErrorCode ierr;
3594 
3595   PetscFunctionBegin;
3596   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3597   PetscValidPointer(indices,2);
3598   ierr = PetscUseMethod(mat,"MatSeqAIJSetColumnIndices_C",(Mat,PetscInt*),(mat,indices));CHKERRQ(ierr);
3599   PetscFunctionReturn(0);
3600 }
3601 
3602 /* ----------------------------------------------------------------------------------------*/
3603 
3604 #undef __FUNCT__
3605 #define __FUNCT__ "MatStoreValues_SeqAIJ"
3606 PetscErrorCode  MatStoreValues_SeqAIJ(Mat mat)
3607 {
3608   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)mat->data;
3609   PetscErrorCode ierr;
3610   size_t         nz = aij->i[mat->rmap->n];
3611 
3612   PetscFunctionBegin;
3613   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3614 
3615   /* allocate space for values if not already there */
3616   if (!aij->saved_values) {
3617     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&aij->saved_values);CHKERRQ(ierr);
3618     ierr = PetscLogObjectMemory((PetscObject)mat,(nz+1)*sizeof(PetscScalar));CHKERRQ(ierr);
3619   }
3620 
3621   /* copy values over */
3622   ierr = PetscMemcpy(aij->saved_values,aij->a,nz*sizeof(PetscScalar));CHKERRQ(ierr);
3623   PetscFunctionReturn(0);
3624 }
3625 
3626 #undef __FUNCT__
3627 #define __FUNCT__ "MatStoreValues"
3628 /*@
3629     MatStoreValues - Stashes a copy of the matrix values; this allows, for
3630        example, reuse of the linear part of a Jacobian, while recomputing the
3631        nonlinear portion.
3632 
3633    Collect on Mat
3634 
3635   Input Parameters:
3636 .  mat - the matrix (currently only AIJ matrices support this option)
3637 
3638   Level: advanced
3639 
3640   Common Usage, with SNESSolve():
3641 $    Create Jacobian matrix
3642 $    Set linear terms into matrix
3643 $    Apply boundary conditions to matrix, at this time matrix must have
3644 $      final nonzero structure (i.e. setting the nonlinear terms and applying
3645 $      boundary conditions again will not change the nonzero structure
3646 $    ierr = MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
3647 $    ierr = MatStoreValues(mat);
3648 $    Call SNESSetJacobian() with matrix
3649 $    In your Jacobian routine
3650 $      ierr = MatRetrieveValues(mat);
3651 $      Set nonlinear terms in matrix
3652 
3653   Common Usage without SNESSolve(), i.e. when you handle nonlinear solve yourself:
3654 $    // build linear portion of Jacobian
3655 $    ierr = MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
3656 $    ierr = MatStoreValues(mat);
3657 $    loop over nonlinear iterations
3658 $       ierr = MatRetrieveValues(mat);
3659 $       // call MatSetValues(mat,...) to set nonliner portion of Jacobian
3660 $       // call MatAssemblyBegin/End() on matrix
3661 $       Solve linear system with Jacobian
3662 $    endloop
3663 
3664   Notes:
3665     Matrix must already be assemblied before calling this routine
3666     Must set the matrix option MatSetOption(mat,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE); before
3667     calling this routine.
3668 
3669     When this is called multiple times it overwrites the previous set of stored values
3670     and does not allocated additional space.
3671 
3672 .seealso: MatRetrieveValues()
3673 
3674 @*/
3675 PetscErrorCode  MatStoreValues(Mat mat)
3676 {
3677   PetscErrorCode ierr;
3678 
3679   PetscFunctionBegin;
3680   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3681   if (!mat->assembled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
3682   if (mat->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3683   ierr = PetscUseMethod(mat,"MatStoreValues_C",(Mat),(mat));CHKERRQ(ierr);
3684   PetscFunctionReturn(0);
3685 }
3686 
3687 #undef __FUNCT__
3688 #define __FUNCT__ "MatRetrieveValues_SeqAIJ"
3689 PetscErrorCode  MatRetrieveValues_SeqAIJ(Mat mat)
3690 {
3691   Mat_SeqAIJ     *aij = (Mat_SeqAIJ*)mat->data;
3692   PetscErrorCode ierr;
3693   PetscInt       nz = aij->i[mat->rmap->n];
3694 
3695   PetscFunctionBegin;
3696   if (aij->nonew != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);first");
3697   if (!aij->saved_values) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Must call MatStoreValues(A);first");
3698   /* copy values over */
3699   ierr = PetscMemcpy(aij->a,aij->saved_values,nz*sizeof(PetscScalar));CHKERRQ(ierr);
3700   PetscFunctionReturn(0);
3701 }
3702 
3703 #undef __FUNCT__
3704 #define __FUNCT__ "MatRetrieveValues"
3705 /*@
3706     MatRetrieveValues - Retrieves the copy of the matrix values; this allows, for
3707        example, reuse of the linear part of a Jacobian, while recomputing the
3708        nonlinear portion.
3709 
3710    Collect on Mat
3711 
3712   Input Parameters:
3713 .  mat - the matrix (currently on AIJ matrices support this option)
3714 
3715   Level: advanced
3716 
3717 .seealso: MatStoreValues()
3718 
3719 @*/
3720 PetscErrorCode  MatRetrieveValues(Mat mat)
3721 {
3722   PetscErrorCode ierr;
3723 
3724   PetscFunctionBegin;
3725   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
3726   if (!mat->assembled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");
3727   if (mat->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
3728   ierr = PetscUseMethod(mat,"MatRetrieveValues_C",(Mat),(mat));CHKERRQ(ierr);
3729   PetscFunctionReturn(0);
3730 }
3731 
3732 
3733 /* --------------------------------------------------------------------------------*/
3734 #undef __FUNCT__
3735 #define __FUNCT__ "MatCreateSeqAIJ"
3736 /*@C
3737    MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format
3738    (the default parallel PETSc format).  For good matrix assembly performance
3739    the user should preallocate the matrix storage by setting the parameter nz
3740    (or the array nnz).  By setting these parameters accurately, performance
3741    during matrix assembly can be increased by more than a factor of 50.
3742 
3743    Collective on MPI_Comm
3744 
3745    Input Parameters:
3746 +  comm - MPI communicator, set to PETSC_COMM_SELF
3747 .  m - number of rows
3748 .  n - number of columns
3749 .  nz - number of nonzeros per row (same for all rows)
3750 -  nnz - array containing the number of nonzeros in the various rows
3751          (possibly different for each row) or NULL
3752 
3753    Output Parameter:
3754 .  A - the matrix
3755 
3756    It is recommended that one use the MatCreate(), MatSetType() and/or MatSetFromOptions(),
3757    MatXXXXSetPreallocation() paradgm instead of this routine directly.
3758    [MatXXXXSetPreallocation() is, for example, MatSeqAIJSetPreallocation]
3759 
3760    Notes:
3761    If nnz is given then nz is ignored
3762 
3763    The AIJ format (also called the Yale sparse matrix format or
3764    compressed row storage), is fully compatible with standard Fortran 77
3765    storage.  That is, the stored row and column indices can begin at
3766    either one (as in Fortran) or zero.  See the users' manual for details.
3767 
3768    Specify the preallocated storage with either nz or nnz (not both).
3769    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
3770    allocation.  For large problems you MUST preallocate memory or you
3771    will get TERRIBLE performance, see the users' manual chapter on matrices.
3772 
3773    By default, this format uses inodes (identical nodes) when possible, to
3774    improve numerical efficiency of matrix-vector products and solves. We
3775    search for consecutive rows with the same nonzero structure, thereby
3776    reusing matrix information to achieve increased efficiency.
3777 
3778    Options Database Keys:
3779 +  -mat_no_inode  - Do not use inodes
3780 -  -mat_inode_limit <limit> - Sets inode limit (max limit=5)
3781 
3782    Level: intermediate
3783 
3784 .seealso: MatCreate(), MatCreateAIJ(), MatSetValues(), MatSeqAIJSetColumnIndices(), MatCreateSeqAIJWithArrays()
3785 
3786 @*/
3787 PetscErrorCode  MatCreateSeqAIJ(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt nz,const PetscInt nnz[],Mat *A)
3788 {
3789   PetscErrorCode ierr;
3790 
3791   PetscFunctionBegin;
3792   ierr = MatCreate(comm,A);CHKERRQ(ierr);
3793   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
3794   ierr = MatSetType(*A,MATSEQAIJ);CHKERRQ(ierr);
3795   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*A,nz,nnz);CHKERRQ(ierr);
3796   PetscFunctionReturn(0);
3797 }
3798 
3799 #undef __FUNCT__
3800 #define __FUNCT__ "MatSeqAIJSetPreallocation"
3801 /*@C
3802    MatSeqAIJSetPreallocation - For good matrix assembly performance
3803    the user should preallocate the matrix storage by setting the parameter nz
3804    (or the array nnz).  By setting these parameters accurately, performance
3805    during matrix assembly can be increased by more than a factor of 50.
3806 
3807    Collective on MPI_Comm
3808 
3809    Input Parameters:
3810 +  B - The matrix-free
3811 .  nz - number of nonzeros per row (same for all rows)
3812 -  nnz - array containing the number of nonzeros in the various rows
3813          (possibly different for each row) or NULL
3814 
3815    Notes:
3816      If nnz is given then nz is ignored
3817 
3818     The AIJ format (also called the Yale sparse matrix format or
3819    compressed row storage), is fully compatible with standard Fortran 77
3820    storage.  That is, the stored row and column indices can begin at
3821    either one (as in Fortran) or zero.  See the users' manual for details.
3822 
3823    Specify the preallocated storage with either nz or nnz (not both).
3824    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
3825    allocation.  For large problems you MUST preallocate memory or you
3826    will get TERRIBLE performance, see the users' manual chapter on matrices.
3827 
3828    You can call MatGetInfo() to get information on how effective the preallocation was;
3829    for example the fields mallocs,nz_allocated,nz_used,nz_unneeded;
3830    You can also run with the option -info and look for messages with the string
3831    malloc in them to see if additional memory allocation was needed.
3832 
3833    Developers: Use nz of MAT_SKIP_ALLOCATION to not allocate any space for the matrix
3834    entries or columns indices
3835 
3836    By default, this format uses inodes (identical nodes) when possible, to
3837    improve numerical efficiency of matrix-vector products and solves. We
3838    search for consecutive rows with the same nonzero structure, thereby
3839    reusing matrix information to achieve increased efficiency.
3840 
3841    Options Database Keys:
3842 +  -mat_no_inode  - Do not use inodes
3843 .  -mat_inode_limit <limit> - Sets inode limit (max limit=5)
3844 -  -mat_aij_oneindex - Internally use indexing starting at 1
3845         rather than 0.  Note that when calling MatSetValues(),
3846         the user still MUST index entries starting at 0!
3847 
3848    Level: intermediate
3849 
3850 .seealso: MatCreate(), MatCreateAIJ(), MatSetValues(), MatSeqAIJSetColumnIndices(), MatCreateSeqAIJWithArrays(), MatGetInfo()
3851 
3852 @*/
3853 PetscErrorCode  MatSeqAIJSetPreallocation(Mat B,PetscInt nz,const PetscInt nnz[])
3854 {
3855   PetscErrorCode ierr;
3856 
3857   PetscFunctionBegin;
3858   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
3859   PetscValidType(B,1);
3860   ierr = PetscTryMethod(B,"MatSeqAIJSetPreallocation_C",(Mat,PetscInt,const PetscInt[]),(B,nz,nnz));CHKERRQ(ierr);
3861   PetscFunctionReturn(0);
3862 }
3863 
3864 #undef __FUNCT__
3865 #define __FUNCT__ "MatSeqAIJSetPreallocation_SeqAIJ"
3866 PetscErrorCode  MatSeqAIJSetPreallocation_SeqAIJ(Mat B,PetscInt nz,const PetscInt *nnz)
3867 {
3868   Mat_SeqAIJ     *b;
3869   PetscBool      skipallocation = PETSC_FALSE,realalloc = PETSC_FALSE;
3870   PetscErrorCode ierr;
3871   PetscInt       i;
3872 
3873   PetscFunctionBegin;
3874   if (nz >= 0 || nnz) realalloc = PETSC_TRUE;
3875   if (nz == MAT_SKIP_ALLOCATION) {
3876     skipallocation = PETSC_TRUE;
3877     nz             = 0;
3878   }
3879 
3880   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
3881   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
3882 
3883   if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
3884   if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %d",nz);
3885   if (nnz) {
3886     for (i=0; i<B->rmap->n; i++) {
3887       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]);
3888       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);
3889     }
3890   }
3891 
3892   B->preallocated = PETSC_TRUE;
3893 
3894   b = (Mat_SeqAIJ*)B->data;
3895 
3896   if (!skipallocation) {
3897     if (!b->imax) {
3898       ierr = PetscMalloc2(B->rmap->n,PetscInt,&b->imax,B->rmap->n,PetscInt,&b->ilen);CHKERRQ(ierr);
3899       ierr = PetscLogObjectMemory((PetscObject)B,2*B->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
3900     }
3901     if (!nnz) {
3902       if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 10;
3903       else if (nz < 0) nz = 1;
3904       for (i=0; i<B->rmap->n; i++) b->imax[i] = nz;
3905       nz = nz*B->rmap->n;
3906     } else {
3907       nz = 0;
3908       for (i=0; i<B->rmap->n; i++) {b->imax[i] = nnz[i]; nz += nnz[i];}
3909     }
3910     /* b->ilen will count nonzeros in each row so far. */
3911     for (i=0; i<B->rmap->n; i++) b->ilen[i] = 0;
3912 
3913     /* allocate the matrix space */
3914     ierr    = MatSeqXAIJFreeAIJ(B,&b->a,&b->j,&b->i);CHKERRQ(ierr);
3915     ierr    = PetscMalloc3(nz,PetscScalar,&b->a,nz,PetscInt,&b->j,B->rmap->n+1,PetscInt,&b->i);CHKERRQ(ierr);
3916     ierr    = PetscLogObjectMemory((PetscObject)B,(B->rmap->n+1)*sizeof(PetscInt)+nz*(sizeof(PetscScalar)+sizeof(PetscInt)));CHKERRQ(ierr);
3917     b->i[0] = 0;
3918     for (i=1; i<B->rmap->n+1; i++) {
3919       b->i[i] = b->i[i-1] + b->imax[i-1];
3920     }
3921     b->singlemalloc = PETSC_TRUE;
3922     b->free_a       = PETSC_TRUE;
3923     b->free_ij      = PETSC_TRUE;
3924 #if defined(PETSC_THREADCOMM_ACTIVE)
3925     ierr = MatZeroEntries_SeqAIJ(B);CHKERRQ(ierr);
3926 #endif
3927   } else {
3928     b->free_a  = PETSC_FALSE;
3929     b->free_ij = PETSC_FALSE;
3930   }
3931 
3932   b->nz               = 0;
3933   b->maxnz            = nz;
3934   B->info.nz_unneeded = (double)b->maxnz;
3935   if (realalloc) {
3936     ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3937   }
3938   PetscFunctionReturn(0);
3939 }
3940 
3941 #undef  __FUNCT__
3942 #define __FUNCT__  "MatSeqAIJSetPreallocationCSR"
3943 /*@
3944    MatSeqAIJSetPreallocationCSR - Allocates memory for a sparse sequential matrix in AIJ format.
3945 
3946    Input Parameters:
3947 +  B - the matrix
3948 .  i - the indices into j for the start of each row (starts with zero)
3949 .  j - the column indices for each row (starts with zero) these must be sorted for each row
3950 -  v - optional values in the matrix
3951 
3952    Level: developer
3953 
3954    The i,j,v values are COPIED with this routine; to avoid the copy use MatCreateSeqAIJWithArrays()
3955 
3956 .keywords: matrix, aij, compressed row, sparse, sequential
3957 
3958 .seealso: MatCreate(), MatCreateSeqAIJ(), MatSetValues(), MatSeqAIJSetPreallocation(), MatCreateSeqAIJ(), SeqAIJ
3959 @*/
3960 PetscErrorCode MatSeqAIJSetPreallocationCSR(Mat B,const PetscInt i[],const PetscInt j[],const PetscScalar v[])
3961 {
3962   PetscErrorCode ierr;
3963 
3964   PetscFunctionBegin;
3965   PetscValidHeaderSpecific(B,MAT_CLASSID,1);
3966   PetscValidType(B,1);
3967   ierr = PetscTryMethod(B,"MatSeqAIJSetPreallocationCSR_C",(Mat,const PetscInt[],const PetscInt[],const PetscScalar[]),(B,i,j,v));CHKERRQ(ierr);
3968   PetscFunctionReturn(0);
3969 }
3970 
3971 #undef  __FUNCT__
3972 #define __FUNCT__  "MatSeqAIJSetPreallocationCSR_SeqAIJ"
3973 PetscErrorCode  MatSeqAIJSetPreallocationCSR_SeqAIJ(Mat B,const PetscInt Ii[],const PetscInt J[],const PetscScalar v[])
3974 {
3975   PetscInt       i;
3976   PetscInt       m,n;
3977   PetscInt       nz;
3978   PetscInt       *nnz, nz_max = 0;
3979   PetscScalar    *values;
3980   PetscErrorCode ierr;
3981 
3982   PetscFunctionBegin;
3983   if (Ii[0]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Ii[0] must be 0 it is %D", Ii[0]);
3984 
3985   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
3986   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
3987 
3988   ierr = MatGetSize(B, &m, &n);CHKERRQ(ierr);
3989   ierr = PetscMalloc((m+1) * sizeof(PetscInt), &nnz);CHKERRQ(ierr);
3990   for (i = 0; i < m; i++) {
3991     nz     = Ii[i+1]- Ii[i];
3992     nz_max = PetscMax(nz_max, nz);
3993     if (nz < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Local row %D has a negative number of columns %D", i, nnz);
3994     nnz[i] = nz;
3995   }
3996   ierr = MatSeqAIJSetPreallocation(B, 0, nnz);CHKERRQ(ierr);
3997   ierr = PetscFree(nnz);CHKERRQ(ierr);
3998 
3999   if (v) {
4000     values = (PetscScalar*) v;
4001   } else {
4002     ierr = PetscMalloc(nz_max*sizeof(PetscScalar), &values);CHKERRQ(ierr);
4003     ierr = PetscMemzero(values, nz_max*sizeof(PetscScalar));CHKERRQ(ierr);
4004   }
4005 
4006   for (i = 0; i < m; i++) {
4007     nz   = Ii[i+1] - Ii[i];
4008     ierr = MatSetValues_SeqAIJ(B, 1, &i, nz, J+Ii[i], values + (v ? Ii[i] : 0), INSERT_VALUES);CHKERRQ(ierr);
4009   }
4010 
4011   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4012   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4013 
4014   if (!v) {
4015     ierr = PetscFree(values);CHKERRQ(ierr);
4016   }
4017   ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
4018   PetscFunctionReturn(0);
4019 }
4020 
4021 #include <../src/mat/impls/dense/seq/dense.h>
4022 #include <petsc-private/kernels/petscaxpy.h>
4023 
4024 #undef __FUNCT__
4025 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqAIJ"
4026 /*
4027     Computes (B'*A')' since computing B*A directly is untenable
4028 
4029                n                       p                          p
4030         (              )       (              )         (                  )
4031       m (      A       )  *  n (       B      )   =   m (         C        )
4032         (              )       (              )         (                  )
4033 
4034 */
4035 PetscErrorCode MatMatMultNumeric_SeqDense_SeqAIJ(Mat A,Mat B,Mat C)
4036 {
4037   PetscErrorCode    ierr;
4038   Mat_SeqDense      *sub_a = (Mat_SeqDense*)A->data;
4039   Mat_SeqAIJ        *sub_b = (Mat_SeqAIJ*)B->data;
4040   Mat_SeqDense      *sub_c = (Mat_SeqDense*)C->data;
4041   PetscInt          i,n,m,q,p;
4042   const PetscInt    *ii,*idx;
4043   const PetscScalar *b,*a,*a_q;
4044   PetscScalar       *c,*c_q;
4045 
4046   PetscFunctionBegin;
4047   m    = A->rmap->n;
4048   n    = A->cmap->n;
4049   p    = B->cmap->n;
4050   a    = sub_a->v;
4051   b    = sub_b->a;
4052   c    = sub_c->v;
4053   ierr = PetscMemzero(c,m*p*sizeof(PetscScalar));CHKERRQ(ierr);
4054 
4055   ii  = sub_b->i;
4056   idx = sub_b->j;
4057   for (i=0; i<n; i++) {
4058     q = ii[i+1] - ii[i];
4059     while (q-->0) {
4060       c_q = c + m*(*idx);
4061       a_q = a + m*i;
4062       PetscKernelAXPY(c_q,*b,a_q,m);
4063       idx++;
4064       b++;
4065     }
4066   }
4067   PetscFunctionReturn(0);
4068 }
4069 
4070 #undef __FUNCT__
4071 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqAIJ"
4072 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqAIJ(Mat A,Mat B,PetscReal fill,Mat *C)
4073 {
4074   PetscErrorCode ierr;
4075   PetscInt       m=A->rmap->n,n=B->cmap->n;
4076   Mat            Cmat;
4077 
4078   PetscFunctionBegin;
4079   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);
4080   ierr = MatCreate(PetscObjectComm((PetscObject)A),&Cmat);CHKERRQ(ierr);
4081   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
4082   ierr = MatSetBlockSizes(Cmat,A->rmap->bs,B->cmap->bs);CHKERRQ(ierr);
4083   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
4084   ierr = MatSeqDenseSetPreallocation(Cmat,NULL);CHKERRQ(ierr);
4085 
4086   Cmat->ops->matmultnumeric = MatMatMultNumeric_SeqDense_SeqAIJ;
4087 
4088   *C = Cmat;
4089   PetscFunctionReturn(0);
4090 }
4091 
4092 /* ----------------------------------------------------------------*/
4093 #undef __FUNCT__
4094 #define __FUNCT__ "MatMatMult_SeqDense_SeqAIJ"
4095 PetscErrorCode MatMatMult_SeqDense_SeqAIJ(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
4096 {
4097   PetscErrorCode ierr;
4098 
4099   PetscFunctionBegin;
4100   if (scall == MAT_INITIAL_MATRIX) {
4101     ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
4102     ierr = MatMatMultSymbolic_SeqDense_SeqAIJ(A,B,fill,C);CHKERRQ(ierr);
4103     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
4104   }
4105   ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
4106   ierr = MatMatMultNumeric_SeqDense_SeqAIJ(A,B,*C);CHKERRQ(ierr);
4107   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
4108   PetscFunctionReturn(0);
4109 }
4110 
4111 
4112 /*MC
4113    MATSEQAIJ - MATSEQAIJ = "seqaij" - A matrix type to be used for sequential sparse matrices,
4114    based on compressed sparse row format.
4115 
4116    Options Database Keys:
4117 . -mat_type seqaij - sets the matrix type to "seqaij" during a call to MatSetFromOptions()
4118 
4119   Level: beginner
4120 
4121 .seealso: MatCreateSeqAIJ(), MatSetFromOptions(), MatSetType(), MatCreate(), MatType
4122 M*/
4123 
4124 /*MC
4125    MATAIJ - MATAIJ = "aij" - A matrix type to be used for sparse matrices.
4126 
4127    This matrix type is identical to MATSEQAIJ when constructed with a single process communicator,
4128    and MATMPIAIJ otherwise.  As a result, for single process communicators,
4129   MatSeqAIJSetPreallocation is supported, and similarly MatMPIAIJSetPreallocation is supported
4130   for communicators controlling multiple processes.  It is recommended that you call both of
4131   the above preallocation routines for simplicity.
4132 
4133    Options Database Keys:
4134 . -mat_type aij - sets the matrix type to "aij" during a call to MatSetFromOptions()
4135 
4136   Developer Notes: Subclasses include MATAIJCUSP, MATAIJPERM, MATAIJCRL, and also automatically switches over to use inodes when
4137    enough exist.
4138 
4139   Level: beginner
4140 
4141 .seealso: MatCreateAIJ(), MatCreateSeqAIJ(), MATSEQAIJ,MATMPIAIJ
4142 M*/
4143 
4144 /*MC
4145    MATAIJCRL - MATAIJCRL = "aijcrl" - A matrix type to be used for sparse matrices.
4146 
4147    This matrix type is identical to MATSEQAIJCRL when constructed with a single process communicator,
4148    and MATMPIAIJCRL otherwise.  As a result, for single process communicators,
4149    MatSeqAIJSetPreallocation() is supported, and similarly MatMPIAIJSetPreallocation() is supported
4150   for communicators controlling multiple processes.  It is recommended that you call both of
4151   the above preallocation routines for simplicity.
4152 
4153    Options Database Keys:
4154 . -mat_type aijcrl - sets the matrix type to "aijcrl" during a call to MatSetFromOptions()
4155 
4156   Level: beginner
4157 
4158 .seealso: MatCreateMPIAIJCRL,MATSEQAIJCRL,MATMPIAIJCRL, MATSEQAIJCRL, MATMPIAIJCRL
4159 M*/
4160 
4161 #if defined(PETSC_HAVE_PASTIX)
4162 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_pastix(Mat,MatFactorType,Mat*);
4163 #endif
4164 #if defined(PETSC_HAVE_ESSL) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_REAL_SINGLE) && !defined(PETSC_USE_REAL___FLOAT128)
4165 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_essl(Mat,MatFactorType,Mat*);
4166 #endif
4167 PETSC_EXTERN PetscErrorCode MatConvert_SeqAIJ_SeqAIJCRL(Mat,MatType,MatReuse,Mat*);
4168 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_petsc(Mat,MatFactorType,Mat*);
4169 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_bas(Mat,MatFactorType,Mat*);
4170 extern PetscErrorCode  MatGetFactorAvailable_seqaij_petsc(Mat,MatFactorType,PetscBool*);
4171 #if defined(PETSC_HAVE_MUMPS)
4172 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_mumps(Mat,MatFactorType,Mat*);
4173 #endif
4174 #if defined(PETSC_HAVE_SUPERLU)
4175 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_superlu(Mat,MatFactorType,Mat*);
4176 #endif
4177 #if defined(PETSC_HAVE_SUPERLU_DIST)
4178 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_superlu_dist(Mat,MatFactorType,Mat*);
4179 #endif
4180 #if defined(PETSC_HAVE_UMFPACK)
4181 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_umfpack(Mat,MatFactorType,Mat*);
4182 #endif
4183 #if defined(PETSC_HAVE_CHOLMOD)
4184 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_cholmod(Mat,MatFactorType,Mat*);
4185 #endif
4186 #if defined(PETSC_HAVE_LUSOL)
4187 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_lusol(Mat,MatFactorType,Mat*);
4188 #endif
4189 #if defined(PETSC_HAVE_MATLAB_ENGINE)
4190 PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_matlab(Mat,MatFactorType,Mat*);
4191 extern PetscErrorCode  MatlabEnginePut_SeqAIJ(PetscObject,void*);
4192 extern PetscErrorCode  MatlabEngineGet_SeqAIJ(PetscObject,void*);
4193 #endif
4194 #if defined(PETSC_HAVE_CLIQUE)
4195 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_clique(Mat,MatFactorType,Mat*);
4196 #endif
4197 
4198 
4199 #undef __FUNCT__
4200 #define __FUNCT__ "MatSeqAIJGetArray"
4201 /*@C
4202    MatSeqAIJGetArray - gives access to the array where the data for a SeqSeqAIJ matrix is stored
4203 
4204    Not Collective
4205 
4206    Input Parameter:
4207 .  mat - a MATSEQDENSE matrix
4208 
4209    Output Parameter:
4210 .   array - pointer to the data
4211 
4212    Level: intermediate
4213 
4214 .seealso: MatSeqAIJRestoreArray(), MatSeqAIJGetArrayF90()
4215 @*/
4216 PetscErrorCode  MatSeqAIJGetArray(Mat A,PetscScalar **array)
4217 {
4218   PetscErrorCode ierr;
4219 
4220   PetscFunctionBegin;
4221   ierr = PetscUseMethod(A,"MatSeqAIJGetArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
4222   PetscFunctionReturn(0);
4223 }
4224 
4225 #undef __FUNCT__
4226 #define __FUNCT__ "MatSeqAIJRestoreArray"
4227 /*@C
4228    MatSeqAIJRestoreArray - returns access to the array where the data for a SeqSeqAIJ matrix is stored obtained by MatSeqAIJGetArray()
4229 
4230    Not Collective
4231 
4232    Input Parameters:
4233 .  mat - a MATSEQDENSE matrix
4234 .  array - pointer to the data
4235 
4236    Level: intermediate
4237 
4238 .seealso: MatSeqAIJGetArray(), MatSeqAIJRestoreArrayF90()
4239 @*/
4240 PetscErrorCode  MatSeqAIJRestoreArray(Mat A,PetscScalar **array)
4241 {
4242   PetscErrorCode ierr;
4243 
4244   PetscFunctionBegin;
4245   ierr = PetscUseMethod(A,"MatSeqAIJRestoreArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
4246   PetscFunctionReturn(0);
4247 }
4248 
4249 #undef __FUNCT__
4250 #define __FUNCT__ "MatCreate_SeqAIJ"
4251 PETSC_EXTERN PetscErrorCode MatCreate_SeqAIJ(Mat B)
4252 {
4253   Mat_SeqAIJ     *b;
4254   PetscErrorCode ierr;
4255   PetscMPIInt    size;
4256 
4257   PetscFunctionBegin;
4258   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)B),&size);CHKERRQ(ierr);
4259   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Comm must be of size 1");
4260 
4261   ierr = PetscNewLog(B,Mat_SeqAIJ,&b);CHKERRQ(ierr);
4262 
4263   B->data = (void*)b;
4264 
4265   ierr = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
4266 
4267   b->row                = 0;
4268   b->col                = 0;
4269   b->icol               = 0;
4270   b->reallocs           = 0;
4271   b->ignorezeroentries  = PETSC_FALSE;
4272   b->roworiented        = PETSC_TRUE;
4273   b->nonew              = 0;
4274   b->diag               = 0;
4275   b->solve_work         = 0;
4276   B->spptr              = 0;
4277   b->saved_values       = 0;
4278   b->idiag              = 0;
4279   b->mdiag              = 0;
4280   b->ssor_work          = 0;
4281   b->omega              = 1.0;
4282   b->fshift             = 0.0;
4283   b->idiagvalid         = PETSC_FALSE;
4284   b->ibdiagvalid        = PETSC_FALSE;
4285   b->keepnonzeropattern = PETSC_FALSE;
4286   b->xtoy               = 0;
4287   b->XtoY               = 0;
4288   B->same_nonzero       = PETSC_FALSE;
4289 
4290   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr);
4291   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJGetArray_C",MatSeqAIJGetArray_SeqAIJ);CHKERRQ(ierr);
4292   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJRestoreArray_C",MatSeqAIJRestoreArray_SeqAIJ);CHKERRQ(ierr);
4293 
4294 #if defined(PETSC_HAVE_MATLAB_ENGINE)
4295   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_matlab_C",MatGetFactor_seqaij_matlab);CHKERRQ(ierr);
4296   ierr = PetscObjectComposeFunction((PetscObject)B,"PetscMatlabEnginePut_C",MatlabEnginePut_SeqAIJ);CHKERRQ(ierr);
4297   ierr = PetscObjectComposeFunction((PetscObject)B,"PetscMatlabEngineGet_C",MatlabEngineGet_SeqAIJ);CHKERRQ(ierr);
4298 #endif
4299 #if defined(PETSC_HAVE_PASTIX)
4300   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_pastix_C",MatGetFactor_seqaij_pastix);CHKERRQ(ierr);
4301 #endif
4302 #if defined(PETSC_HAVE_ESSL) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_REAL_SINGLE) && !defined(PETSC_USE_REAL___FLOAT128)
4303   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_essl_C",MatGetFactor_seqaij_essl);CHKERRQ(ierr);
4304 #endif
4305 #if defined(PETSC_HAVE_SUPERLU)
4306   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_superlu_C",MatGetFactor_seqaij_superlu);CHKERRQ(ierr);
4307 #endif
4308 #if defined(PETSC_HAVE_SUPERLU_DIST)
4309   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_superlu_dist_C",MatGetFactor_seqaij_superlu_dist);CHKERRQ(ierr);
4310 #endif
4311 #if defined(PETSC_HAVE_MUMPS)
4312   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_mumps_C",MatGetFactor_aij_mumps);CHKERRQ(ierr);
4313 #endif
4314 #if defined(PETSC_HAVE_UMFPACK)
4315   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_umfpack_C",MatGetFactor_seqaij_umfpack);CHKERRQ(ierr);
4316 #endif
4317 #if defined(PETSC_HAVE_CHOLMOD)
4318   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_cholmod_C",MatGetFactor_seqaij_cholmod);CHKERRQ(ierr);
4319 #endif
4320 #if defined(PETSC_HAVE_LUSOL)
4321   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_lusol_C",MatGetFactor_seqaij_lusol);CHKERRQ(ierr);
4322 #endif
4323 #if defined(PETSC_HAVE_CLIQUE)
4324   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_clique_C",MatGetFactor_aij_clique);CHKERRQ(ierr);
4325 #endif
4326 
4327   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_petsc_C",MatGetFactor_seqaij_petsc);CHKERRQ(ierr);
4328   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactorAvailable_petsc_C",MatGetFactorAvailable_seqaij_petsc);CHKERRQ(ierr);
4329   ierr = PetscObjectComposeFunction((PetscObject)B,"MatGetFactor_bas_C",MatGetFactor_seqaij_bas);CHKERRQ(ierr);
4330   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetColumnIndices_C",MatSeqAIJSetColumnIndices_SeqAIJ);CHKERRQ(ierr);
4331   ierr = PetscObjectComposeFunction((PetscObject)B,"MatStoreValues_C",MatStoreValues_SeqAIJ);CHKERRQ(ierr);
4332   ierr = PetscObjectComposeFunction((PetscObject)B,"MatRetrieveValues_C",MatRetrieveValues_SeqAIJ);CHKERRQ(ierr);
4333   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqsbaij_C",MatConvert_SeqAIJ_SeqSBAIJ);CHKERRQ(ierr);
4334   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqbaij_C",MatConvert_SeqAIJ_SeqBAIJ);CHKERRQ(ierr);
4335   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqaijperm_C",MatConvert_SeqAIJ_SeqAIJPERM);CHKERRQ(ierr);
4336   ierr = PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqaij_seqaijcrl_C",MatConvert_SeqAIJ_SeqAIJCRL);CHKERRQ(ierr);
4337   ierr = PetscObjectComposeFunction((PetscObject)B,"MatIsTranspose_C",MatIsTranspose_SeqAIJ);CHKERRQ(ierr);
4338   ierr = PetscObjectComposeFunction((PetscObject)B,"MatIsHermitianTranspose_C",MatIsTranspose_SeqAIJ);CHKERRQ(ierr);
4339   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetPreallocation_C",MatSeqAIJSetPreallocation_SeqAIJ);CHKERRQ(ierr);
4340   ierr = PetscObjectComposeFunction((PetscObject)B,"MatSeqAIJSetPreallocationCSR_C",MatSeqAIJSetPreallocationCSR_SeqAIJ);CHKERRQ(ierr);
4341   ierr = PetscObjectComposeFunction((PetscObject)B,"MatReorderForNonzeroDiagonal_C",MatReorderForNonzeroDiagonal_SeqAIJ);CHKERRQ(ierr);
4342   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMult_seqdense_seqaij_C",MatMatMult_SeqDense_SeqAIJ);CHKERRQ(ierr);
4343   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultSymbolic_seqdense_seqaij_C",MatMatMultSymbolic_SeqDense_SeqAIJ);CHKERRQ(ierr);
4344   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMatMultNumeric_seqdense_seqaij_C",MatMatMultNumeric_SeqDense_SeqAIJ);CHKERRQ(ierr);
4345   ierr = MatCreate_SeqAIJ_Inode(B);CHKERRQ(ierr);
4346   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr);
4347   PetscFunctionReturn(0);
4348 }
4349 
4350 #undef __FUNCT__
4351 #define __FUNCT__ "MatDuplicateNoCreate_SeqAIJ"
4352 /*
4353     Given a matrix generated with MatGetFactor() duplicates all the information in A into B
4354 */
4355 PetscErrorCode MatDuplicateNoCreate_SeqAIJ(Mat C,Mat A,MatDuplicateOption cpvalues,PetscBool mallocmatspace)
4356 {
4357   Mat_SeqAIJ     *c,*a = (Mat_SeqAIJ*)A->data;
4358   PetscErrorCode ierr;
4359   PetscInt       i,m = A->rmap->n;
4360 
4361   PetscFunctionBegin;
4362   c = (Mat_SeqAIJ*)C->data;
4363 
4364   C->factortype = A->factortype;
4365   c->row        = 0;
4366   c->col        = 0;
4367   c->icol       = 0;
4368   c->reallocs   = 0;
4369 
4370   C->assembled = PETSC_TRUE;
4371 
4372   ierr = PetscLayoutReference(A->rmap,&C->rmap);CHKERRQ(ierr);
4373   ierr = PetscLayoutReference(A->cmap,&C->cmap);CHKERRQ(ierr);
4374 
4375   ierr = PetscMalloc2(m,PetscInt,&c->imax,m,PetscInt,&c->ilen);CHKERRQ(ierr);
4376   ierr = PetscLogObjectMemory((PetscObject)C, 2*m*sizeof(PetscInt));CHKERRQ(ierr);
4377   for (i=0; i<m; i++) {
4378     c->imax[i] = a->imax[i];
4379     c->ilen[i] = a->ilen[i];
4380   }
4381 
4382   /* allocate the matrix space */
4383   if (mallocmatspace) {
4384     ierr = PetscMalloc3(a->i[m],PetscScalar,&c->a,a->i[m],PetscInt,&c->j,m+1,PetscInt,&c->i);CHKERRQ(ierr);
4385     ierr = PetscLogObjectMemory((PetscObject)C, a->i[m]*(sizeof(PetscScalar)+sizeof(PetscInt))+(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4386 
4387     c->singlemalloc = PETSC_TRUE;
4388 
4389     ierr = PetscMemcpy(c->i,a->i,(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4390     if (m > 0) {
4391       ierr = PetscMemcpy(c->j,a->j,(a->i[m])*sizeof(PetscInt));CHKERRQ(ierr);
4392       if (cpvalues == MAT_COPY_VALUES) {
4393         ierr = PetscMemcpy(c->a,a->a,(a->i[m])*sizeof(PetscScalar));CHKERRQ(ierr);
4394       } else {
4395         ierr = PetscMemzero(c->a,(a->i[m])*sizeof(PetscScalar));CHKERRQ(ierr);
4396       }
4397     }
4398   }
4399 
4400   c->ignorezeroentries = a->ignorezeroentries;
4401   c->roworiented       = a->roworiented;
4402   c->nonew             = a->nonew;
4403   if (a->diag) {
4404     ierr = PetscMalloc((m+1)*sizeof(PetscInt),&c->diag);CHKERRQ(ierr);
4405     ierr = PetscLogObjectMemory((PetscObject)C,(m+1)*sizeof(PetscInt));CHKERRQ(ierr);
4406     for (i=0; i<m; i++) {
4407       c->diag[i] = a->diag[i];
4408     }
4409   } else c->diag = 0;
4410 
4411   c->solve_work         = 0;
4412   c->saved_values       = 0;
4413   c->idiag              = 0;
4414   c->ssor_work          = 0;
4415   c->keepnonzeropattern = a->keepnonzeropattern;
4416   c->free_a             = PETSC_TRUE;
4417   c->free_ij            = PETSC_TRUE;
4418   c->xtoy               = 0;
4419   c->XtoY               = 0;
4420 
4421   c->rmax         = a->rmax;
4422   c->nz           = a->nz;
4423   c->maxnz        = a->nz;       /* Since we allocate exactly the right amount */
4424   C->preallocated = PETSC_TRUE;
4425 
4426   c->compressedrow.use   = a->compressedrow.use;
4427   c->compressedrow.nrows = a->compressedrow.nrows;
4428   c->compressedrow.check = a->compressedrow.check;
4429   if (a->compressedrow.use) {
4430     i    = a->compressedrow.nrows;
4431     ierr = PetscMalloc2(i+1,PetscInt,&c->compressedrow.i,i,PetscInt,&c->compressedrow.rindex);CHKERRQ(ierr);
4432     ierr = PetscMemcpy(c->compressedrow.i,a->compressedrow.i,(i+1)*sizeof(PetscInt));CHKERRQ(ierr);
4433     ierr = PetscMemcpy(c->compressedrow.rindex,a->compressedrow.rindex,i*sizeof(PetscInt));CHKERRQ(ierr);
4434   } else {
4435     c->compressedrow.use    = PETSC_FALSE;
4436     c->compressedrow.i      = NULL;
4437     c->compressedrow.rindex = NULL;
4438   }
4439   C->same_nonzero = A->same_nonzero;
4440 
4441   ierr = MatDuplicate_SeqAIJ_Inode(A,cpvalues,&C);CHKERRQ(ierr);
4442   ierr = PetscFunctionListDuplicate(((PetscObject)A)->qlist,&((PetscObject)C)->qlist);CHKERRQ(ierr);
4443   PetscFunctionReturn(0);
4444 }
4445 
4446 #undef __FUNCT__
4447 #define __FUNCT__ "MatDuplicate_SeqAIJ"
4448 PetscErrorCode MatDuplicate_SeqAIJ(Mat A,MatDuplicateOption cpvalues,Mat *B)
4449 {
4450   PetscErrorCode ierr;
4451 
4452   PetscFunctionBegin;
4453   ierr = MatCreate(PetscObjectComm((PetscObject)A),B);CHKERRQ(ierr);
4454   ierr = MatSetSizes(*B,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
4455   ierr = MatSetBlockSizes(*B,A->rmap->bs,A->cmap->bs);CHKERRQ(ierr);
4456   ierr = MatSetType(*B,((PetscObject)A)->type_name);CHKERRQ(ierr);
4457   ierr = MatDuplicateNoCreate_SeqAIJ(*B,A,cpvalues,PETSC_TRUE);CHKERRQ(ierr);
4458   PetscFunctionReturn(0);
4459 }
4460 
4461 #undef __FUNCT__
4462 #define __FUNCT__ "MatLoad_SeqAIJ"
4463 PetscErrorCode MatLoad_SeqAIJ(Mat newMat, PetscViewer viewer)
4464 {
4465   Mat_SeqAIJ     *a;
4466   PetscErrorCode ierr;
4467   PetscInt       i,sum,nz,header[4],*rowlengths = 0,M,N,rows,cols;
4468   int            fd;
4469   PetscMPIInt    size;
4470   MPI_Comm       comm;
4471   PetscInt       bs = 1;
4472 
4473   PetscFunctionBegin;
4474   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
4475   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
4476   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"view must have one processor");
4477 
4478   ierr = PetscOptionsBegin(comm,NULL,"Options for loading SEQAIJ matrix","Mat");CHKERRQ(ierr);
4479   ierr = PetscOptionsInt("-matload_block_size","Set the blocksize used to store the matrix","MatLoad",bs,&bs,NULL);CHKERRQ(ierr);
4480   ierr = PetscOptionsEnd();CHKERRQ(ierr);
4481   if (bs > 1) {ierr = MatSetBlockSize(newMat,bs);CHKERRQ(ierr);}
4482 
4483   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
4484   ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr);
4485   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"not matrix object in file");
4486   M = header[1]; N = header[2]; nz = header[3];
4487 
4488   if (nz < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Matrix stored in special format on disk,cannot load as SeqAIJ");
4489 
4490   /* read in row lengths */
4491   ierr = PetscMalloc(M*sizeof(PetscInt),&rowlengths);CHKERRQ(ierr);
4492   ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr);
4493 
4494   /* check if sum of rowlengths is same as nz */
4495   for (i=0,sum=0; i< M; i++) sum +=rowlengths[i];
4496   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);
4497 
4498   /* set global size if not set already*/
4499   if (newMat->rmap->n < 0 && newMat->rmap->N < 0 && newMat->cmap->n < 0 && newMat->cmap->N < 0) {
4500     ierr = MatSetSizes(newMat,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
4501   } else {
4502     /* if sizes and type are already set, check if the vector global sizes are correct */
4503     ierr = MatGetSize(newMat,&rows,&cols);CHKERRQ(ierr);
4504     if (rows < 0 && cols < 0) { /* user might provide local size instead of global size */
4505       ierr = MatGetLocalSize(newMat,&rows,&cols);CHKERRQ(ierr);
4506     }
4507     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);
4508   }
4509   ierr = MatSeqAIJSetPreallocation_SeqAIJ(newMat,0,rowlengths);CHKERRQ(ierr);
4510   a    = (Mat_SeqAIJ*)newMat->data;
4511 
4512   ierr = PetscBinaryRead(fd,a->j,nz,PETSC_INT);CHKERRQ(ierr);
4513 
4514   /* read in nonzero values */
4515   ierr = PetscBinaryRead(fd,a->a,nz,PETSC_SCALAR);CHKERRQ(ierr);
4516 
4517   /* set matrix "i" values */
4518   a->i[0] = 0;
4519   for (i=1; i<= M; i++) {
4520     a->i[i]      = a->i[i-1] + rowlengths[i-1];
4521     a->ilen[i-1] = rowlengths[i-1];
4522   }
4523   ierr = PetscFree(rowlengths);CHKERRQ(ierr);
4524 
4525   ierr = MatAssemblyBegin(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4526   ierr = MatAssemblyEnd(newMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4527   PetscFunctionReturn(0);
4528 }
4529 
4530 #undef __FUNCT__
4531 #define __FUNCT__ "MatEqual_SeqAIJ"
4532 PetscErrorCode MatEqual_SeqAIJ(Mat A,Mat B,PetscBool * flg)
4533 {
4534   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data,*b = (Mat_SeqAIJ*)B->data;
4535   PetscErrorCode ierr;
4536 #if defined(PETSC_USE_COMPLEX)
4537   PetscInt k;
4538 #endif
4539 
4540   PetscFunctionBegin;
4541   /* If the  matrix dimensions are not equal,or no of nonzeros */
4542   if ((A->rmap->n != B->rmap->n) || (A->cmap->n != B->cmap->n) ||(a->nz != b->nz)) {
4543     *flg = PETSC_FALSE;
4544     PetscFunctionReturn(0);
4545   }
4546 
4547   /* if the a->i are the same */
4548   ierr = PetscMemcmp(a->i,b->i,(A->rmap->n+1)*sizeof(PetscInt),flg);CHKERRQ(ierr);
4549   if (!*flg) PetscFunctionReturn(0);
4550 
4551   /* if a->j are the same */
4552   ierr = PetscMemcmp(a->j,b->j,(a->nz)*sizeof(PetscInt),flg);CHKERRQ(ierr);
4553   if (!*flg) PetscFunctionReturn(0);
4554 
4555   /* if a->a are the same */
4556 #if defined(PETSC_USE_COMPLEX)
4557   for (k=0; k<a->nz; k++) {
4558     if (PetscRealPart(a->a[k]) != PetscRealPart(b->a[k]) || PetscImaginaryPart(a->a[k]) != PetscImaginaryPart(b->a[k])) {
4559       *flg = PETSC_FALSE;
4560       PetscFunctionReturn(0);
4561     }
4562   }
4563 #else
4564   ierr = PetscMemcmp(a->a,b->a,(a->nz)*sizeof(PetscScalar),flg);CHKERRQ(ierr);
4565 #endif
4566   PetscFunctionReturn(0);
4567 }
4568 
4569 #undef __FUNCT__
4570 #define __FUNCT__ "MatCreateSeqAIJWithArrays"
4571 /*@
4572      MatCreateSeqAIJWithArrays - Creates an sequential AIJ matrix using matrix elements (in CSR format)
4573               provided by the user.
4574 
4575       Collective on MPI_Comm
4576 
4577    Input Parameters:
4578 +   comm - must be an MPI communicator of size 1
4579 .   m - number of rows
4580 .   n - number of columns
4581 .   i - row indices
4582 .   j - column indices
4583 -   a - matrix values
4584 
4585    Output Parameter:
4586 .   mat - the matrix
4587 
4588    Level: intermediate
4589 
4590    Notes:
4591        The i, j, and a arrays are not copied by this routine, the user must free these arrays
4592     once the matrix is destroyed and not before
4593 
4594        You cannot set new nonzero locations into this matrix, that will generate an error.
4595 
4596        The i and j indices are 0 based
4597 
4598        The format which is used for the sparse matrix input, is equivalent to a
4599     row-major ordering.. i.e for the following matrix, the input data expected is
4600     as shown:
4601 
4602         1 0 0
4603         2 0 3
4604         4 5 6
4605 
4606         i =  {0,1,3,6}  [size = nrow+1  = 3+1]
4607         j =  {0,0,2,0,1,2}  [size = nz = 6]; values must be sorted for each row
4608         v =  {1,2,3,4,5,6}  [size = nz = 6]
4609 
4610 
4611 .seealso: MatCreate(), MatCreateAIJ(), MatCreateSeqAIJ(), MatCreateMPIAIJWithArrays(), MatMPIAIJSetPreallocationCSR()
4612 
4613 @*/
4614 PetscErrorCode  MatCreateSeqAIJWithArrays(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat)
4615 {
4616   PetscErrorCode ierr;
4617   PetscInt       ii;
4618   Mat_SeqAIJ     *aij;
4619 #if defined(PETSC_USE_DEBUG)
4620   PetscInt jj;
4621 #endif
4622 
4623   PetscFunctionBegin;
4624   if (i[0]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"i (row indices) must start with 0");
4625   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
4626   ierr = MatSetSizes(*mat,m,n,m,n);CHKERRQ(ierr);
4627   /* ierr = MatSetBlockSizes(*mat,,);CHKERRQ(ierr); */
4628   ierr = MatSetType(*mat,MATSEQAIJ);CHKERRQ(ierr);
4629   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*mat,MAT_SKIP_ALLOCATION,0);CHKERRQ(ierr);
4630   aij  = (Mat_SeqAIJ*)(*mat)->data;
4631   ierr = PetscMalloc2(m,PetscInt,&aij->imax,m,PetscInt,&aij->ilen);CHKERRQ(ierr);
4632 
4633   aij->i            = i;
4634   aij->j            = j;
4635   aij->a            = a;
4636   aij->singlemalloc = PETSC_FALSE;
4637   aij->nonew        = -1;             /*this indicates that inserting a new value in the matrix that generates a new nonzero is an error*/
4638   aij->free_a       = PETSC_FALSE;
4639   aij->free_ij      = PETSC_FALSE;
4640 
4641   for (ii=0; ii<m; ii++) {
4642     aij->ilen[ii] = aij->imax[ii] = i[ii+1] - i[ii];
4643 #if defined(PETSC_USE_DEBUG)
4644     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]);
4645     for (jj=i[ii]+1; jj<i[ii+1]; jj++) {
4646       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);
4647       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);
4648     }
4649 #endif
4650   }
4651 #if defined(PETSC_USE_DEBUG)
4652   for (ii=0; ii<aij->i[m]; ii++) {
4653     if (j[ii] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative column index at location = %d index = %d",ii,j[ii]);
4654     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]);
4655   }
4656 #endif
4657 
4658   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4659   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4660   PetscFunctionReturn(0);
4661 }
4662 #undef __FUNCT__
4663 #define __FUNCT__ "MatCreateSeqAIJFromTriple"
4664 /*@C
4665      MatCreateSeqAIJFromTriple - Creates an sequential AIJ matrix using matrix elements (in COO format)
4666               provided by the user.
4667 
4668       Collective on MPI_Comm
4669 
4670    Input Parameters:
4671 +   comm - must be an MPI communicator of size 1
4672 .   m   - number of rows
4673 .   n   - number of columns
4674 .   i   - row indices
4675 .   j   - column indices
4676 .   a   - matrix values
4677 .   nz  - number of nonzeros
4678 -   idx - 0 or 1 based
4679 
4680    Output Parameter:
4681 .   mat - the matrix
4682 
4683    Level: intermediate
4684 
4685    Notes:
4686        The i and j indices are 0 based
4687 
4688        The format which is used for the sparse matrix input, is equivalent to a
4689     row-major ordering.. i.e for the following matrix, the input data expected is
4690     as shown:
4691 
4692         1 0 0
4693         2 0 3
4694         4 5 6
4695 
4696         i =  {0,1,1,2,2,2}
4697         j =  {0,0,2,0,1,2}
4698         v =  {1,2,3,4,5,6}
4699 
4700 
4701 .seealso: MatCreate(), MatCreateAIJ(), MatCreateSeqAIJ(), MatCreateSeqAIJWithArrays(), MatMPIAIJSetPreallocationCSR()
4702 
4703 @*/
4704 PetscErrorCode  MatCreateSeqAIJFromTriple(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat,PetscInt nz,PetscBool idx)
4705 {
4706   PetscErrorCode ierr;
4707   PetscInt       ii, *nnz, one = 1,row,col;
4708 
4709 
4710   PetscFunctionBegin;
4711   ierr = PetscMalloc(m*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
4712   ierr = PetscMemzero(nnz,m*sizeof(PetscInt));CHKERRQ(ierr);
4713   for (ii = 0; ii < nz; ii++) {
4714     nnz[i[ii]] += 1;
4715   }
4716   ierr = MatCreate(comm,mat);CHKERRQ(ierr);
4717   ierr = MatSetSizes(*mat,m,n,m,n);CHKERRQ(ierr);
4718   /* ierr = MatSetBlockSizes(*mat,,);CHKERRQ(ierr); */
4719   ierr = MatSetType(*mat,MATSEQAIJ);CHKERRQ(ierr);
4720   ierr = MatSeqAIJSetPreallocation_SeqAIJ(*mat,0,nnz);CHKERRQ(ierr);
4721   for (ii = 0; ii < nz; ii++) {
4722     if (idx) {
4723       row = i[ii] - 1;
4724       col = j[ii] - 1;
4725     } else {
4726       row = i[ii];
4727       col = j[ii];
4728     }
4729     ierr = MatSetValues(*mat,one,&row,one,&col,&a[ii],ADD_VALUES);CHKERRQ(ierr);
4730   }
4731   ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4732   ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4733   ierr = PetscFree(nnz);CHKERRQ(ierr);
4734   PetscFunctionReturn(0);
4735 }
4736 
4737 #undef __FUNCT__
4738 #define __FUNCT__ "MatSetColoring_SeqAIJ"
4739 PetscErrorCode MatSetColoring_SeqAIJ(Mat A,ISColoring coloring)
4740 {
4741   PetscErrorCode ierr;
4742   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
4743 
4744   PetscFunctionBegin;
4745   if (coloring->ctype == IS_COLORING_GLOBAL) {
4746     ierr        = ISColoringReference(coloring);CHKERRQ(ierr);
4747     a->coloring = coloring;
4748   } else if (coloring->ctype == IS_COLORING_GHOSTED) {
4749     PetscInt        i,*larray;
4750     ISColoring      ocoloring;
4751     ISColoringValue *colors;
4752 
4753     /* set coloring for diagonal portion */
4754     ierr = PetscMalloc(A->cmap->n*sizeof(PetscInt),&larray);CHKERRQ(ierr);
4755     for (i=0; i<A->cmap->n; i++) larray[i] = i;
4756     ierr = ISGlobalToLocalMappingApply(A->cmap->mapping,IS_GTOLM_MASK,A->cmap->n,larray,NULL,larray);CHKERRQ(ierr);
4757     ierr = PetscMalloc(A->cmap->n*sizeof(ISColoringValue),&colors);CHKERRQ(ierr);
4758     for (i=0; i<A->cmap->n; i++) colors[i] = coloring->colors[larray[i]];
4759     ierr        = PetscFree(larray);CHKERRQ(ierr);
4760     ierr        = ISColoringCreate(PETSC_COMM_SELF,coloring->n,A->cmap->n,colors,&ocoloring);CHKERRQ(ierr);
4761     a->coloring = ocoloring;
4762   }
4763   PetscFunctionReturn(0);
4764 }
4765 
4766 #undef __FUNCT__
4767 #define __FUNCT__ "MatSetValuesAdifor_SeqAIJ"
4768 PetscErrorCode MatSetValuesAdifor_SeqAIJ(Mat A,PetscInt nl,void *advalues)
4769 {
4770   Mat_SeqAIJ      *a      = (Mat_SeqAIJ*)A->data;
4771   PetscInt        m       = A->rmap->n,*ii = a->i,*jj = a->j,nz,i,j;
4772   MatScalar       *v      = a->a;
4773   PetscScalar     *values = (PetscScalar*)advalues;
4774   ISColoringValue *color;
4775 
4776   PetscFunctionBegin;
4777   if (!a->coloring) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Coloring not set for matrix");
4778   color = a->coloring->colors;
4779   /* loop over rows */
4780   for (i=0; i<m; i++) {
4781     nz = ii[i+1] - ii[i];
4782     /* loop over columns putting computed value into matrix */
4783     for (j=0; j<nz; j++) *v++ = values[color[*jj++]];
4784     values += nl; /* jump to next row of derivatives */
4785   }
4786   PetscFunctionReturn(0);
4787 }
4788 
4789 #undef __FUNCT__
4790 #define __FUNCT__ "MatSeqAIJInvalidateDiagonal"
4791 PetscErrorCode MatSeqAIJInvalidateDiagonal(Mat A)
4792 {
4793   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
4794   PetscErrorCode ierr;
4795 
4796   PetscFunctionBegin;
4797   a->idiagvalid  = PETSC_FALSE;
4798   a->ibdiagvalid = PETSC_FALSE;
4799 
4800   ierr = MatSeqAIJInvalidateDiagonal_Inode(A);CHKERRQ(ierr);
4801   PetscFunctionReturn(0);
4802 }
4803 
4804 /*
4805     Special version for direct calls from Fortran
4806 */
4807 #include <petsc-private/fortranimpl.h>
4808 #if defined(PETSC_HAVE_FORTRAN_CAPS)
4809 #define matsetvaluesseqaij_ MATSETVALUESSEQAIJ
4810 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
4811 #define matsetvaluesseqaij_ matsetvaluesseqaij
4812 #endif
4813 
4814 /* Change these macros so can be used in void function */
4815 #undef CHKERRQ
4816 #define CHKERRQ(ierr) CHKERRABORT(PetscObjectComm((PetscObject)A),ierr)
4817 #undef SETERRQ2
4818 #define SETERRQ2(comm,ierr,b,c,d) CHKERRABORT(comm,ierr)
4819 #undef SETERRQ3
4820 #define SETERRQ3(comm,ierr,b,c,d,e) CHKERRABORT(comm,ierr)
4821 
4822 #undef __FUNCT__
4823 #define __FUNCT__ "matsetvaluesseqaij_"
4824 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)
4825 {
4826   Mat            A  = *AA;
4827   PetscInt       m  = *mm, n = *nn;
4828   InsertMode     is = *isis;
4829   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
4830   PetscInt       *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax,N;
4831   PetscInt       *imax,*ai,*ailen;
4832   PetscErrorCode ierr;
4833   PetscInt       *aj,nonew = a->nonew,lastcol = -1;
4834   MatScalar      *ap,value,*aa;
4835   PetscBool      ignorezeroentries = a->ignorezeroentries;
4836   PetscBool      roworiented       = a->roworiented;
4837 
4838   PetscFunctionBegin;
4839   MatCheckPreallocated(A,1);
4840   imax  = a->imax;
4841   ai    = a->i;
4842   ailen = a->ilen;
4843   aj    = a->j;
4844   aa    = a->a;
4845 
4846   for (k=0; k<m; k++) { /* loop over added rows */
4847     row = im[k];
4848     if (row < 0) continue;
4849 #if defined(PETSC_USE_DEBUG)
4850     if (row >= A->rmap->n) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Row too large");
4851 #endif
4852     rp   = aj + ai[row]; ap = aa + ai[row];
4853     rmax = imax[row]; nrow = ailen[row];
4854     low  = 0;
4855     high = nrow;
4856     for (l=0; l<n; l++) { /* loop over added columns */
4857       if (in[l] < 0) continue;
4858 #if defined(PETSC_USE_DEBUG)
4859       if (in[l] >= A->cmap->n) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Column too large");
4860 #endif
4861       col = in[l];
4862       if (roworiented) value = v[l + k*n];
4863       else value = v[k + l*m];
4864 
4865       if (value == 0.0 && ignorezeroentries && (is == ADD_VALUES)) continue;
4866 
4867       if (col <= lastcol) low = 0;
4868       else high = nrow;
4869       lastcol = col;
4870       while (high-low > 5) {
4871         t = (low+high)/2;
4872         if (rp[t] > col) high = t;
4873         else             low  = t;
4874       }
4875       for (i=low; i<high; i++) {
4876         if (rp[i] > col) break;
4877         if (rp[i] == col) {
4878           if (is == ADD_VALUES) ap[i] += value;
4879           else                  ap[i] = value;
4880           goto noinsert;
4881         }
4882       }
4883       if (value == 0.0 && ignorezeroentries) goto noinsert;
4884       if (nonew == 1) goto noinsert;
4885       if (nonew == -1) SETERRABORT(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero in the matrix");
4886       MatSeqXAIJReallocateAIJ(A,A->rmap->n,1,nrow,row,col,rmax,aa,ai,aj,rp,ap,imax,nonew,MatScalar);
4887       N = nrow++ - 1; a->nz++; high++;
4888       /* shift up all the later entries in this row */
4889       for (ii=N; ii>=i; ii--) {
4890         rp[ii+1] = rp[ii];
4891         ap[ii+1] = ap[ii];
4892       }
4893       rp[i] = col;
4894       ap[i] = value;
4895 noinsert:;
4896       low = i + 1;
4897     }
4898     ailen[row] = nrow;
4899   }
4900   A->same_nonzero = PETSC_FALSE;
4901   PetscFunctionReturnVoid();
4902 }
4903 
4904 
4905