xref: /petsc/src/mat/impls/aij/seq/aij.c (revision 3eee16b04de4467482e6ce56cbcc0108d577ea39)
1 #ifndef lint
2 static char vcid[] = "$Id: aij.c,v 1.227 1997/07/01 21:45:08 bsmith Exp bsmith $";
3 #endif
4 
5 /*
6     Defines the basic matrix operations for the AIJ (compressed row)
7   matrix storage format.
8 */
9 
10 #include "pinclude/pviewer.h"
11 #include "sys.h"
12 #include "src/mat/impls/aij/seq/aij.h"
13 #include "src/vec/vecimpl.h"
14 #include "src/inline/spops.h"
15 #include "src/inline/bitarray.h"
16 
17 /*
18     Basic AIJ format ILU based on drop tolerance
19 */
20 #undef __FUNC__
21 #define __FUNC__ "MatILUDTFactor_SeqAIJ"
22 int MatILUDTFactor_SeqAIJ(Mat A,double dt,int maxnz,IS row,IS col,Mat *fact)
23 {
24   /* Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; */
25   int        ierr = 1;
26 
27   SETERRQ(ierr,0,"Not implemented");
28 }
29 
30 extern int MatToSymmetricIJ_SeqAIJ(int,int*,int*,int,int,int**,int**);
31 
32 #undef __FUNC__
33 #define __FUNC__ "MatGetRowIJ_SeqAIJ"
34 int MatGetRowIJ_SeqAIJ(Mat A,int oshift,PetscTruth symmetric,int *m,int **ia,int **ja,
35                            PetscTruth *done)
36 {
37   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
38   int        ierr,i,ishift;
39 
40   *m     = A->m;
41   if (!ia) return 0;
42   ishift = a->indexshift;
43   if (symmetric) {
44     ierr = MatToSymmetricIJ_SeqAIJ(a->m,a->i,a->j,ishift,oshift,ia,ja); CHKERRQ(ierr);
45   } else if (oshift == 0 && ishift == -1) {
46     int nz = a->i[a->m];
47     /* malloc space and  subtract 1 from i and j indices */
48     *ia = (int *) PetscMalloc( (a->m+1)*sizeof(int) ); CHKPTRQ(*ia);
49     *ja = (int *) PetscMalloc( (nz+1)*sizeof(int) ); CHKPTRQ(*ja);
50     for ( i=0; i<nz; i++ ) (*ja)[i] = a->j[i] - 1;
51     for ( i=0; i<a->m+1; i++ ) (*ia)[i] = a->i[i] - 1;
52   } else if (oshift == 1 && ishift == 0) {
53     int nz = a->i[a->m] + 1;
54     /* malloc space and  add 1 to i and j indices */
55     *ia = (int *) PetscMalloc( (a->m+1)*sizeof(int) ); CHKPTRQ(*ia);
56     *ja = (int *) PetscMalloc( (nz+1)*sizeof(int) ); CHKPTRQ(*ja);
57     for ( i=0; i<nz; i++ ) (*ja)[i] = a->j[i] + 1;
58     for ( i=0; i<a->m+1; i++ ) (*ia)[i] = a->i[i] + 1;
59   } else {
60     *ia = a->i; *ja = a->j;
61   }
62 
63   return 0;
64 }
65 
66 #undef __FUNC__
67 #define __FUNC__ "MatRestoreRowIJ_SeqAIJ"
68 int MatRestoreRowIJ_SeqAIJ(Mat A,int oshift,PetscTruth symmetric,int *n,int **ia,int **ja,
69                                PetscTruth *done)
70 {
71   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
72   int        ishift = a->indexshift;
73 
74   if (!ia) return 0;
75   if (symmetric || (oshift == 0 && ishift == -1) || (oshift == 1 && ishift == 0)) {
76     PetscFree(*ia);
77     PetscFree(*ja);
78   }
79   return 0;
80 }
81 
82 #undef __FUNC__
83 #define __FUNC__ "MatGetColumnIJ_SeqAIJ"
84 int MatGetColumnIJ_SeqAIJ(Mat A,int oshift,PetscTruth symmetric,int *nn,int **ia,int **ja,
85                            PetscTruth *done)
86 {
87   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
88   int        ierr,i,ishift = a->indexshift,*collengths,*cia,*cja,n = A->n,m = A->m;
89   int        nz = a->i[m]+ishift,row,*jj,mr,col;
90 
91   *nn     = A->n;
92   if (!ia) return 0;
93   if (symmetric) {
94     ierr = MatToSymmetricIJ_SeqAIJ(a->m,a->i,a->j,ishift,oshift,ia,ja); CHKERRQ(ierr);
95   } else {
96     collengths = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(collengths);
97     PetscMemzero(collengths,n*sizeof(int));
98     cia        = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(cia);
99     cja        = (int *) PetscMalloc( (nz+1)*sizeof(int) ); CHKPTRQ(cja);
100     jj = a->j;
101     for ( i=0; i<nz; i++ ) {
102       collengths[jj[i] + ishift]++;
103     }
104     cia[0] = oshift;
105     for ( i=0; i<n; i++) {
106       cia[i+1] = cia[i] + collengths[i];
107     }
108     PetscMemzero(collengths,n*sizeof(int));
109     jj = a->j;
110     for ( row=0; row<m; row++ ) {
111       mr = a->i[row+1] - a->i[row];
112       for ( i=0; i<mr; i++ ) {
113         col = *jj++ + ishift;
114         cja[cia[col] + collengths[col]++ - oshift] = row + oshift;
115       }
116     }
117     PetscFree(collengths);
118     *ia = cia; *ja = cja;
119   }
120 
121   return 0;
122 }
123 
124 #undef __FUNC__
125 #define __FUNC__ "MatRestoreColumnIJ_SeqAIJ"
126 int MatRestoreColumnIJ_SeqAIJ(Mat A,int oshift,PetscTruth symmetric,int *n,int **ia,
127                                      int **ja,PetscTruth *done)
128 {
129   if (!ia) return 0;
130 
131   PetscFree(*ia);
132   PetscFree(*ja);
133 
134   return 0;
135 }
136 
137 #define CHUNKSIZE   15
138 
139 #undef __FUNC__
140 #define __FUNC__ "MatSetValues_SeqAIJ"
141 int MatSetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v,InsertMode is)
142 {
143   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
144   int        *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax, N, sorted = a->sorted;
145   int        *imax = a->imax, *ai = a->i, *ailen = a->ilen,roworiented = a->roworiented;
146   int        *aj = a->j, nonew = a->nonew,shift = a->indexshift;
147   Scalar     *ap,value, *aa = a->a;
148 
149   for ( k=0; k<m; k++ ) { /* loop over added rows */
150     row  = im[k];
151 #if defined(PETSC_BOPT_g)
152     if (row < 0) SETERRQ(1,0,"Negative row");
153     if (row >= a->m) SETERRQ(1,0,"Row too large");
154 #endif
155     rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
156     rmax = imax[row]; nrow = ailen[row];
157     low = 0;
158     for ( l=0; l<n; l++ ) { /* loop over added columns */
159 #if defined(PETSC_BOPT_g)
160       if (in[l] < 0) SETERRQ(1,0,"Negative column");
161       if (in[l] >= a->n) SETERRQ(1,0,"Column too large");
162 #endif
163       col = in[l] - shift;
164       if (roworiented) {
165         value = *v++;
166       }
167       else {
168         value = v[k + l*m];
169       }
170       if (!sorted) low = 0; high = nrow;
171       while (high-low > 5) {
172         t = (low+high)/2;
173         if (rp[t] > col) high = t;
174         else             low  = t;
175       }
176       for ( i=low; i<high; i++ ) {
177         if (rp[i] > col) break;
178         if (rp[i] == col) {
179           if (is == ADD_VALUES) ap[i] += value;
180           else                  ap[i] = value;
181           goto noinsert;
182         }
183       }
184       if (nonew == 1) goto noinsert;
185       else if (nonew == -1) SETERRQ(1,0,"Inserting a new nonzero in the matrix");
186       if (nrow >= rmax) {
187         /* there is no extra room in row, therefore enlarge */
188         int    new_nz = ai[a->m] + CHUNKSIZE,len,*new_i,*new_j;
189         Scalar *new_a;
190 
191         if (nonew == -2) SETERRQ(1,0,"Inserting a new nonzero in the matrix");
192 
193         /* malloc new storage space */
194         len     = new_nz*(sizeof(int)+sizeof(Scalar))+(a->m+1)*sizeof(int);
195         new_a   = (Scalar *) PetscMalloc( len ); CHKPTRQ(new_a);
196         new_j   = (int *) (new_a + new_nz);
197         new_i   = new_j + new_nz;
198 
199         /* copy over old data into new slots */
200         for ( ii=0; ii<row+1; ii++ ) {new_i[ii] = ai[ii];}
201         for ( ii=row+1; ii<a->m+1; ii++ ) {new_i[ii] = ai[ii]+CHUNKSIZE;}
202         PetscMemcpy(new_j,aj,(ai[row]+nrow+shift)*sizeof(int));
203         len = (new_nz - CHUNKSIZE - ai[row] - nrow - shift);
204         PetscMemcpy(new_j+ai[row]+shift+nrow+CHUNKSIZE,aj+ai[row]+shift+nrow,
205                                                            len*sizeof(int));
206         PetscMemcpy(new_a,aa,(ai[row]+nrow+shift)*sizeof(Scalar));
207         PetscMemcpy(new_a+ai[row]+shift+nrow+CHUNKSIZE,aa+ai[row]+shift+nrow,
208                                                            len*sizeof(Scalar));
209         /* free up old matrix storage */
210         PetscFree(a->a);
211         if (!a->singlemalloc) {PetscFree(a->i);PetscFree(a->j);}
212         aa = a->a = new_a; ai = a->i = new_i; aj = a->j = new_j;
213         a->singlemalloc = 1;
214 
215         rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
216         rmax = imax[row] = imax[row] + CHUNKSIZE;
217         PLogObjectMemory(A,CHUNKSIZE*(sizeof(int) + sizeof(Scalar)));
218         a->maxnz += CHUNKSIZE;
219         a->reallocs++;
220       }
221       N = nrow++ - 1; a->nz++;
222       /* shift up all the later entries in this row */
223       for ( ii=N; ii>=i; ii-- ) {
224         rp[ii+1] = rp[ii];
225         ap[ii+1] = ap[ii];
226       }
227       rp[i] = col;
228       ap[i] = value;
229       noinsert:;
230       low = i + 1;
231     }
232     ailen[row] = nrow;
233   }
234   return 0;
235 }
236 
237 #undef __FUNC__
238 #define __FUNC__ "MatGetValues_SeqAIJ"
239 int MatGetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v)
240 {
241   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
242   int        *rp, k, low, high, t, row, nrow, i, col, l, *aj = a->j;
243   int        *ai = a->i, *ailen = a->ilen, shift = a->indexshift;
244   Scalar     *ap, *aa = a->a, zero = 0.0;
245 
246   for ( k=0; k<m; k++ ) { /* loop over rows */
247     row  = im[k];
248     if (row < 0) SETERRQ(1,0,"Negative row");
249     if (row >= a->m) SETERRQ(1,0,"Row too large");
250     rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
251     nrow = ailen[row];
252     for ( l=0; l<n; l++ ) { /* loop over columns */
253       if (in[l] < 0) SETERRQ(1,0,"Negative column");
254       if (in[l] >= a->n) SETERRQ(1,0,"Column too large");
255       col = in[l] - shift;
256       high = nrow; low = 0; /* assume unsorted */
257       while (high-low > 5) {
258         t = (low+high)/2;
259         if (rp[t] > col) high = t;
260         else             low  = t;
261       }
262       for ( i=low; i<high; i++ ) {
263         if (rp[i] > col) break;
264         if (rp[i] == col) {
265           *v++ = ap[i];
266           goto finished;
267         }
268       }
269       *v++ = zero;
270       finished:;
271     }
272   }
273   return 0;
274 }
275 
276 
277 #undef __FUNC__
278 #define __FUNC__ "MatView_SeqAIJ_Binary"
279 extern int MatView_SeqAIJ_Binary(Mat A,Viewer viewer)
280 {
281   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
282   int        i, fd, *col_lens, ierr;
283 
284   ierr = ViewerBinaryGetDescriptor(viewer,&fd); CHKERRQ(ierr);
285   col_lens = (int *) PetscMalloc( (4+a->m)*sizeof(int) ); CHKPTRQ(col_lens);
286   col_lens[0] = MAT_COOKIE;
287   col_lens[1] = a->m;
288   col_lens[2] = a->n;
289   col_lens[3] = a->nz;
290 
291   /* store lengths of each row and write (including header) to file */
292   for ( i=0; i<a->m; i++ ) {
293     col_lens[4+i] = a->i[i+1] - a->i[i];
294   }
295   ierr = PetscBinaryWrite(fd,col_lens,4+a->m,BINARY_INT,1); CHKERRQ(ierr);
296   PetscFree(col_lens);
297 
298   /* store column indices (zero start index) */
299   if (a->indexshift) {
300     for ( i=0; i<a->nz; i++ ) a->j[i]--;
301   }
302   ierr = PetscBinaryWrite(fd,a->j,a->nz,BINARY_INT,0); CHKERRQ(ierr);
303   if (a->indexshift) {
304     for ( i=0; i<a->nz; i++ ) a->j[i]++;
305   }
306 
307   /* store nonzero values */
308   ierr = PetscBinaryWrite(fd,a->a,a->nz,BINARY_SCALAR,0); CHKERRQ(ierr);
309   return 0;
310 }
311 
312 #undef __FUNC__
313 #define __FUNC__ "MatView_SeqAIJ_ASCII"
314 extern int MatView_SeqAIJ_ASCII(Mat A,Viewer viewer)
315 {
316   Mat_SeqAIJ  *a = (Mat_SeqAIJ *) A->data;
317   int         ierr, i,j, m = a->m, shift = a->indexshift, format, flg1,flg2;
318   FILE        *fd;
319   char        *outputname;
320 
321   ierr = ViewerASCIIGetPointer(viewer,&fd); CHKERRQ(ierr);
322   ierr = ViewerFileGetOutputname_Private(viewer,&outputname); CHKERRQ(ierr);
323   ierr = ViewerGetFormat(viewer,&format);
324   if (format == VIEWER_FORMAT_ASCII_INFO) {
325     return 0;
326   }
327   else if (format == VIEWER_FORMAT_ASCII_INFO_LONG) {
328     ierr = OptionsHasName(PETSC_NULL,"-mat_aij_no_inode",&flg1); CHKERRQ(ierr);
329     ierr = OptionsHasName(PETSC_NULL,"-mat_no_unroll",&flg2); CHKERRQ(ierr);
330     if (flg1 || flg2) fprintf(fd,"  not using I-node routines\n");
331     else     fprintf(fd,"  using I-node routines: found %d nodes, limit used is %d\n",
332         a->inode.node_count,a->inode.limit);
333   }
334   else if (format == VIEWER_FORMAT_ASCII_MATLAB) {
335     fprintf(fd,"%% Size = %d %d \n",m,a->n);
336     fprintf(fd,"%% Nonzeros = %d \n",a->nz);
337     fprintf(fd,"zzz = zeros(%d,3);\n",a->nz);
338     fprintf(fd,"zzz = [\n");
339 
340     for (i=0; i<m; i++) {
341       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
342 #if defined(PETSC_COMPLEX)
343         fprintf(fd,"%d %d  %18.16e + %18.16e i \n",i+1,a->j[j]+!shift,real(a->a[j]),
344                    imag(a->a[j]));
345 #else
346         fprintf(fd,"%d %d  %18.16e\n", i+1, a->j[j]+!shift, a->a[j]);
347 #endif
348       }
349     }
350     fprintf(fd,"];\n %s = spconvert(zzz);\n",outputname);
351   }
352   else if (format == VIEWER_FORMAT_ASCII_COMMON) {
353     for ( i=0; i<m; i++ ) {
354       fprintf(fd,"row %d:",i);
355       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
356 #if defined(PETSC_COMPLEX)
357         if (imag(a->a[j]) > 0.0 && real(a->a[j]) != 0.0)
358           fprintf(fd," %d %g + %g i",a->j[j]+shift,real(a->a[j]),imag(a->a[j]));
359         else if (imag(a->a[j]) < 0.0 && real(a->a[j]) != 0.0)
360           fprintf(fd," %d %g - %g i",a->j[j]+shift,real(a->a[j]),-imag(a->a[j]));
361         else if (real(a->a[j]) != 0.0)
362           fprintf(fd," %d %g ",a->j[j]+shift,real(a->a[j]));
363 #else
364         if (a->a[j] != 0.0) fprintf(fd," %d %g ",a->j[j]+shift,a->a[j]);
365 #endif
366       }
367       fprintf(fd,"\n");
368     }
369   }
370   else if (format == VIEWER_FORMAT_ASCII_SYMMODU) {
371     int nzd=0, fshift=1, *sptr;
372     sptr = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(sptr);
373     for ( i=0; i<m; i++ ) {
374       sptr[i] = nzd+1;
375       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
376         if (a->j[j] >= i) {
377 #if defined(PETSC_COMPLEX)
378           if (imag(a->a[j]) != 0.0 || real(a->a[j]) != 0.0) nzd++;
379 #else
380           if (a->a[j] != 0.0) nzd++;
381 #endif
382         }
383       }
384     }
385     sptr[m] = nzd+1;
386     fprintf(fd," %d %d\n\n",m,nzd);
387     for ( i=0; i<m+1; i+=6 ) {
388       if (i+4<m) fprintf(fd," %d %d %d %d %d %d\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3],sptr[i+4],sptr[i+5]);
389       else if (i+3<m) fprintf(fd," %d %d %d %d %d\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3],sptr[i+4]);
390       else if (i+2<m) fprintf(fd," %d %d %d %d\n",sptr[i],sptr[i+1],sptr[i+2],sptr[i+3]);
391       else if (i+1<m) fprintf(fd," %d %d %d\n",sptr[i],sptr[i+1],sptr[i+2]);
392       else if (i<m)   fprintf(fd," %d %d\n",sptr[i],sptr[i+1]);
393       else            fprintf(fd," %d\n",sptr[i]);
394     }
395     fprintf(fd,"\n");
396     PetscFree(sptr);
397     for ( i=0; i<m; i++ ) {
398       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
399         if (a->j[j] >= i) fprintf(fd," %d ",a->j[j]+fshift);
400       }
401       fprintf(fd,"\n");
402     }
403     fprintf(fd,"\n");
404     for ( i=0; i<m; i++ ) {
405       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
406         if (a->j[j] >= i) {
407 #if defined(PETSC_COMPLEX)
408           if (imag(a->a[j]) != 0.0 || real(a->a[j]) != 0.0)
409             fprintf(fd," %18.16e %18.16e ",real(a->a[j]),imag(a->a[j]));
410 #else
411           if (a->a[j] != 0.0) fprintf(fd," %18.16e ",a->a[j]);
412 #endif
413         }
414       }
415       fprintf(fd,"\n");
416     }
417   }
418   else {
419     for ( i=0; i<m; i++ ) {
420       fprintf(fd,"row %d:",i);
421       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
422 #if defined(PETSC_COMPLEX)
423         if (imag(a->a[j]) > 0.0) {
424           fprintf(fd," %d %g + %g i",a->j[j]+shift,real(a->a[j]),imag(a->a[j]));
425         } else if (imag(a->a[j]) < 0.0) {
426           fprintf(fd," %d %g - %g i",a->j[j]+shift,real(a->a[j]),-imag(a->a[j]));
427         }
428         else {
429           fprintf(fd," %d %g ",a->j[j]+shift,real(a->a[j]));
430         }
431 #else
432         fprintf(fd," %d %g ",a->j[j]+shift,a->a[j]);
433 #endif
434       }
435       fprintf(fd,"\n");
436     }
437   }
438   fflush(fd);
439   return 0;
440 }
441 
442 #undef __FUNC__
443 #define __FUNC__ "MatView_SeqAIJ_Draw"
444 extern int MatView_SeqAIJ_Draw(Mat A,Viewer viewer)
445 {
446   Mat_SeqAIJ  *a = (Mat_SeqAIJ *) A->data;
447   int         ierr, i,j, m = a->m, shift = a->indexshift,pause,color;
448   int         format;
449   double      xl,yl,xr,yr,w,h,xc,yc,scale = 1.0,x_l,x_r,y_l,y_r,maxv = 0.0;
450   Draw        draw;
451   DrawButton  button;
452   PetscTruth  isnull;
453 
454   ierr = ViewerDrawGetDraw(viewer,&draw); CHKERRQ(ierr);
455   ierr = DrawClear(draw); CHKERRQ(ierr);
456   ierr = ViewerGetFormat(viewer,&format); CHKERRQ(ierr);
457   ierr = DrawIsNull(draw,&isnull); CHKERRQ(ierr); if (isnull) return 0;
458 
459   xr  = a->n; yr = a->m; h = yr/10.0; w = xr/10.0;
460   xr += w;    yr += h;  xl = -w;     yl = -h;
461   ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr);
462   /* loop over matrix elements drawing boxes */
463 
464   if (format != VIEWER_FORMAT_DRAW_CONTOUR) {
465     /* Blue for negative, Cyan for zero and  Red for positive */
466     color = DRAW_BLUE;
467     for ( i=0; i<m; i++ ) {
468       y_l = m - i - 1.0; y_r = y_l + 1.0;
469       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
470         x_l = a->j[j] + shift; x_r = x_l + 1.0;
471 #if defined(PETSC_COMPLEX)
472         if (real(a->a[j]) >=  0.) continue;
473 #else
474         if (a->a[j] >=  0.) continue;
475 #endif
476         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
477       }
478     }
479     color = DRAW_CYAN;
480     for ( i=0; i<m; i++ ) {
481       y_l = m - i - 1.0; y_r = y_l + 1.0;
482       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
483         x_l = a->j[j] + shift; x_r = x_l + 1.0;
484         if (a->a[j] !=  0.) continue;
485         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
486       }
487     }
488     color = DRAW_RED;
489     for ( i=0; i<m; i++ ) {
490       y_l = m - i - 1.0; y_r = y_l + 1.0;
491       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
492         x_l = a->j[j] + shift; x_r = x_l + 1.0;
493 #if defined(PETSC_COMPLEX)
494         if (real(a->a[j]) <=  0.) continue;
495 #else
496         if (a->a[j] <=  0.) continue;
497 #endif
498         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
499       }
500     }
501   } else {
502     /* use contour shading to indicate magnitude of values */
503     /* first determine max of all nonzero values */
504     int    nz = a->nz,count;
505     Draw   popup;
506 
507     for ( i=0; i<nz; i++ ) {
508       if (PetscAbsScalar(a->a[i]) > maxv) maxv = PetscAbsScalar(a->a[i]);
509     }
510     ierr = DrawCreatePopUp(draw,&popup); CHKERRQ(ierr);
511     ierr = DrawScalePopup(popup,0.0,maxv); CHKERRQ(ierr);
512     count = 0;
513     for ( i=0; i<m; i++ ) {
514       y_l = m - i - 1.0; y_r = y_l + 1.0;
515       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
516         x_l = a->j[j] + shift; x_r = x_l + 1.0;
517         color = 32 + (int) ((200.0 - 32.0)*PetscAbsScalar(a->a[count])/maxv);
518         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
519         count++;
520       }
521     }
522   }
523   DrawFlush(draw);
524   DrawGetPause(draw,&pause);
525   if (pause >= 0) { PetscSleep(pause); return 0;}
526 
527   /* allow the matrix to zoom or shrink */
528   ierr = DrawCheckResizedWindow(draw);
529   ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0);
530   while (button != BUTTON_RIGHT) {
531     DrawClear(draw);
532     if (button == BUTTON_LEFT) scale = .5;
533     else if (button == BUTTON_CENTER) scale = 2.;
534     xl = scale*(xl + w - xc) + xc - w*scale;
535     xr = scale*(xr - w - xc) + xc + w*scale;
536     yl = scale*(yl + h - yc) + yc - h*scale;
537     yr = scale*(yr - h - yc) + yc + h*scale;
538     w *= scale; h *= scale;
539     ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr);
540     if (format != VIEWER_FORMAT_DRAW_CONTOUR) {
541       /* Blue for negative, Cyan for zero and  Red for positive */
542       color = DRAW_BLUE;
543       for ( i=0; i<m; i++ ) {
544         y_l = m - i - 1.0; y_r = y_l + 1.0;
545         for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
546           x_l = a->j[j] + shift; x_r = x_l + 1.0;
547 #if defined(PETSC_COMPLEX)
548           if (real(a->a[j]) >=  0.) continue;
549 #else
550           if (a->a[j] >=  0.) continue;
551 #endif
552           DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
553         }
554       }
555       color = DRAW_CYAN;
556       for ( i=0; i<m; i++ ) {
557         y_l = m - i - 1.0; y_r = y_l + 1.0;
558         for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
559           x_l = a->j[j] + shift; x_r = x_l + 1.0;
560           if (a->a[j] !=  0.) continue;
561           DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
562         }
563       }
564       color = DRAW_RED;
565       for ( i=0; i<m; i++ ) {
566         y_l = m - i - 1.0; y_r = y_l + 1.0;
567         for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
568           x_l = a->j[j] + shift; x_r = x_l + 1.0;
569 #if defined(PETSC_COMPLEX)
570           if (real(a->a[j]) <=  0.) continue;
571 #else
572           if (a->a[j] <=  0.) continue;
573 #endif
574           DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
575         }
576       }
577     } else {
578       /* use contour shading to indicate magnitude of values */
579       int count = 0;
580       for ( i=0; i<m; i++ ) {
581         y_l = m - i - 1.0; y_r = y_l + 1.0;
582         for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
583           x_l = a->j[j] + shift; x_r = x_l + 1.0;
584           color = 32 + (int) ((200.0 - 32.0)*PetscAbsScalar(a->a[count])/maxv);
585           DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
586           count++;
587         }
588       }
589     }
590 
591     ierr = DrawCheckResizedWindow(draw);
592     ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0);
593   }
594   return 0;
595 }
596 
597 #undef __FUNC__
598 #define __FUNC__ "MatView_SeqAIJ" /* ADIC Ignore */
599 int MatView_SeqAIJ(PetscObject obj,Viewer viewer)
600 {
601   Mat         A = (Mat) obj;
602   Mat_SeqAIJ  *a = (Mat_SeqAIJ*) A->data;
603   ViewerType  vtype;
604   int         ierr;
605 
606   ierr = ViewerGetType(viewer,&vtype); CHKERRQ(ierr);
607   if (vtype == MATLAB_VIEWER) {
608     return ViewerMatlabPutSparse_Private(viewer,a->m,a->n,a->nz,a->a,a->i,a->j);
609   }
610   else if (vtype == ASCII_FILE_VIEWER || vtype == ASCII_FILES_VIEWER){
611     return MatView_SeqAIJ_ASCII(A,viewer);
612   }
613   else if (vtype == BINARY_FILE_VIEWER) {
614     return MatView_SeqAIJ_Binary(A,viewer);
615   }
616   else if (vtype == DRAW_VIEWER) {
617     return MatView_SeqAIJ_Draw(A,viewer);
618   }
619   return 0;
620 }
621 
622 extern int Mat_AIJ_CheckInode(Mat);
623 #undef __FUNC__
624 #define __FUNC__ "MatAssemblyEnd_SeqAIJ"
625 int MatAssemblyEnd_SeqAIJ(Mat A,MatAssemblyType mode)
626 {
627   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
628   int        fshift = 0,i,j,*ai = a->i, *aj = a->j, *imax = a->imax,ierr;
629   int        m = a->m, *ip, N, *ailen = a->ilen,shift = a->indexshift,rmax;
630   Scalar     *aa = a->a, *ap;
631 
632   if (mode == MAT_FLUSH_ASSEMBLY) return 0;
633 
634   rmax = ailen[0]; /* determine row with most nonzeros */
635   for ( i=1; i<m; i++ ) {
636     /* move each row back by the amount of empty slots (fshift) before it*/
637     fshift += imax[i-1] - ailen[i-1];
638     rmax   = PetscMax(rmax,ailen[i]);
639     if (fshift) {
640       ip = aj + ai[i] + shift; ap = aa + ai[i] + shift;
641       N = ailen[i];
642       for ( j=0; j<N; j++ ) {
643         ip[j-fshift] = ip[j];
644         ap[j-fshift] = ap[j];
645       }
646     }
647     ai[i] = ai[i-1] + ailen[i-1];
648   }
649   if (m) {
650     fshift += imax[m-1] - ailen[m-1];
651     ai[m] = ai[m-1] + ailen[m-1];
652   }
653   /* reset ilen and imax for each row */
654   for ( i=0; i<m; i++ ) {
655     ailen[i] = imax[i] = ai[i+1] - ai[i];
656   }
657   a->nz = ai[m] + shift;
658 
659   /* diagonals may have moved, so kill the diagonal pointers */
660   if (fshift && a->diag) {
661     PetscFree(a->diag);
662     PLogObjectMemory(A,-(m+1)*sizeof(int));
663     a->diag = 0;
664   }
665   PLogInfo(A,"MatAssemblyEnd_SeqAIJ:Matrix size: %d X %d; storage space: %d unneeded, %d used\n",
666            m,a->n,fshift,a->nz);
667   PLogInfo(A,"MatAssemblyEnd_SeqAIJ:Number of mallocs during MatSetValues is %d\n",
668            a->reallocs);
669   PLogInfo(A,"MatAssemblyEnd_SeqAIJ:Most nonzeros in any row is %d\n",rmax);
670   a->reallocs          = 0;
671   A->info.nz_unneeded  = (double)fshift;
672 
673   /* check out for identical nodes. If found, use inode functions */
674   ierr = Mat_AIJ_CheckInode(A); CHKERRQ(ierr);
675   return 0;
676 }
677 
678 #undef __FUNC__
679 #define __FUNC__ "MatZeroEntries_SeqAIJ"
680 int MatZeroEntries_SeqAIJ(Mat A)
681 {
682   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
683   PetscMemzero(a->a,(a->i[a->m]+a->indexshift)*sizeof(Scalar));
684   return 0;
685 }
686 
687 #undef __FUNC__
688 #define __FUNC__ "MatDestroy_SeqAIJ"
689 int MatDestroy_SeqAIJ(PetscObject obj)
690 {
691   Mat        A  = (Mat) obj;
692   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
693 
694 #if defined(PETSC_LOG)
695   PLogObjectState(obj,"Rows=%d, Cols=%d, NZ=%d",a->m,a->n,a->nz);
696 #endif
697   PetscFree(a->a);
698   if (!a->singlemalloc) { PetscFree(a->i); PetscFree(a->j);}
699   if (a->diag) PetscFree(a->diag);
700   if (a->ilen) PetscFree(a->ilen);
701   if (a->imax) PetscFree(a->imax);
702   if (a->solve_work) PetscFree(a->solve_work);
703   if (a->inode.size) PetscFree(a->inode.size);
704   PetscFree(a);
705 
706   PLogObjectDestroy(A);
707   PetscHeaderDestroy(A);
708   return 0;
709 }
710 
711 #undef __FUNC__
712 #define __FUNC__ "MatCompress_SeqAIJ"
713 int MatCompress_SeqAIJ(Mat A)
714 {
715   return 0;
716 }
717 
718 #undef __FUNC__
719 #define __FUNC__ "MatSetOption_SeqAIJ"
720 int MatSetOption_SeqAIJ(Mat A,MatOption op)
721 {
722   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
723   if      (op == MAT_ROW_ORIENTED)                 a->roworiented = 1;
724   else if (op == MAT_COLUMN_ORIENTED)              a->roworiented = 0;
725   else if (op == MAT_COLUMNS_SORTED)               a->sorted      = 1;
726   else if (op == MAT_COLUMNS_UNSORTED)             a->sorted      = 0;
727   else if (op == MAT_NO_NEW_NONZERO_LOCATIONS)     a->nonew       = 1;
728   else if (op == MAT_NEW_NONZERO_LOCATION_ERROR)   a->nonew       = -1;
729   else if (op == MAT_NEW_NONZERO_ALLOCATION_ERROR) a->nonew       = -2;
730   else if (op == MAT_YES_NEW_NONZERO_LOCATIONS)    a->nonew       = 0;
731   else if (op == MAT_ROWS_SORTED ||
732            op == MAT_ROWS_UNSORTED ||
733            op == MAT_SYMMETRIC ||
734            op == MAT_STRUCTURALLY_SYMMETRIC ||
735            op == MAT_YES_NEW_DIAGONALS ||
736            op == MAT_IGNORE_OFF_PROC_ENTRIES)
737     PLogInfo(A,"Info:MatSetOption_SeqAIJ:Option ignored\n");
738   else if (op == MAT_NO_NEW_DIAGONALS)
739     {SETERRQ(PETSC_ERR_SUP,0,"MAT_NO_NEW_DIAGONALS");}
740   else if (op == MAT_INODE_LIMIT_1)            a->inode.limit  = 1;
741   else if (op == MAT_INODE_LIMIT_2)            a->inode.limit  = 2;
742   else if (op == MAT_INODE_LIMIT_3)            a->inode.limit  = 3;
743   else if (op == MAT_INODE_LIMIT_4)            a->inode.limit  = 4;
744   else if (op == MAT_INODE_LIMIT_5)            a->inode.limit  = 5;
745   else
746     {SETERRQ(PETSC_ERR_SUP,0,"unknown option");}
747   return 0;
748 }
749 
750 #undef __FUNC__
751 #define __FUNC__ "MatGetDiagonal_SeqAIJ"
752 int MatGetDiagonal_SeqAIJ(Mat A,Vec v)
753 {
754   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
755   int        i,j, n,shift = a->indexshift;
756   Scalar     *x, zero = 0.0;
757 
758   VecSet(&zero,v);
759   VecGetArray_Fast(v,x); VecGetLocalSize(v,&n);
760   if (n != a->m) SETERRQ(1,0,"Nonconforming matrix and vector");
761   for ( i=0; i<a->m; i++ ) {
762     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
763       if (a->j[j]+shift == i) {
764         x[i] = a->a[j];
765         break;
766       }
767     }
768   }
769   return 0;
770 }
771 
772 /* -------------------------------------------------------*/
773 /* Should check that shapes of vectors and matrices match */
774 /* -------------------------------------------------------*/
775 #undef __FUNC__
776 #define __FUNC__ "MatMultTrans_SeqAIJ"
777 int MatMultTrans_SeqAIJ(Mat A,Vec xx,Vec yy)
778 {
779   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
780   Scalar     *x, *y, *v, alpha;
781   int        m = a->m, n, i, *idx, shift = a->indexshift;
782 
783   VecGetArray_Fast(xx,x); VecGetArray_Fast(yy,y);
784   PetscMemzero(y,a->n*sizeof(Scalar));
785   y = y + shift; /* shift for Fortran start by 1 indexing */
786   for ( i=0; i<m; i++ ) {
787     idx   = a->j + a->i[i] + shift;
788     v     = a->a + a->i[i] + shift;
789     n     = a->i[i+1] - a->i[i];
790     alpha = x[i];
791     while (n-->0) {y[*idx++] += alpha * *v++;}
792   }
793   PLogFlops(2*a->nz - a->n);
794   return 0;
795 }
796 
797 #undef __FUNC__
798 #define __FUNC__ "MatMultTransAdd_SeqAIJ"
799 int MatMultTransAdd_SeqAIJ(Mat A,Vec xx,Vec zz,Vec yy)
800 {
801   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
802   Scalar     *x, *y, *v, alpha;
803   int        m = a->m, n, i, *idx,shift = a->indexshift;
804 
805   VecGetArray_Fast(xx,x); VecGetArray_Fast(yy,y);
806   if (zz != yy) VecCopy(zz,yy);
807   y = y + shift; /* shift for Fortran start by 1 indexing */
808   for ( i=0; i<m; i++ ) {
809     idx   = a->j + a->i[i] + shift;
810     v     = a->a + a->i[i] + shift;
811     n     = a->i[i+1] - a->i[i];
812     alpha = x[i];
813     while (n-->0) {y[*idx++] += alpha * *v++;}
814   }
815   PLogFlops(2*a->nz);
816   return 0;
817 }
818 
819 #undef __FUNC__
820 #define __FUNC__ "MatMult_SeqAIJ"
821 int MatMult_SeqAIJ(Mat A,Vec xx,Vec yy)
822 {
823   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
824   Scalar     *x, *y, *v, sum;
825   int        m = a->m, n, i, *idx, shift = a->indexshift,*ii,jrow,j;
826 
827   VecGetArray_Fast(xx,x); VecGetArray_Fast(yy,y);
828   x    = x + shift; /* shift for Fortran start by 1 indexing */
829   idx  = a->j;
830   v    = a->a;
831   ii   = a->i;
832   for ( i=0; i<m; i++ ) {
833     jrow = ii[i];
834     n    = ii[i+1] - jrow;
835     sum  = 0.0;
836     /* while (n--) sum += *v++ * x[*idx++]; */
837     for ( j=0; j<n; j++) {
838       sum += v[jrow]*x[idx[jrow]]; jrow++;
839      }
840     y[i] = sum;
841   }
842   PLogFlops(2*a->nz - m);
843   return 0;
844 }
845 
846 #undef __FUNC__
847 #define __FUNC__ "MatMultAdd_SeqAIJ"
848 int MatMultAdd_SeqAIJ(Mat A,Vec xx,Vec yy,Vec zz)
849 {
850   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
851   Scalar     *x, *y, *z, *v, sum;
852   int        m = a->m, n, i, *idx, shift = a->indexshift,*ii,jrow,j;
853 
854 
855   VecGetArray_Fast(xx,x); VecGetArray_Fast(yy,y); VecGetArray_Fast(zz,z);
856   x    = x + shift; /* shift for Fortran start by 1 indexing */
857   idx  = a->j;
858   v    = a->a;
859   ii   = a->i;
860   for ( i=0; i<m; i++ ) {
861     jrow = ii[i];
862     n    = ii[i+1] - jrow;
863     sum  = y[i];
864     /* while (n--) sum += *v++ * x[*idx++]; */
865     for ( j=0; j<n; j++) {
866       sum += v[jrow]*x[idx[jrow]]; jrow++;
867      }
868     z[i] = sum;
869   }
870   PLogFlops(2*a->nz);
871   return 0;
872 }
873 
874 /*
875      Adds diagonal pointers to sparse matrix structure.
876 */
877 
878 #undef __FUNC__
879 #define __FUNC__ "MatMarkDiag_SeqAIJ"
880 int MatMarkDiag_SeqAIJ(Mat A)
881 {
882   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
883   int        i,j, *diag, m = a->m,shift = a->indexshift;
884 
885   diag = (int *) PetscMalloc( (m+1)*sizeof(int)); CHKPTRQ(diag);
886   PLogObjectMemory(A,(m+1)*sizeof(int));
887   for ( i=0; i<a->m; i++ ) {
888     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
889       if (a->j[j]+shift == i) {
890         diag[i] = j - shift;
891         break;
892       }
893     }
894   }
895   a->diag = diag;
896   return 0;
897 }
898 
899 #undef __FUNC__
900 #define __FUNC__ "MatRelax_SeqAIJ"
901 int MatRelax_SeqAIJ(Mat A,Vec bb,double omega,MatSORType flag,
902                            double fshift,int its,Vec xx)
903 {
904   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
905   Scalar     *x, *b, *bs,  d, *xs, sum, *v = a->a,*t,scale,*ts, *xb;
906   int        ierr, *idx, *diag,n = a->n, m = a->m, i, shift = a->indexshift;
907 
908   VecGetArray_Fast(xx,x); VecGetArray_Fast(bb,b);
909   if (!a->diag) {if ((ierr = MatMarkDiag_SeqAIJ(A))) return ierr;}
910   diag = a->diag;
911   xs   = x + shift; /* shifted by one for index start of a or a->j*/
912   if (flag == SOR_APPLY_UPPER) {
913    /* apply ( U + D/omega) to the vector */
914     bs = b + shift;
915     for ( i=0; i<m; i++ ) {
916         d    = fshift + a->a[diag[i] + shift];
917         n    = a->i[i+1] - diag[i] - 1;
918         idx  = a->j + diag[i] + (!shift);
919         v    = a->a + diag[i] + (!shift);
920         sum  = b[i]*d/omega;
921         SPARSEDENSEDOT(sum,bs,v,idx,n);
922         x[i] = sum;
923     }
924     return 0;
925   }
926   if (flag == SOR_APPLY_LOWER) {
927     SETERRQ(1,0,"SOR_APPLY_LOWER is not done");
928   }
929   else if (flag & SOR_EISENSTAT) {
930     /* Let  A = L + U + D; where L is lower trianglar,
931     U is upper triangular, E is diagonal; This routine applies
932 
933             (L + E)^{-1} A (U + E)^{-1}
934 
935     to a vector efficiently using Eisenstat's trick. This is for
936     the case of SSOR preconditioner, so E is D/omega where omega
937     is the relaxation factor.
938     */
939     t = (Scalar *) PetscMalloc( m*sizeof(Scalar) ); CHKPTRQ(t);
940     scale = (2.0/omega) - 1.0;
941 
942     /*  x = (E + U)^{-1} b */
943     for ( i=m-1; i>=0; i-- ) {
944       d    = fshift + a->a[diag[i] + shift];
945       n    = a->i[i+1] - diag[i] - 1;
946       idx  = a->j + diag[i] + (!shift);
947       v    = a->a + diag[i] + (!shift);
948       sum  = b[i];
949       SPARSEDENSEMDOT(sum,xs,v,idx,n);
950       x[i] = omega*(sum/d);
951     }
952 
953     /*  t = b - (2*E - D)x */
954     v = a->a;
955     for ( i=0; i<m; i++ ) { t[i] = b[i] - scale*(v[*diag++ + shift])*x[i]; }
956 
957     /*  t = (E + L)^{-1}t */
958     ts = t + shift; /* shifted by one for index start of a or a->j*/
959     diag = a->diag;
960     for ( i=0; i<m; i++ ) {
961       d    = fshift + a->a[diag[i]+shift];
962       n    = diag[i] - a->i[i];
963       idx  = a->j + a->i[i] + shift;
964       v    = a->a + a->i[i] + shift;
965       sum  = t[i];
966       SPARSEDENSEMDOT(sum,ts,v,idx,n);
967       t[i] = omega*(sum/d);
968     }
969 
970     /*  x = x + t */
971     for ( i=0; i<m; i++ ) { x[i] += t[i]; }
972     PetscFree(t);
973     return 0;
974   }
975   if (flag & SOR_ZERO_INITIAL_GUESS) {
976     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
977       for ( i=0; i<m; i++ ) {
978         d    = fshift + a->a[diag[i]+shift];
979         n    = diag[i] - a->i[i];
980         idx  = a->j + a->i[i] + shift;
981         v    = a->a + a->i[i] + shift;
982         sum  = b[i];
983         SPARSEDENSEMDOT(sum,xs,v,idx,n);
984         x[i] = omega*(sum/d);
985       }
986       xb = x;
987     }
988     else xb = b;
989     if ((flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) &&
990         (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP)) {
991       for ( i=0; i<m; i++ ) {
992         x[i] *= a->a[diag[i]+shift];
993       }
994     }
995     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
996       for ( i=m-1; i>=0; i-- ) {
997         d    = fshift + a->a[diag[i] + shift];
998         n    = a->i[i+1] - diag[i] - 1;
999         idx  = a->j + diag[i] + (!shift);
1000         v    = a->a + diag[i] + (!shift);
1001         sum  = xb[i];
1002         SPARSEDENSEMDOT(sum,xs,v,idx,n);
1003         x[i] = omega*(sum/d);
1004       }
1005     }
1006     its--;
1007   }
1008   while (its--) {
1009     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
1010       for ( i=0; i<m; i++ ) {
1011         d    = fshift + a->a[diag[i]+shift];
1012         n    = a->i[i+1] - a->i[i];
1013         idx  = a->j + a->i[i] + shift;
1014         v    = a->a + a->i[i] + shift;
1015         sum  = b[i];
1016         SPARSEDENSEMDOT(sum,xs,v,idx,n);
1017         x[i] = (1. - omega)*x[i] + omega*(sum + a->a[diag[i]+shift]*x[i])/d;
1018       }
1019     }
1020     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
1021       for ( i=m-1; i>=0; i-- ) {
1022         d    = fshift + a->a[diag[i] + shift];
1023         n    = a->i[i+1] - a->i[i];
1024         idx  = a->j + a->i[i] + shift;
1025         v    = a->a + a->i[i] + shift;
1026         sum  = b[i];
1027         SPARSEDENSEMDOT(sum,xs,v,idx,n);
1028         x[i] = (1. - omega)*x[i] + omega*(sum + a->a[diag[i]+shift]*x[i])/d;
1029       }
1030     }
1031   }
1032   return 0;
1033 }
1034 
1035 #undef __FUNC__
1036 #define __FUNC__ "MatGetInfo_SeqAIJ"
1037 int MatGetInfo_SeqAIJ(Mat A,MatInfoType flag,MatInfo *info)
1038 {
1039   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1040 
1041   info->rows_global    = (double)a->m;
1042   info->columns_global = (double)a->n;
1043   info->rows_local     = (double)a->m;
1044   info->columns_local  = (double)a->n;
1045   info->block_size     = 1.0;
1046   info->nz_allocated   = (double)a->maxnz;
1047   info->nz_used        = (double)a->nz;
1048   info->nz_unneeded    = (double)(a->maxnz - a->nz);
1049   /*  if (info->nz_unneeded != A->info.nz_unneeded)
1050     printf("space descrepancy: maxnz-nz = %d, nz_unneeded = %d\n",(int)info->nz_unneeded,(int)A->info.nz_unneeded); */
1051   info->assemblies     = (double)A->num_ass;
1052   info->mallocs        = (double)a->reallocs;
1053   info->memory         = A->mem;
1054   if (A->factor) {
1055     info->fill_ratio_given  = A->info.fill_ratio_given;
1056     info->fill_ratio_needed = A->info.fill_ratio_needed;
1057     info->factor_mallocs    = A->info.factor_mallocs;
1058   } else {
1059     info->fill_ratio_given  = 0;
1060     info->fill_ratio_needed = 0;
1061     info->factor_mallocs    = 0;
1062   }
1063   return 0;
1064 }
1065 
1066 extern int MatLUFactorSymbolic_SeqAIJ(Mat,IS,IS,double,Mat*);
1067 extern int MatLUFactorNumeric_SeqAIJ(Mat,Mat*);
1068 extern int MatLUFactor_SeqAIJ(Mat,IS,IS,double);
1069 extern int MatSolve_SeqAIJ(Mat,Vec,Vec);
1070 extern int MatSolveAdd_SeqAIJ(Mat,Vec,Vec,Vec);
1071 extern int MatSolveTrans_SeqAIJ(Mat,Vec,Vec);
1072 extern int MatSolveTransAdd_SeqAIJ(Mat,Vec,Vec,Vec);
1073 
1074 #undef __FUNC__
1075 #define __FUNC__ "MatZeroRows_SeqAIJ"
1076 int MatZeroRows_SeqAIJ(Mat A,IS is,Scalar *diag)
1077 {
1078   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1079   int         i,ierr,N, *rows,m = a->m - 1,shift = a->indexshift;
1080 
1081   ierr = ISGetSize(is,&N); CHKERRQ(ierr);
1082   ierr = ISGetIndices(is,&rows); CHKERRQ(ierr);
1083   if (diag) {
1084     for ( i=0; i<N; i++ ) {
1085       if (rows[i] < 0 || rows[i] > m) SETERRQ(1,0,"row out of range");
1086       if (a->ilen[rows[i]] > 0) { /* in case row was completely empty */
1087         a->ilen[rows[i]] = 1;
1088         a->a[a->i[rows[i]]+shift] = *diag;
1089         a->j[a->i[rows[i]]+shift] = rows[i]+shift;
1090       }
1091       else {
1092         ierr = MatSetValues_SeqAIJ(A,1,&rows[i],1,&rows[i],diag,INSERT_VALUES);
1093         CHKERRQ(ierr);
1094       }
1095     }
1096   }
1097   else {
1098     for ( i=0; i<N; i++ ) {
1099       if (rows[i] < 0 || rows[i] > m) SETERRQ(1,0,"row out of range");
1100       a->ilen[rows[i]] = 0;
1101     }
1102   }
1103   ISRestoreIndices(is,&rows);
1104   ierr = MatAssemblyEnd_SeqAIJ(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1105   return 0;
1106 }
1107 
1108 #undef __FUNC__
1109 #define __FUNC__ "MatGetSize_SeqAIJ"
1110 int MatGetSize_SeqAIJ(Mat A,int *m,int *n)
1111 {
1112   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1113   *m = a->m; *n = a->n;
1114   return 0;
1115 }
1116 
1117 #undef __FUNC__
1118 #define __FUNC__ "MatGetOwnershipRange_SeqAIJ"
1119 int MatGetOwnershipRange_SeqAIJ(Mat A,int *m,int *n)
1120 {
1121   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1122   *m = 0; *n = a->m;
1123   return 0;
1124 }
1125 
1126 #undef __FUNC__
1127 #define __FUNC__ "MatGetRow_SeqAIJ"
1128 int MatGetRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v)
1129 {
1130   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1131   int        *itmp,i,shift = a->indexshift;
1132 
1133   if (row < 0 || row >= a->m) SETERRQ(1,0,"Row out of range");
1134 
1135   *nz = a->i[row+1] - a->i[row];
1136   if (v) *v = a->a + a->i[row] + shift;
1137   if (idx) {
1138     itmp = a->j + a->i[row] + shift;
1139     if (*nz && shift) {
1140       *idx = (int *) PetscMalloc( (*nz)*sizeof(int) ); CHKPTRQ(*idx);
1141       for ( i=0; i<(*nz); i++ ) {(*idx)[i] = itmp[i] + shift;}
1142     } else if (*nz) {
1143       *idx = itmp;
1144     }
1145     else *idx = 0;
1146   }
1147   return 0;
1148 }
1149 
1150 #undef __FUNC__
1151 #define __FUNC__ "MatRestoreRow_SeqAIJ"
1152 int MatRestoreRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v)
1153 {
1154   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1155   if (idx) {if (*idx && a->indexshift) PetscFree(*idx);}
1156   return 0;
1157 }
1158 
1159 #undef __FUNC__
1160 #define __FUNC__ "MatNorm_SeqAIJ"
1161 int MatNorm_SeqAIJ(Mat A,NormType type,double *norm)
1162 {
1163   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1164   Scalar     *v = a->a;
1165   double     sum = 0.0;
1166   int        i, j,shift = a->indexshift;
1167 
1168   if (type == NORM_FROBENIUS) {
1169     for (i=0; i<a->nz; i++ ) {
1170 #if defined(PETSC_COMPLEX)
1171       sum += real(conj(*v)*(*v)); v++;
1172 #else
1173       sum += (*v)*(*v); v++;
1174 #endif
1175     }
1176     *norm = sqrt(sum);
1177   }
1178   else if (type == NORM_1) {
1179     double *tmp;
1180     int    *jj = a->j;
1181     tmp = (double *) PetscMalloc( (a->n+1)*sizeof(double) ); CHKPTRQ(tmp);
1182     PetscMemzero(tmp,a->n*sizeof(double));
1183     *norm = 0.0;
1184     for ( j=0; j<a->nz; j++ ) {
1185         tmp[*jj++ + shift] += PetscAbsScalar(*v);  v++;
1186     }
1187     for ( j=0; j<a->n; j++ ) {
1188       if (tmp[j] > *norm) *norm = tmp[j];
1189     }
1190     PetscFree(tmp);
1191   }
1192   else if (type == NORM_INFINITY) {
1193     *norm = 0.0;
1194     for ( j=0; j<a->m; j++ ) {
1195       v = a->a + a->i[j] + shift;
1196       sum = 0.0;
1197       for ( i=0; i<a->i[j+1]-a->i[j]; i++ ) {
1198         sum += PetscAbsScalar(*v); v++;
1199       }
1200       if (sum > *norm) *norm = sum;
1201     }
1202   }
1203   else {
1204     SETERRQ(1,0,"No support for two norm yet");
1205   }
1206   return 0;
1207 }
1208 
1209 #undef __FUNC__
1210 #define __FUNC__ "MatTranspose_SeqAIJ"
1211 int MatTranspose_SeqAIJ(Mat A,Mat *B)
1212 {
1213   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1214   Mat        C;
1215   int        i, ierr, *aj = a->j, *ai = a->i, m = a->m, len, *col;
1216   int        shift = a->indexshift;
1217   Scalar     *array = a->a;
1218 
1219   if (B == PETSC_NULL && m != a->n)
1220     SETERRQ(1,0,"Square matrix only for in-place");
1221   col = (int *) PetscMalloc((1+a->n)*sizeof(int)); CHKPTRQ(col);
1222   PetscMemzero(col,(1+a->n)*sizeof(int));
1223   if (shift) {
1224     for ( i=0; i<ai[m]-1; i++ ) aj[i] -= 1;
1225   }
1226   for ( i=0; i<ai[m]+shift; i++ ) col[aj[i]] += 1;
1227   ierr = MatCreateSeqAIJ(A->comm,a->n,m,0,col,&C); CHKERRQ(ierr);
1228   PetscFree(col);
1229   for ( i=0; i<m; i++ ) {
1230     len = ai[i+1]-ai[i];
1231     ierr = MatSetValues(C,len,aj,1,&i,array,INSERT_VALUES); CHKERRQ(ierr);
1232     array += len; aj += len;
1233   }
1234   if (shift) {
1235     for ( i=0; i<ai[m]-1; i++ ) aj[i] += 1;
1236   }
1237 
1238   ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1239   ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1240 
1241   if (B != PETSC_NULL) {
1242     *B = C;
1243   } else {
1244     /* This isn't really an in-place transpose */
1245     PetscFree(a->a);
1246     if (!a->singlemalloc) {PetscFree(a->i); PetscFree(a->j);}
1247     if (a->diag) PetscFree(a->diag);
1248     if (a->ilen) PetscFree(a->ilen);
1249     if (a->imax) PetscFree(a->imax);
1250     if (a->solve_work) PetscFree(a->solve_work);
1251     if (a->inode.size) PetscFree(a->inode.size);
1252     PetscFree(a);
1253     PetscMemcpy(A,C,sizeof(struct _p_Mat));
1254     PetscHeaderDestroy(C);
1255   }
1256   return 0;
1257 }
1258 
1259 #undef __FUNC__
1260 #define __FUNC__ "MatDiagonalScale_SeqAIJ"
1261 int MatDiagonalScale_SeqAIJ(Mat A,Vec ll,Vec rr)
1262 {
1263   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1264   Scalar     *l,*r,x,*v;
1265   int        i,j,m = a->m, n = a->n, M, nz = a->nz, *jj,shift = a->indexshift;
1266 
1267   if (ll) {
1268     /* The local size is used so that VecMPI can be passed to this routine
1269        by MatDiagonalScale_MPIAIJ */
1270     VecGetLocalSize_Fast(ll,m);
1271     if (m != a->m) SETERRQ(1,0,"Left scaling vector wrong length");
1272     VecGetArray_Fast(ll,l);
1273     v = a->a;
1274     for ( i=0; i<m; i++ ) {
1275       x = l[i];
1276       M = a->i[i+1] - a->i[i];
1277       for ( j=0; j<M; j++ ) { (*v++) *= x;}
1278     }
1279     PLogFlops(nz);
1280   }
1281   if (rr) {
1282     VecGetLocalSize_Fast(rr,n);
1283     if (n != a->n) SETERRQ(1,0,"Right scaling vector wrong length");
1284     VecGetArray_Fast(rr,r);
1285     v = a->a; jj = a->j;
1286     for ( i=0; i<nz; i++ ) {
1287       (*v++) *= r[*jj++ + shift];
1288     }
1289     PLogFlops(nz);
1290   }
1291   return 0;
1292 }
1293 
1294 #undef __FUNC__
1295 #define __FUNC__ "MatGetSubMatrix_SeqAIJ"
1296 int MatGetSubMatrix_SeqAIJ(Mat A,IS isrow,IS iscol,MatGetSubMatrixCall scall,Mat *B)
1297 {
1298   Mat_SeqAIJ   *a = (Mat_SeqAIJ *) A->data,*c;
1299   int          nznew, *smap, i, k, kstart, kend, ierr, oldcols = a->n,*lens;
1300   int          row,mat_i,*mat_j,tcol,first,step,*mat_ilen;
1301   register int sum,lensi;
1302   int          *irow, *icol, nrows, ncols, shift = a->indexshift,*ssmap;
1303   int          *starts,*j_new,*i_new,*aj = a->j, *ai = a->i,ii,*ailen = a->ilen;
1304   Scalar       *a_new,*mat_a;
1305   Mat          C;
1306 
1307   ierr = ISSorted(isrow,(PetscTruth*)&i);
1308   if (!i) SETERRQ(1,0,"ISrow is not sorted");
1309   ierr = ISSorted(iscol,(PetscTruth*)&i);
1310   if (!i) SETERRQ(1,0,"IScol is not sorted");
1311 
1312   ierr = ISGetIndices(isrow,&irow); CHKERRQ(ierr);
1313   ierr = ISGetSize(isrow,&nrows); CHKERRQ(ierr);
1314   ierr = ISGetSize(iscol,&ncols); CHKERRQ(ierr);
1315 
1316   if (ISStrideGetInfo(iscol,&first,&step) && step == 1) { /* no need to sort */
1317     /* special case of contiguous rows */
1318     lens   = (int *) PetscMalloc((ncols+nrows+1)*sizeof(int)); CHKPTRQ(lens);
1319     starts = lens + ncols;
1320     /* loop over new rows determining lens and starting points */
1321     for (i=0; i<nrows; i++) {
1322       kstart  = ai[irow[i]]+shift;
1323       kend    = kstart + ailen[irow[i]];
1324       for ( k=kstart; k<kend; k++ ) {
1325         if (aj[k]+shift >= first) {
1326           starts[i] = k;
1327           break;
1328 	}
1329       }
1330       sum = 0;
1331       while (k < kend) {
1332         if (aj[k++]+shift >= first+ncols) break;
1333         sum++;
1334       }
1335       lens[i] = sum;
1336     }
1337     /* create submatrix */
1338     if (scall == MAT_REUSE_MATRIX) {
1339       int n_cols,n_rows;
1340       ierr = MatGetSize(*B,&n_rows,&n_cols); CHKERRQ(ierr);
1341       if (n_rows != nrows || n_cols != ncols) SETERRQ(1,0,"");
1342       ierr = MatZeroEntries(*B); CHKERRQ(ierr);
1343       C = *B;
1344     }
1345     else {
1346       ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr);
1347     }
1348     c = (Mat_SeqAIJ*) C->data;
1349 
1350     /* loop over rows inserting into submatrix */
1351     a_new    = c->a;
1352     j_new    = c->j;
1353     i_new    = c->i;
1354     i_new[0] = -shift;
1355     for (i=0; i<nrows; i++) {
1356       ii    = starts[i];
1357       lensi = lens[i];
1358       for ( k=0; k<lensi; k++ ) {
1359         *j_new++ = aj[ii+k] - first;
1360       }
1361       PetscMemcpy(a_new,a->a + starts[i],lensi*sizeof(Scalar));
1362       a_new      += lensi;
1363       i_new[i+1]  = i_new[i] + lensi;
1364       c->ilen[i]  = lensi;
1365     }
1366     PetscFree(lens);
1367   }
1368   else {
1369     ierr = ISGetIndices(iscol,&icol); CHKERRQ(ierr);
1370     smap  = (int *) PetscMalloc((1+oldcols)*sizeof(int)); CHKPTRQ(smap);
1371     ssmap = smap + shift;
1372     lens  = (int *) PetscMalloc((1+nrows)*sizeof(int)); CHKPTRQ(lens);
1373     PetscMemzero(smap,oldcols*sizeof(int));
1374     for ( i=0; i<ncols; i++ ) smap[icol[i]] = i+1;
1375     /* determine lens of each row */
1376     for (i=0; i<nrows; i++) {
1377       kstart  = ai[irow[i]]+shift;
1378       kend    = kstart + a->ilen[irow[i]];
1379       lens[i] = 0;
1380       for ( k=kstart; k<kend; k++ ) {
1381         if (ssmap[aj[k]]) {
1382           lens[i]++;
1383         }
1384       }
1385     }
1386     /* Create and fill new matrix */
1387     if (scall == MAT_REUSE_MATRIX) {
1388       c = (Mat_SeqAIJ *)((*B)->data);
1389 
1390       if (c->m  != nrows || c->n != ncols) SETERRQ(1,0,"");
1391       if (PetscMemcmp(c->ilen,lens, c->m *sizeof(int))) {
1392         SETERRQ(1,0,"Cannot reuse matrix. wrong no of nonzeros");
1393       }
1394       PetscMemzero(c->ilen,c->m*sizeof(int));
1395       C = *B;
1396     }
1397     else {
1398       ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr);
1399     }
1400     c = (Mat_SeqAIJ *)(C->data);
1401     for (i=0; i<nrows; i++) {
1402       row    = irow[i];
1403       nznew  = 0;
1404       kstart = ai[row]+shift;
1405       kend   = kstart + a->ilen[row];
1406       mat_i  = c->i[i]+shift;
1407       mat_j  = c->j + mat_i;
1408       mat_a  = c->a + mat_i;
1409       mat_ilen = c->ilen + i;
1410       for ( k=kstart; k<kend; k++ ) {
1411         if ((tcol=ssmap[a->j[k]])) {
1412           *mat_j++ = tcol - (!shift);
1413           *mat_a++ = a->a[k];
1414           (*mat_ilen)++;
1415 
1416         }
1417       }
1418     }
1419     /* Free work space */
1420     ierr = ISRestoreIndices(iscol,&icol); CHKERRQ(ierr);
1421     PetscFree(smap); PetscFree(lens);
1422   }
1423   ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1424   ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1425 
1426   ierr = ISRestoreIndices(isrow,&irow); CHKERRQ(ierr);
1427   *B = C;
1428   return 0;
1429 }
1430 
1431 /*
1432      note: This can only work for identity for row and col. It would
1433    be good to check this and otherwise generate an error.
1434 */
1435 #undef __FUNC__
1436 #define __FUNC__ "MatILUFactor_SeqAIJ"
1437 int MatILUFactor_SeqAIJ(Mat inA,IS row,IS col,double efill,int fill)
1438 {
1439   Mat_SeqAIJ *a = (Mat_SeqAIJ *) inA->data;
1440   int        ierr;
1441   Mat        outA;
1442 
1443   if (fill != 0) SETERRQ(1,0,"Only fill=0 supported");
1444 
1445   outA          = inA;
1446   inA->factor   = FACTOR_LU;
1447   a->row        = row;
1448   a->col        = col;
1449 
1450   if (!a->solve_work) { /* this matrix may have been factored before */
1451     a->solve_work = (Scalar *) PetscMalloc( (a->m+1)*sizeof(Scalar)); CHKPTRQ(a->solve_work);
1452   }
1453 
1454   if (!a->diag) {
1455     ierr = MatMarkDiag_SeqAIJ(inA); CHKERRQ(ierr);
1456   }
1457   ierr = MatLUFactorNumeric_SeqAIJ(inA,&outA); CHKERRQ(ierr);
1458   return 0;
1459 }
1460 
1461 #include "pinclude/plapack.h"
1462 #undef __FUNC__
1463 #define __FUNC__ "MatScale_SeqAIJ"
1464 int MatScale_SeqAIJ(Scalar *alpha,Mat inA)
1465 {
1466   Mat_SeqAIJ *a = (Mat_SeqAIJ *) inA->data;
1467   int        one = 1;
1468   BLscal_( &a->nz, alpha, a->a, &one );
1469   PLogFlops(a->nz);
1470   return 0;
1471 }
1472 
1473 #undef __FUNC__
1474 #define __FUNC__ "MatGetSubMatrices_SeqAIJ"
1475 int MatGetSubMatrices_SeqAIJ(Mat A,int n, IS *irow,IS *icol,MatGetSubMatrixCall scall,
1476                                     Mat **B)
1477 {
1478   int ierr,i;
1479 
1480   if (scall == MAT_INITIAL_MATRIX) {
1481     *B = (Mat *) PetscMalloc( (n+1)*sizeof(Mat) ); CHKPTRQ(*B);
1482   }
1483 
1484   for ( i=0; i<n; i++ ) {
1485     ierr = MatGetSubMatrix_SeqAIJ(A,irow[i],icol[i],scall,&(*B)[i]);CHKERRQ(ierr);
1486   }
1487   return 0;
1488 }
1489 
1490 #undef __FUNC__
1491 #define __FUNC__ "MatGetBlockSize_SeqAIJ"
1492 int MatGetBlockSize_SeqAIJ(Mat A, int *bs)
1493 {
1494   *bs = 1;
1495   return 0;
1496 }
1497 
1498 #undef __FUNC__
1499 #define __FUNC__ "MatIncreaseOverlap_SeqAIJ"
1500 int MatIncreaseOverlap_SeqAIJ(Mat A, int is_max, IS *is, int ov)
1501 {
1502   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1503   int        shift, row, i,j,k,l,m,n, *idx,ierr, *nidx, isz, val;
1504   int        start, end, *ai, *aj;
1505   char       *table;
1506   shift = a->indexshift;
1507   m     = a->m;
1508   ai    = a->i;
1509   aj    = a->j+shift;
1510 
1511   if (ov < 0)  SETERRQ(1,0,"illegal overlap value used");
1512 
1513   table = (char *) PetscMalloc((m/BITSPERBYTE +1)*sizeof(char)); CHKPTRQ(table);
1514   nidx  = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(nidx);
1515 
1516   for ( i=0; i<is_max; i++ ) {
1517     /* Initialize the two local arrays */
1518     isz  = 0;
1519     PetscMemzero(table,(m/BITSPERBYTE +1)*sizeof(char));
1520 
1521     /* Extract the indices, assume there can be duplicate entries */
1522     ierr = ISGetIndices(is[i],&idx);  CHKERRQ(ierr);
1523     ierr = ISGetSize(is[i],&n);  CHKERRQ(ierr);
1524 
1525     /* Enter these into the temp arrays. I.e., mark table[row], enter row into new index */
1526     for ( j=0; j<n ; ++j){
1527       if(!BT_LOOKUP(table, idx[j])) { nidx[isz++] = idx[j];}
1528     }
1529     ierr = ISRestoreIndices(is[i],&idx);  CHKERRQ(ierr);
1530     ierr = ISDestroy(is[i]); CHKERRQ(ierr);
1531 
1532     k = 0;
1533     for ( j=0; j<ov; j++){ /* for each overlap */
1534       n = isz;
1535       for ( ; k<n ; k++){ /* do only those rows in nidx[k], which are not done yet */
1536         row   = nidx[k];
1537         start = ai[row];
1538         end   = ai[row+1];
1539         for ( l = start; l<end ; l++){
1540           val = aj[l] + shift;
1541           if (!BT_LOOKUP(table,val)) {nidx[isz++] = val;}
1542         }
1543       }
1544     }
1545     ierr = ISCreateGeneral(PETSC_COMM_SELF, isz, nidx, (is+i)); CHKERRQ(ierr);
1546   }
1547   PetscFree(table);
1548   PetscFree(nidx);
1549   return 0;
1550 }
1551 
1552 /* -------------------------------------------------------------- */
1553 #undef __FUNC__
1554 #define __FUNC__ "MatPermute_SeqAIJ"
1555 int MatPermute_SeqAIJ(Mat A, IS rowp, IS colp, Mat *B)
1556 {
1557   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
1558   Scalar     *vwork;
1559   int        i, ierr, nz, m = a->m, n = a->n, *cwork;
1560   int        *row,*col,*cnew,j,*lens;
1561   IS         icolp,irowp;
1562 
1563   ierr = ISInvertPermutation(rowp,&irowp); CHKERRQ(ierr);
1564   ierr = ISGetIndices(irowp,&row); CHKERRQ(ierr);
1565   ierr = ISInvertPermutation(colp,&icolp); CHKERRQ(ierr);
1566   ierr = ISGetIndices(icolp,&col); CHKERRQ(ierr);
1567 
1568   /* determine lengths of permuted rows */
1569   lens = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(lens);
1570   for (i=0; i<m; i++ ) {
1571     lens[row[i]] = a->i[i+1] - a->i[i];
1572   }
1573   ierr = MatCreateSeqAIJ(A->comm,m,n,0,lens,B);CHKERRQ(ierr);
1574   PetscFree(lens);
1575 
1576   cnew = (int *) PetscMalloc( n*sizeof(int) ); CHKPTRQ(cnew);
1577   for (i=0; i<m; i++) {
1578     ierr = MatGetRow(A,i,&nz,&cwork,&vwork); CHKERRQ(ierr);
1579     for (j=0; j<nz; j++ ) { cnew[j] = col[cwork[j]];}
1580     ierr = MatSetValues(*B,1,&row[i],nz,cnew,vwork,INSERT_VALUES); CHKERRQ(ierr);
1581     ierr = MatRestoreRow(A,i,&nz,&cwork,&vwork); CHKERRQ(ierr);
1582   }
1583   PetscFree(cnew);
1584   ierr = MatAssemblyBegin(*B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1585   ierr = MatAssemblyEnd(*B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1586   ierr = ISRestoreIndices(irowp,&row); CHKERRQ(ierr);
1587   ierr = ISRestoreIndices(icolp,&col); CHKERRQ(ierr);
1588   ierr = ISDestroy(irowp); CHKERRQ(ierr);
1589   ierr = ISDestroy(icolp); CHKERRQ(ierr);
1590   return 0;
1591 }
1592 
1593 #undef __FUNC__
1594 #define __FUNC__ "MatPrintHelp_SeqAIJ"
1595 int MatPrintHelp_SeqAIJ(Mat A)
1596 {
1597   static int called = 0;
1598   MPI_Comm   comm = A->comm;
1599 
1600   if (called) return 0; else called = 1;
1601   PetscPrintf(comm," Options for MATSEQAIJ and MATMPIAIJ matrix formats (the defaults):\n");
1602   PetscPrintf(comm,"  -mat_lu_pivotthreshold <threshold>: Set pivoting threshold\n");
1603   PetscPrintf(comm,"  -mat_aij_oneindex: internal indices begin at 1 instead of the default 0.\n");
1604   PetscPrintf(comm,"  -mat_aij_no_inode: Do not use inodes\n");
1605   PetscPrintf(comm,"  -mat_aij_inode_limit <limit>: Set inode limit (max limit=5)\n");
1606 #if defined(HAVE_ESSL)
1607   PetscPrintf(comm,"  -mat_aij_essl: Use IBM sparse LU factorization and solve.\n");
1608 #endif
1609   return 0;
1610 }
1611 extern int MatEqual_SeqAIJ(Mat A,Mat B, PetscTruth* flg);
1612 extern int MatFDColoringCreate_SeqAIJ(Mat,ISColoring,MatFDColoring);
1613 extern int MatColoringPatch_SeqAIJ(Mat,int,int *,ISColoring *);
1614 
1615 /* -------------------------------------------------------------------*/
1616 static struct _MatOps MatOps = {MatSetValues_SeqAIJ,
1617        MatGetRow_SeqAIJ,MatRestoreRow_SeqAIJ,
1618        MatMult_SeqAIJ,MatMultAdd_SeqAIJ,
1619        MatMultTrans_SeqAIJ,MatMultTransAdd_SeqAIJ,
1620        MatSolve_SeqAIJ,MatSolveAdd_SeqAIJ,
1621        MatSolveTrans_SeqAIJ,MatSolveTransAdd_SeqAIJ,
1622        MatLUFactor_SeqAIJ,0,
1623        MatRelax_SeqAIJ,
1624        MatTranspose_SeqAIJ,
1625        MatGetInfo_SeqAIJ,MatEqual_SeqAIJ,
1626        MatGetDiagonal_SeqAIJ,MatDiagonalScale_SeqAIJ,MatNorm_SeqAIJ,
1627        0,MatAssemblyEnd_SeqAIJ,
1628        MatCompress_SeqAIJ,
1629        MatSetOption_SeqAIJ,MatZeroEntries_SeqAIJ,MatZeroRows_SeqAIJ,
1630        MatLUFactorSymbolic_SeqAIJ,MatLUFactorNumeric_SeqAIJ,0,0,
1631        MatGetSize_SeqAIJ,MatGetSize_SeqAIJ,MatGetOwnershipRange_SeqAIJ,
1632        MatILUFactorSymbolic_SeqAIJ,0,
1633        0,0,
1634        MatConvertSameType_SeqAIJ,0,0,
1635        MatILUFactor_SeqAIJ,0,0,
1636        MatGetSubMatrices_SeqAIJ,MatIncreaseOverlap_SeqAIJ,
1637        MatGetValues_SeqAIJ,0,
1638        MatPrintHelp_SeqAIJ,
1639        MatScale_SeqAIJ,0,0,
1640        MatILUDTFactor_SeqAIJ,
1641        MatGetBlockSize_SeqAIJ,
1642        MatGetRowIJ_SeqAIJ,
1643        MatRestoreRowIJ_SeqAIJ,
1644        MatGetColumnIJ_SeqAIJ,
1645        MatRestoreColumnIJ_SeqAIJ,
1646        MatFDColoringCreate_SeqAIJ,
1647        MatColoringPatch_SeqAIJ,
1648        0,
1649        MatPermute_SeqAIJ};
1650 
1651 extern int MatUseSuperLU_SeqAIJ(Mat);
1652 extern int MatUseEssl_SeqAIJ(Mat);
1653 extern int MatUseDXML_SeqAIJ(Mat);
1654 
1655 #undef __FUNC__
1656 #define __FUNC__ "MatCreateSeqAIJ"
1657 /*@C
1658    MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format
1659    (the default parallel PETSc format).  For good matrix assembly performance
1660    the user should preallocate the matrix storage by setting the parameter nz
1661    (or the array nzz).  By setting these parameters accurately, performance
1662    during matrix assembly can be increased by more than a factor of 50.
1663 
1664    Input Parameters:
1665 .  comm - MPI communicator, set to PETSC_COMM_SELF
1666 .  m - number of rows
1667 .  n - number of columns
1668 .  nz - number of nonzeros per row (same for all rows)
1669 .  nzz - array containing the number of nonzeros in the various rows
1670          (possibly different for each row) or PETSC_NULL
1671 
1672    Output Parameter:
1673 .  A - the matrix
1674 
1675    Notes:
1676    The AIJ format (also called the Yale sparse matrix format or
1677    compressed row storage), is fully compatible with standard Fortran 77
1678    storage.  That is, the stored row and column indices can begin at
1679    either one (as in Fortran) or zero.  See the users' manual for details.
1680 
1681    Specify the preallocated storage with either nz or nnz (not both).
1682    Set nz=PETSC_DEFAULT and nnz=PETSC_NULL for PETSc to control dynamic memory
1683    allocation.  For large problems you MUST preallocate memory or you
1684    will get TERRIBLE performance, see the users' manual chapter on matrices.
1685 
1686    By default, this format uses inodes (identical nodes) when possible, to
1687    improve numerical efficiency of Matrix vector products and solves. We
1688    search for consecutive rows with the same nonzero structure, thereby
1689    reusing matrix information to achieve increased efficiency.
1690 
1691    Options Database Keys:
1692 $    -mat_aij_no_inode  - Do not use inodes
1693 $    -mat_aij_inode_limit <limit> - Set inode limit.
1694 $        (max limit=5)
1695 $    -mat_aij_oneindex - Internally use indexing starting at 1
1696 $        rather than 0.  Note: When calling MatSetValues(),
1697 $        the user still MUST index entries starting at 0!
1698 
1699 .seealso: MatCreate(), MatCreateMPIAIJ(), MatSetValues()
1700 @*/
1701 int MatCreateSeqAIJ(MPI_Comm comm,int m,int n,int nz,int *nnz, Mat *A)
1702 {
1703   Mat        B;
1704   Mat_SeqAIJ *b;
1705   int        i, len, ierr, flg,size;
1706 
1707   MPI_Comm_size(comm,&size);
1708   if (size > 1) SETERRQ(1,0,"Comm must be of size 1");
1709 
1710   *A                  = 0;
1711   PetscHeaderCreate(B,_p_Mat,MAT_COOKIE,MATSEQAIJ,comm);
1712   PLogObjectCreate(B);
1713   B->data             = (void *) (b = PetscNew(Mat_SeqAIJ)); CHKPTRQ(b);
1714   PetscMemzero(b,sizeof(Mat_SeqAIJ));
1715   PetscMemcpy(&B->ops,&MatOps,sizeof(struct _MatOps));
1716   B->destroy          = MatDestroy_SeqAIJ;
1717   B->view             = MatView_SeqAIJ;
1718   B->factor           = 0;
1719   B->lupivotthreshold = 1.0;
1720   B->mapping          = 0;
1721   ierr = OptionsGetDouble(PETSC_NULL,"-mat_lu_pivotthreshold",&B->lupivotthreshold,
1722                           &flg); CHKERRQ(ierr);
1723   b->ilu_preserve_row_sums = PETSC_FALSE;
1724   ierr = OptionsHasName(PETSC_NULL,"-pc_ilu_preserve_row_sums",
1725                         (int*) &b->ilu_preserve_row_sums); CHKERRQ(ierr);
1726   b->row              = 0;
1727   b->col              = 0;
1728   b->indexshift       = 0;
1729   b->reallocs         = 0;
1730   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_oneindex", &flg); CHKERRQ(ierr);
1731   if (flg) b->indexshift = -1;
1732 
1733   b->m = m; B->m = m; B->M = m;
1734   b->n = n; B->n = n; B->N = n;
1735   b->imax = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(b->imax);
1736   if (nnz == PETSC_NULL) {
1737     if (nz == PETSC_DEFAULT) nz = 10;
1738     else if (nz <= 0)        nz = 1;
1739     for ( i=0; i<m; i++ ) b->imax[i] = nz;
1740     nz = nz*m;
1741   }
1742   else {
1743     nz = 0;
1744     for ( i=0; i<m; i++ ) {b->imax[i] = nnz[i]; nz += nnz[i];}
1745   }
1746 
1747   /* allocate the matrix space */
1748   len     = nz*(sizeof(int) + sizeof(Scalar)) + (b->m+1)*sizeof(int);
1749   b->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
1750   b->j  = (int *) (b->a + nz);
1751   PetscMemzero(b->j,nz*sizeof(int));
1752   b->i  = b->j + nz;
1753   b->singlemalloc = 1;
1754 
1755   b->i[0] = -b->indexshift;
1756   for (i=1; i<m+1; i++) {
1757     b->i[i] = b->i[i-1] + b->imax[i-1];
1758   }
1759 
1760   /* b->ilen will count nonzeros in each row so far. */
1761   b->ilen = (int *) PetscMalloc((m+1)*sizeof(int));
1762   PLogObjectMemory(B,len+2*(m+1)*sizeof(int)+sizeof(struct _p_Mat)+sizeof(Mat_SeqAIJ));
1763   for ( i=0; i<b->m; i++ ) { b->ilen[i] = 0;}
1764 
1765   b->nz               = 0;
1766   b->maxnz            = nz;
1767   b->sorted           = 0;
1768   b->roworiented      = 1;
1769   b->nonew            = 0;
1770   b->diag             = 0;
1771   b->solve_work       = 0;
1772   b->spptr            = 0;
1773   b->inode.node_count = 0;
1774   b->inode.size       = 0;
1775   b->inode.limit      = 5;
1776   b->inode.max_limit  = 5;
1777   B->info.nz_unneeded = (double)b->maxnz;
1778 
1779   *A = B;
1780 
1781   /*  SuperLU is not currently supported through PETSc */
1782 #if defined(HAVE_SUPERLU)
1783   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_superlu", &flg); CHKERRQ(ierr);
1784   if (flg) { ierr = MatUseSuperLU_SeqAIJ(B); CHKERRQ(ierr); }
1785 #endif
1786   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_essl", &flg); CHKERRQ(ierr);
1787   if (flg) { ierr = MatUseEssl_SeqAIJ(B); CHKERRQ(ierr); }
1788   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_dxml", &flg); CHKERRQ(ierr);
1789   if (flg) {
1790     if (!b->indexshift) SETERRQ(1,0,"need -mat_aij_oneindex with -mat_aij_dxml");
1791     ierr = MatUseDXML_SeqAIJ(B); CHKERRQ(ierr);
1792   }
1793   ierr = OptionsHasName(PETSC_NULL,"-help", &flg); CHKERRQ(ierr);
1794   if (flg) {ierr = MatPrintHelp(B); CHKERRQ(ierr); }
1795   return 0;
1796 }
1797 
1798 #undef __FUNC__
1799 #define __FUNC__ "MatConvertSameType_SeqAIJ"
1800 int MatConvertSameType_SeqAIJ(Mat A,Mat *B,int cpvalues)
1801 {
1802   Mat        C;
1803   Mat_SeqAIJ *c,*a = (Mat_SeqAIJ *) A->data;
1804   int        i,len, m = a->m,shift = a->indexshift;
1805 
1806   *B = 0;
1807   PetscHeaderCreate(C,_p_Mat,MAT_COOKIE,MATSEQAIJ,A->comm);
1808   PLogObjectCreate(C);
1809   C->data       = (void *) (c = PetscNew(Mat_SeqAIJ)); CHKPTRQ(c);
1810   PetscMemcpy(&C->ops,&A->ops,sizeof(struct _MatOps));
1811   C->destroy    = MatDestroy_SeqAIJ;
1812   C->view       = MatView_SeqAIJ;
1813   C->factor     = A->factor;
1814   c->row        = 0;
1815   c->col        = 0;
1816   c->indexshift = shift;
1817   C->assembled  = PETSC_TRUE;
1818 
1819   c->m = C->m   = a->m;
1820   c->n = C->n   = a->n;
1821   C->M          = a->m;
1822   C->N          = a->n;
1823 
1824   c->imax       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->imax);
1825   c->ilen       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->ilen);
1826   for ( i=0; i<m; i++ ) {
1827     c->imax[i] = a->imax[i];
1828     c->ilen[i] = a->ilen[i];
1829   }
1830 
1831   /* allocate the matrix space */
1832   c->singlemalloc = 1;
1833   len     = (m+1)*sizeof(int)+(a->i[m])*(sizeof(Scalar)+sizeof(int));
1834   c->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(c->a);
1835   c->j  = (int *) (c->a + a->i[m] + shift);
1836   c->i  = c->j + a->i[m] + shift;
1837   PetscMemcpy(c->i,a->i,(m+1)*sizeof(int));
1838   if (m > 0) {
1839     PetscMemcpy(c->j,a->j,(a->i[m]+shift)*sizeof(int));
1840     if (cpvalues == COPY_VALUES) {
1841       PetscMemcpy(c->a,a->a,(a->i[m]+shift)*sizeof(Scalar));
1842     }
1843   }
1844 
1845   PLogObjectMemory(C,len+2*(m+1)*sizeof(int)+sizeof(struct _p_Mat)+sizeof(Mat_SeqAIJ));
1846   c->sorted      = a->sorted;
1847   c->roworiented = a->roworiented;
1848   c->nonew       = a->nonew;
1849   c->ilu_preserve_row_sums = a->ilu_preserve_row_sums;
1850 
1851   if (a->diag) {
1852     c->diag = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(c->diag);
1853     PLogObjectMemory(C,(m+1)*sizeof(int));
1854     for ( i=0; i<m; i++ ) {
1855       c->diag[i] = a->diag[i];
1856     }
1857   }
1858   else c->diag          = 0;
1859   c->inode.limit        = a->inode.limit;
1860   c->inode.max_limit    = a->inode.max_limit;
1861   if (a->inode.size){
1862     c->inode.size       = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(c->inode.size);
1863     c->inode.node_count = a->inode.node_count;
1864     PetscMemcpy( c->inode.size, a->inode.size, (m+1)*sizeof(int));
1865   } else {
1866     c->inode.size       = 0;
1867     c->inode.node_count = 0;
1868   }
1869   c->nz                 = a->nz;
1870   c->maxnz              = a->maxnz;
1871   c->solve_work         = 0;
1872   c->spptr              = 0;      /* Dangerous -I'm throwing away a->spptr */
1873 
1874   *B = C;
1875   return 0;
1876 }
1877 
1878 #undef __FUNC__
1879 #define __FUNC__ "MatLoad_SeqAIJ"
1880 int MatLoad_SeqAIJ(Viewer viewer,MatType type,Mat *A)
1881 {
1882   Mat_SeqAIJ   *a;
1883   Mat          B;
1884   int          i, nz, ierr, fd, header[4],size,*rowlengths = 0,M,N,shift;
1885   MPI_Comm     comm;
1886 
1887   PetscObjectGetComm((PetscObject) viewer,&comm);
1888   MPI_Comm_size(comm,&size);
1889   if (size > 1) SETERRQ(1,0,"view must have one processor");
1890   ierr = ViewerBinaryGetDescriptor(viewer,&fd); CHKERRQ(ierr);
1891   ierr = PetscBinaryRead(fd,header,4,BINARY_INT); CHKERRQ(ierr);
1892   if (header[0] != MAT_COOKIE) SETERRQ(1,0,"not matrix object in file");
1893   M = header[1]; N = header[2]; nz = header[3];
1894 
1895   /* read in row lengths */
1896   rowlengths = (int*) PetscMalloc( M*sizeof(int) ); CHKPTRQ(rowlengths);
1897   ierr = PetscBinaryRead(fd,rowlengths,M,BINARY_INT); CHKERRQ(ierr);
1898 
1899   /* create our matrix */
1900   ierr = MatCreateSeqAIJ(comm,M,N,0,rowlengths,A); CHKERRQ(ierr);
1901   B = *A;
1902   a = (Mat_SeqAIJ *) B->data;
1903   shift = a->indexshift;
1904 
1905   /* read in column indices and adjust for Fortran indexing*/
1906   ierr = PetscBinaryRead(fd,a->j,nz,BINARY_INT); CHKERRQ(ierr);
1907   if (shift) {
1908     for ( i=0; i<nz; i++ ) {
1909       a->j[i] += 1;
1910     }
1911   }
1912 
1913   /* read in nonzero values */
1914   ierr = PetscBinaryRead(fd,a->a,nz,BINARY_SCALAR); CHKERRQ(ierr);
1915 
1916   /* set matrix "i" values */
1917   a->i[0] = -shift;
1918   for ( i=1; i<= M; i++ ) {
1919     a->i[i]      = a->i[i-1] + rowlengths[i-1];
1920     a->ilen[i-1] = rowlengths[i-1];
1921   }
1922   PetscFree(rowlengths);
1923 
1924   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1925   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
1926   return 0;
1927 }
1928 
1929 #undef __FUNC__
1930 #define __FUNC__ "MatEqual_SeqAIJ"
1931 int MatEqual_SeqAIJ(Mat A,Mat B, PetscTruth* flg)
1932 {
1933   Mat_SeqAIJ *a = (Mat_SeqAIJ *)A->data, *b = (Mat_SeqAIJ *)B->data;
1934 
1935   if (B->type !=MATSEQAIJ)SETERRQ(1,0,"Matrices must be same type");
1936 
1937   /* If the  matrix dimensions are not equal, or no of nonzeros or shift */
1938   if ((a->m != b->m ) || (a->n !=b->n) ||( a->nz != b->nz)||
1939       (a->indexshift != b->indexshift)) {
1940     *flg = PETSC_FALSE; return 0;
1941   }
1942 
1943   /* if the a->i are the same */
1944   if (PetscMemcmp(a->i,b->i,(a->m+1)*sizeof(int))) {
1945     *flg = PETSC_FALSE; return 0;
1946   }
1947 
1948   /* if a->j are the same */
1949   if (PetscMemcmp(a->j, b->j, (a->nz)*sizeof(int))) {
1950     *flg = PETSC_FALSE; return 0;
1951   }
1952 
1953   /* if a->a are the same */
1954   if (PetscMemcmp(a->a, b->a, (a->nz)*sizeof(Scalar))) {
1955     *flg = PETSC_FALSE; return 0;
1956   }
1957   *flg = PETSC_TRUE;
1958   return 0;
1959 
1960 }
1961