xref: /petsc/src/mat/impls/aij/seq/aij.c (revision 25cdf11f00656cd6142ccc252ca9e2f99af554b2)
1 #ifndef lint
2 static char vcid[] = "$Id: aij.c,v 1.133 1996/01/08 17:41:34 bsmith Exp balay $";
3 #endif
4 
5 /*
6     Defines the basic matrix operations for the AIJ (compressed row)
7   matrix storage format.
8 */
9 #include "aij.h"
10 #include "vec/vecimpl.h"
11 #include "inline/spops.h"
12 
13 extern int MatToSymmetricIJ_SeqAIJ(Mat_SeqAIJ*,int**,int**);
14 
15 static int MatGetReordering_SeqAIJ(Mat A,MatOrdering type,IS *rperm, IS *cperm)
16 {
17   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
18   int        ierr, *ia, *ja,n,*idx,i;
19   /*Viewer     V1, V2;*/
20 
21   if (!a->assembled) SETERRQ(1,"MatGetReordering_SeqAIJ:Not for unassembled matrix");
22 
23   /*
24      this is tacky: In the future when we have written special factorization
25      and solve routines for the identity permutation we should use a
26      stride index set instead of the general one.
27   */
28   if (type  == ORDER_NATURAL) {
29     n = a->n;
30     idx = (int *) PetscMalloc( n*sizeof(int) ); CHKPTRQ(idx);
31     for ( i=0; i<n; i++ ) idx[i] = i;
32     ierr = ISCreateSeq(MPI_COMM_SELF,n,idx,rperm); CHKERRQ(ierr);
33     ierr = ISCreateSeq(MPI_COMM_SELF,n,idx,cperm); CHKERRQ(ierr);
34     PetscFree(idx);
35     ISSetPermutation(*rperm);
36     ISSetPermutation(*cperm);
37     ISSetIdentity(*rperm);
38     ISSetIdentity(*cperm);
39     return 0;
40   }
41 
42   ierr = MatToSymmetricIJ_SeqAIJ( a, &ia, &ja ); CHKERRQ(ierr);
43   ierr = MatGetReordering_IJ(a->n,ia,ja,type,rperm,cperm); CHKERRQ(ierr);
44 /*  ISView(*rperm, STDOUT_VIEWER_SELF);*/
45 
46   /*ViewerFileOpenASCII(MPI_COMM_SELF,"row_is_orig", &V1);
47   ViewerFileOpenASCII(MPI_COMM_SELF,"col_is_orig", &V2);
48   ISView(*rperm,V1);
49   ISView(*cperm,V2);
50   ViewerDestroy(V1);
51   ViewerDestroy(V2);*/
52 
53   PetscFree(ia); PetscFree(ja);
54   return 0;
55 }
56 
57 #define CHUNKSIZE   10
58 
59 /* This version has row oriented v  */
60 static int MatSetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v,InsertMode is)
61 {
62   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
63   int        *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax, N, sorted = a->sorted;
64   int        *imax = a->imax, *ai = a->i, *ailen = a->ilen,roworiented = a->roworiented;
65   int        *aj = a->j, nonew = a->nonew,shift = a->indexshift;
66   Scalar     *ap,value, *aa = a->a;
67 
68   for ( k=0; k<m; k++ ) { /* loop over added rows */
69     row  = im[k];
70     if (row < 0) SETERRQ(1,"MatSetValues_SeqAIJ:Negative row");
71     if (row >= a->m) SETERRQ(1,"MatSetValues_SeqAIJ:Row too large");
72     rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
73     rmax = imax[row]; nrow = ailen[row];
74     low = 0;
75     for ( l=0; l<n; l++ ) { /* loop over added columns */
76       if (in[l] < 0) SETERRQ(1,"MatSetValues_SeqAIJ:Negative column");
77       if (in[l] >= a->n) SETERRQ(1,"MatSetValues_SeqAIJ:Column too large");
78       col = in[l] - shift;
79       if (roworiented) {
80         value = *v++;
81       }
82       else {
83         value = v[k + l*m];
84       }
85       if (!sorted) low = 0; high = nrow;
86       while (high-low > 5) {
87         t = (low+high)/2;
88         if (rp[t] > col) high = t;
89         else             low  = t;
90       }
91       for ( i=low; i<high; i++ ) {
92         if (rp[i] > col) break;
93         if (rp[i] == col) {
94           if (is == ADD_VALUES) ap[i] += value;
95           else                  ap[i] = value;
96           goto noinsert;
97         }
98       }
99       if (nonew) goto noinsert;
100       if (nrow >= rmax) {
101         /* there is no extra room in row, therefore enlarge */
102         int    new_nz = ai[a->m] + CHUNKSIZE,len,*new_i,*new_j;
103         Scalar *new_a;
104 
105         /* malloc new storage space */
106         len     = new_nz*(sizeof(int)+sizeof(Scalar))+(a->m+1)*sizeof(int);
107         new_a   = (Scalar *) PetscMalloc( len ); CHKPTRQ(new_a);
108         new_j   = (int *) (new_a + new_nz);
109         new_i   = new_j + new_nz;
110 
111         /* copy over old data into new slots */
112         for ( ii=0; ii<row+1; ii++ ) {new_i[ii] = ai[ii];}
113         for ( ii=row+1; ii<a->m+1; ii++ ) {new_i[ii] = ai[ii]+CHUNKSIZE;}
114         PetscMemcpy(new_j,aj,(ai[row]+nrow+shift)*sizeof(int));
115         len = (new_nz - CHUNKSIZE - ai[row] - nrow - shift);
116         PetscMemcpy(new_j+ai[row]+shift+nrow+CHUNKSIZE,aj+ai[row]+shift+nrow,
117                                                            len*sizeof(int));
118         PetscMemcpy(new_a,aa,(ai[row]+nrow+shift)*sizeof(Scalar));
119         PetscMemcpy(new_a+ai[row]+shift+nrow+CHUNKSIZE,aa+ai[row]+shift+nrow,
120                                                            len*sizeof(Scalar));
121         /* free up old matrix storage */
122         PetscFree(a->a);
123         if (!a->singlemalloc) {PetscFree(a->i);PetscFree(a->j);}
124         aa = a->a = new_a; ai = a->i = new_i; aj = a->j = new_j;
125         a->singlemalloc = 1;
126 
127         rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
128         rmax = imax[row] = imax[row] + CHUNKSIZE;
129         PLogObjectMemory(A,CHUNKSIZE*(sizeof(int) + sizeof(Scalar)));
130         a->maxnz += CHUNKSIZE;
131       }
132       N = nrow++ - 1; a->nz++;
133       /* shift up all the later entries in this row */
134       for ( ii=N; ii>=i; ii-- ) {
135         rp[ii+1] = rp[ii];
136         ap[ii+1] = ap[ii];
137       }
138       rp[i] = col;
139       ap[i] = value;
140       noinsert:;
141       low = i + 1;
142     }
143     ailen[row] = nrow;
144   }
145   return 0;
146 }
147 
148 static int MatGetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v)
149 {
150   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
151   int        *rp, k, low, high, t, row, nrow, i, col, l, *aj = a->j;
152   int        *ai = a->i, *ailen = a->ilen, shift = a->indexshift;
153   Scalar     *ap, *aa = a->a, zero = 0.0;
154 
155   if (!a->assembled) SETERRQ(1,"MatGetValues_SeqAIJ:Not for unassembled matrix");
156   for ( k=0; k<m; k++ ) { /* loop over rows */
157     row  = im[k];
158     if (row < 0) SETERRQ(1,"MatGetValues_SeqAIJ:Negative row");
159     if (row >= a->m) SETERRQ(1,"MatGetValues_SeqAIJ:Row too large");
160     rp   = aj + ai[row] + shift; ap = aa + ai[row] + shift;
161     nrow = ailen[row];
162     for ( l=0; l<n; l++ ) { /* loop over columns */
163       if (in[l] < 0) SETERRQ(1,"MatGetValues_SeqAIJ:Negative column");
164       if (in[l] >= a->n) SETERRQ(1,"MatGetValues_SeqAIJ:Column too large");
165       col = in[l] - shift;
166       high = nrow; low = 0; /* assume unsorted */
167       while (high-low > 5) {
168         t = (low+high)/2;
169         if (rp[t] > col) high = t;
170         else             low  = t;
171       }
172       for ( i=low; i<high; i++ ) {
173         if (rp[i] > col) break;
174         if (rp[i] == col) {
175           *v++ = ap[i];
176           goto finished;
177         }
178       }
179       *v++ = zero;
180       finished:;
181     }
182   }
183   return 0;
184 }
185 
186 #include "draw.h"
187 #include "pinclude/pviewer.h"
188 #include "sysio.h"
189 
190 static int MatView_SeqAIJ_Binary(Mat A,Viewer viewer)
191 {
192   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
193   int        i, fd, *col_lens, ierr;
194 
195   ierr = ViewerFileGetDescriptor_Private(viewer,&fd); CHKERRQ(ierr);
196   col_lens = (int *) PetscMalloc( (4+a->m)*sizeof(int) ); CHKPTRQ(col_lens);
197   col_lens[0] = MAT_COOKIE;
198   col_lens[1] = a->m;
199   col_lens[2] = a->n;
200   col_lens[3] = a->nz;
201 
202   /* store lengths of each row and write (including header) to file */
203   for ( i=0; i<a->m; i++ ) {
204     col_lens[4+i] = a->i[i+1] - a->i[i];
205   }
206   ierr = SYWrite(fd,col_lens,4+a->m,SYINT,1); CHKERRQ(ierr);
207   PetscFree(col_lens);
208 
209   /* store column indices (zero start index) */
210   if (a->indexshift) {
211     for ( i=0; i<a->nz; i++ ) a->j[i]--;
212   }
213   ierr = SYWrite(fd,a->j,a->nz,SYINT,0); CHKERRQ(ierr);
214   if (a->indexshift) {
215     for ( i=0; i<a->nz; i++ ) a->j[i]++;
216   }
217 
218   /* store nonzero values */
219   ierr = SYWrite(fd,a->a,a->nz,SYSCALAR,0); CHKERRQ(ierr);
220   return 0;
221 }
222 
223 static int MatView_SeqAIJ_ASCII(Mat A,Viewer viewer)
224 {
225   Mat_SeqAIJ  *a = (Mat_SeqAIJ *) A->data;
226   int         ierr, i,j, m = a->m, shift = a->indexshift,format;
227   FILE        *fd;
228   char        *outputname;
229 
230   ierr = ViewerFileGetPointer_Private(viewer,&fd); CHKERRQ(ierr);
231   ierr = ViewerFileGetOutputname_Private(viewer,&outputname); CHKERRQ(ierr);
232   ierr = ViewerFileGetFormat_Private(viewer,&format);
233   if (format == FILE_FORMAT_INFO) {
234     /* no need to print additional information */ ;
235   }
236   else if (format == FILE_FORMAT_MATLAB) {
237     int nz, nzalloc, mem;
238     MatGetInfo(A,MAT_LOCAL,&nz,&nzalloc,&mem);
239     fprintf(fd,"%% Size = %d %d \n",m,a->n);
240     fprintf(fd,"%% Nonzeros = %d \n",nz);
241     fprintf(fd,"zzz = zeros(%d,3);\n",nz);
242     fprintf(fd,"zzz = [\n");
243 
244     for (i=0; i<m; i++) {
245       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
246 #if defined(PETSC_COMPLEX)
247         fprintf(fd,"%d %d  %18.16e  %18.16e \n",i+1,a->j[j],real(a->a[j]),
248                    imag(a->a[j]));
249 #else
250         fprintf(fd,"%d %d  %18.16e\n", i+1, a->j[j], a->a[j]);
251 #endif
252       }
253     }
254     fprintf(fd,"];\n %s = spconvert(zzz);\n",outputname);
255   }
256   else {
257     for ( i=0; i<m; i++ ) {
258       fprintf(fd,"row %d:",i);
259       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
260 #if defined(PETSC_COMPLEX)
261         if (imag(a->a[j]) != 0.0) {
262           fprintf(fd," %d %g + %g i",a->j[j]+shift,real(a->a[j]),imag(a->a[j]));
263         }
264         else {
265           fprintf(fd," %d %g ",a->j[j]+shift,real(a->a[j]));
266         }
267 #else
268         fprintf(fd," %d %g ",a->j[j]+shift,a->a[j]);
269 #endif
270       }
271       fprintf(fd,"\n");
272     }
273   }
274   fflush(fd);
275   return 0;
276 }
277 
278 static int MatView_SeqAIJ_Draw(Mat A,Viewer viewer)
279 {
280   Mat_SeqAIJ  *a = (Mat_SeqAIJ *) A->data;
281   int         ierr, i,j, m = a->m, shift = a->indexshift,pause,color;
282   double      xl,yl,xr,yr,w,h,xc,yc,scale = 1.0,x_l,x_r,y_l,y_r;
283   Draw     draw = (Draw) viewer;
284   DrawButton  button;
285 
286   xr  = a->n; yr = a->m; h = yr/10.0; w = xr/10.0;
287   xr += w;    yr += h;  xl = -w;     yl = -h;
288   ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr);
289   /* loop over matrix elements drawing boxes */
290   color = DRAW_BLUE;
291   for ( i=0; i<m; i++ ) {
292     y_l = m - i - 1.0; y_r = y_l + 1.0;
293     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
294       x_l = a->j[j] + shift; x_r = x_l + 1.0;
295 #if defined(PETSC_COMPLEX)
296       if (real(a->a[j]) >=  0.) continue;
297 #else
298       if (a->a[j] >=  0.) continue;
299 #endif
300       DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
301     }
302   }
303   color = DRAW_CYAN;
304   for ( i=0; i<m; i++ ) {
305     y_l = m - i - 1.0; y_r = y_l + 1.0;
306     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
307       x_l = a->j[j] + shift; x_r = x_l + 1.0;
308       if (a->a[j] !=  0.) continue;
309       DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
310     }
311   }
312   color = DRAW_RED;
313   for ( i=0; i<m; i++ ) {
314     y_l = m - i - 1.0; y_r = y_l + 1.0;
315     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
316       x_l = a->j[j] + shift; x_r = x_l + 1.0;
317 #if defined(PETSC_COMPLEX)
318       if (real(a->a[j]) <=  0.) continue;
319 #else
320       if (a->a[j] <=  0.) continue;
321 #endif
322       DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
323     }
324   }
325   DrawFlush(draw);
326   DrawGetPause(draw,&pause);
327   if (pause >= 0) { PetscSleep(pause); return 0;}
328 
329   /* allow the matrix to zoom or shrink */
330   ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0);
331   while (button != BUTTON_RIGHT) {
332     DrawClear(draw);
333     if (button == BUTTON_LEFT) scale = .5;
334     else if (button == BUTTON_CENTER) scale = 2.;
335     xl = scale*(xl + w - xc) + xc - w*scale;
336     xr = scale*(xr - w - xc) + xc + w*scale;
337     yl = scale*(yl + h - yc) + yc - h*scale;
338     yr = scale*(yr - h - yc) + yc + h*scale;
339     w *= scale; h *= scale;
340     ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr);
341     color = DRAW_BLUE;
342     for ( i=0; i<m; i++ ) {
343       y_l = m - i - 1.0; y_r = y_l + 1.0;
344       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
345         x_l = a->j[j] + shift; x_r = x_l + 1.0;
346 #if defined(PETSC_COMPLEX)
347         if (real(a->a[j]) >=  0.) continue;
348 #else
349         if (a->a[j] >=  0.) continue;
350 #endif
351         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
352       }
353     }
354     color = DRAW_CYAN;
355     for ( i=0; i<m; i++ ) {
356       y_l = m - i - 1.0; y_r = y_l + 1.0;
357       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
358         x_l = a->j[j] + shift; x_r = x_l + 1.0;
359         if (a->a[j] !=  0.) continue;
360         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
361       }
362     }
363     color = DRAW_RED;
364     for ( i=0; i<m; i++ ) {
365       y_l = m - i - 1.0; y_r = y_l + 1.0;
366       for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
367         x_l = a->j[j] + shift; x_r = x_l + 1.0;
368 #if defined(PETSC_COMPLEX)
369         if (real(a->a[j]) <=  0.) continue;
370 #else
371         if (a->a[j] <=  0.) continue;
372 #endif
373         DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
374       }
375     }
376     ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0);
377   }
378   return 0;
379 }
380 
381 static int MatView_SeqAIJ(PetscObject obj,Viewer viewer)
382 {
383   Mat         A = (Mat) obj;
384   Mat_SeqAIJ  *a = (Mat_SeqAIJ*) A->data;
385   PetscObject vobj = (PetscObject) viewer;
386 
387   if (!a->assembled) SETERRQ(1,"MatView_SeqAIJ:Not for unassembled matrix");
388   if (!viewer) {
389     viewer = STDOUT_VIEWER_SELF; vobj = (PetscObject) viewer;
390   }
391   if (vobj->cookie == VIEWER_COOKIE) {
392     if (vobj->type == MATLAB_VIEWER) {
393       return ViewerMatlabPutSparse_Private(viewer,a->m,a->n,a->nz,a->a,a->i,a->j);
394     }
395     else if (vobj->type == ASCII_FILE_VIEWER || vobj->type == ASCII_FILES_VIEWER){
396       return MatView_SeqAIJ_ASCII(A,viewer);
397     }
398     else if (vobj->type == BINARY_FILE_VIEWER) {
399       return MatView_SeqAIJ_Binary(A,viewer);
400     }
401   }
402   else if (vobj->cookie == DRAW_COOKIE) {
403     if (vobj->type == NULLWINDOW) return 0;
404     else return MatView_SeqAIJ_Draw(A,viewer);
405   }
406   return 0;
407 }
408 int Mat_AIJ_CheckInode(Mat);
409 static int MatAssemblyEnd_SeqAIJ(Mat A,MatAssemblyType mode)
410 {
411   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
412   int        fshift = 0,i,j,*ai = a->i, *aj = a->j, *imax = a->imax,ierr;
413   int        m = a->m, *ip, N, *ailen = a->ilen,shift = a->indexshift;
414   Scalar     *aa = a->a, *ap;
415 
416   if (mode == FLUSH_ASSEMBLY) return 0;
417 
418   for ( i=1; i<m; i++ ) {
419     /* move each row back by the amount of empty slots (fshift) before it*/
420     fshift += imax[i-1] - ailen[i-1];
421     if (fshift) {
422       ip = aj + ai[i] + shift; ap = aa + ai[i] + shift;
423       N = ailen[i];
424       for ( j=0; j<N; j++ ) {
425         ip[j-fshift] = ip[j];
426         ap[j-fshift] = ap[j];
427       }
428     }
429     ai[i] = ai[i-1] + ailen[i-1];
430   }
431   if (m) {
432     fshift += imax[m-1] - ailen[m-1];
433     ai[m] = ai[m-1] + ailen[m-1];
434   }
435   /* reset ilen and imax for each row */
436   for ( i=0; i<m; i++ ) {
437     ailen[i] = imax[i] = ai[i+1] - ai[i];
438   }
439   a->nz = ai[m] + shift;
440 
441   /* diagonals may have moved, so kill the diagonal pointers */
442   if (fshift && a->diag) {
443     PetscFree(a->diag);
444     PLogObjectMemory(A,-(m+1)*sizeof(int));
445     a->diag = 0;
446   }
447   /* check out for identical nodes. If found, use inode functions */
448   ierr = Mat_AIJ_CheckInode(A); CHKERRQ(ierr);
449   a->assembled = 1;
450   return 0;
451 }
452 
453 static int MatZeroEntries_SeqAIJ(Mat A)
454 {
455   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
456   PetscMemzero(a->a,(a->i[a->m]+a->indexshift)*sizeof(Scalar));
457   return 0;
458 }
459 
460 int MatDestroy_SeqAIJ(PetscObject obj)
461 {
462   Mat        A  = (Mat) obj;
463   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
464 
465 #if defined(PETSC_LOG)
466   PLogObjectState(obj,"Rows=%d, Cols=%d, NZ=%d",a->m,a->n,a->nz);
467 #endif
468   PetscFree(a->a);
469   if (!a->singlemalloc) { PetscFree(a->i); PetscFree(a->j);}
470   if (a->diag) PetscFree(a->diag);
471   if (a->ilen) PetscFree(a->ilen);
472   if (a->imax) PetscFree(a->imax);
473   if (a->solve_work) PetscFree(a->solve_work);
474   if (a->inode.size) PetscFree(a->inode.size);
475   PetscFree(a);
476   PLogObjectDestroy(A);
477   PetscHeaderDestroy(A);
478   return 0;
479 }
480 
481 static int MatCompress_SeqAIJ(Mat A)
482 {
483   return 0;
484 }
485 
486 static int MatSetOption_SeqAIJ(Mat A,MatOption op)
487 {
488   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
489   if      (op == ROW_ORIENTED)              a->roworiented = 1;
490   else if (op == COLUMN_ORIENTED)           a->roworiented = 0;
491   else if (op == COLUMNS_SORTED)            a->sorted      = 1;
492   else if (op == NO_NEW_NONZERO_LOCATIONS)  a->nonew       = 1;
493   else if (op == YES_NEW_NONZERO_LOCATIONS) a->nonew       = 0;
494   else if (op == ROWS_SORTED ||
495            op == SYMMETRIC_MATRIX ||
496            op == STRUCTURALLY_SYMMETRIC_MATRIX ||
497            op == YES_NEW_DIAGONALS)
498     PLogInfo((PetscObject)A,"Info:MatSetOption_SeqAIJ:Option ignored\n");
499   else if (op == NO_NEW_DIAGONALS)
500     {SETERRQ(PETSC_ERR_SUP,"MatSetOption_SeqAIJ:NO_NEW_DIAGONALS");}
501   else if (op == INODE_LIMIT_1)            a->inode.limit  = 1;
502   else if (op == INODE_LIMIT_2)            a->inode.limit  = 2;
503   else if (op == INODE_LIMIT_3)            a->inode.limit  = 3;
504   else if (op == INODE_LIMIT_4)            a->inode.limit  = 4;
505   else if (op == INODE_LIMIT_5)            a->inode.limit  = 5;
506   else
507     {SETERRQ(PETSC_ERR_SUP,"MatSetOption_SeqAIJ:unknown option");}
508   return 0;
509 }
510 
511 static int MatGetDiagonal_SeqAIJ(Mat A,Vec v)
512 {
513   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
514   int        i,j, n,shift = a->indexshift;
515   Scalar     *x, zero = 0.0;
516 
517   if (!a->assembled) SETERRQ(1,"MatGetDiagonal_SeqAIJ:Not for unassembled matrix");
518   VecSet(&zero,v);
519   VecGetArray(v,&x); VecGetLocalSize(v,&n);
520   if (n != a->m) SETERRQ(1,"MatGetDiagonal_SeqAIJ:Nonconforming matrix and vector");
521   for ( i=0; i<a->m; i++ ) {
522     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
523       if (a->j[j]+shift == i) {
524         x[i] = a->a[j];
525         break;
526       }
527     }
528   }
529   return 0;
530 }
531 
532 /* -------------------------------------------------------*/
533 /* Should check that shapes of vectors and matrices match */
534 /* -------------------------------------------------------*/
535 static int MatMultTrans_SeqAIJ(Mat A,Vec xx,Vec yy)
536 {
537   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
538   Scalar     *x, *y, *v, alpha;
539   int        m = a->m, n, i, *idx, shift = a->indexshift;
540 
541   if (!a->assembled) SETERRQ(1,"MatMultTrans_SeqAIJ:Not for unassembled matrix");
542   VecGetArray(xx,&x); VecGetArray(yy,&y);
543   PetscMemzero(y,a->n*sizeof(Scalar));
544   y = y + shift; /* shift for Fortran start by 1 indexing */
545   for ( i=0; i<m; i++ ) {
546     idx   = a->j + a->i[i] + shift;
547     v     = a->a + a->i[i] + shift;
548     n     = a->i[i+1] - a->i[i];
549     alpha = x[i];
550     while (n-->0) {y[*idx++] += alpha * *v++;}
551   }
552   PLogFlops(2*a->nz - a->n);
553   return 0;
554 }
555 
556 static int MatMultTransAdd_SeqAIJ(Mat A,Vec xx,Vec zz,Vec yy)
557 {
558   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
559   Scalar     *x, *y, *v, alpha;
560   int        m = a->m, n, i, *idx,shift = a->indexshift;
561 
562   if (!a->assembled) SETERRQ(1,"MatMultTransAdd_SeqAIJ:Not for unassembled matrix");
563   VecGetArray(xx,&x); VecGetArray(yy,&y);
564   if (zz != yy) VecCopy(zz,yy);
565   y = y + shift; /* shift for Fortran start by 1 indexing */
566   for ( i=0; i<m; i++ ) {
567     idx   = a->j + a->i[i] + shift;
568     v     = a->a + a->i[i] + shift;
569     n     = a->i[i+1] - a->i[i];
570     alpha = x[i];
571     while (n-->0) {y[*idx++] += alpha * *v++;}
572   }
573   return 0;
574 }
575 
576 static int MatMult_SeqAIJ(Mat A,Vec xx,Vec yy)
577 {
578   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
579   Scalar     *x, *y, *v, sum;
580   int        m = a->m, n, i, *idx, shift = a->indexshift,*ii;
581 
582   if (!a->assembled) SETERRQ(1,"MatMult_SeqAIJ:Not for unassembled matrix");
583   VecGetArray(xx,&x); VecGetArray(yy,&y);
584   x    = x + shift; /* shift for Fortran start by 1 indexing */
585   idx  = a->j;
586   v    = a->a;
587   ii   = a->i;
588   for ( i=0; i<m; i++ ) {
589     n    = ii[1] - ii[0]; ii++;
590     sum  = 0.0;
591     /* SPARSEDENSEDOT(sum,x,v,idx,n);  */
592     /* for ( j=n-1; j>-1; j--) sum += v[j]*x[idx[j]]; */
593     while (n--) sum += *v++ * x[*idx++];
594     y[i] = sum;
595   }
596   PLogFlops(2*a->nz - m);
597   return 0;
598 }
599 
600 static int MatMultAdd_SeqAIJ(Mat A,Vec xx,Vec yy,Vec zz)
601 {
602   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
603   Scalar     *x, *y, *z, *v, sum;
604   int        m = a->m, n, i, *idx, shift = a->indexshift,*ii;
605 
606   if (!a->assembled) SETERRQ(1,"MatMultAdd_SeqAIJ:Not for unassembled matrix");
607   VecGetArray(xx,&x); VecGetArray(yy,&y); VecGetArray(zz,&z);
608   x    = x + shift; /* shift for Fortran start by 1 indexing */
609   idx  = a->j;
610   v    = a->a;
611   ii   = a->i;
612   for ( i=0; i<m; i++ ) {
613     n    = ii[1] - ii[0]; ii++;
614     sum  = y[i];
615     /* SPARSEDENSEDOT(sum,x,v,idx,n);  */
616     while (n--) sum += *v++ * x[*idx++];
617     z[i] = sum;
618   }
619   PLogFlops(2*a->nz);
620   return 0;
621 }
622 
623 /*
624      Adds diagonal pointers to sparse matrix structure.
625 */
626 
627 int MatMarkDiag_SeqAIJ(Mat A)
628 {
629   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
630   int        i,j, *diag, m = a->m,shift = a->indexshift;
631 
632   if (!a->assembled) SETERRQ(1,"MatMarkDiag_SeqAIJ:unassembled matrix");
633   diag = (int *) PetscMalloc( (m+1)*sizeof(int)); CHKPTRQ(diag);
634   PLogObjectMemory(A,(m+1)*sizeof(int));
635   for ( i=0; i<a->m; i++ ) {
636     for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) {
637       if (a->j[j]+shift == i) {
638         diag[i] = j - shift;
639         break;
640       }
641     }
642   }
643   a->diag = diag;
644   return 0;
645 }
646 
647 static int MatRelax_SeqAIJ(Mat A,Vec bb,double omega,MatSORType flag,
648                            double fshift,int its,Vec xx)
649 {
650   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
651   Scalar     *x, *b, *bs,  d, *xs, sum, *v = a->a,*t,scale,*ts, *xb;
652   int        ierr, *idx, *diag,n = a->n, m = a->m, i, shift = a->indexshift;
653 
654   VecGetArray(xx,&x); VecGetArray(bb,&b);
655   if (!a->diag) {if ((ierr = MatMarkDiag_SeqAIJ(A))) return ierr;}
656   diag = a->diag;
657   xs   = x + shift; /* shifted by one for index start of a or a->j*/
658   if (flag == SOR_APPLY_UPPER) {
659    /* apply ( U + D/omega) to the vector */
660     bs = b + shift;
661     for ( i=0; i<m; i++ ) {
662         d    = fshift + a->a[diag[i] + shift];
663         n    = a->i[i+1] - diag[i] - 1;
664         idx  = a->j + diag[i] + (!shift);
665         v    = a->a + diag[i] + (!shift);
666         sum  = b[i]*d/omega;
667         SPARSEDENSEDOT(sum,bs,v,idx,n);
668         x[i] = sum;
669     }
670     return 0;
671   }
672   if (flag == SOR_APPLY_LOWER) {
673     SETERRQ(1,"MatRelax_SeqAIJ:SOR_APPLY_LOWER is not done");
674   }
675   else if (flag & SOR_EISENSTAT) {
676     /* Let  A = L + U + D; where L is lower trianglar,
677     U is upper triangular, E is diagonal; This routine applies
678 
679             (L + E)^{-1} A (U + E)^{-1}
680 
681     to a vector efficiently using Eisenstat's trick. This is for
682     the case of SSOR preconditioner, so E is D/omega where omega
683     is the relaxation factor.
684     */
685     t = (Scalar *) PetscMalloc( m*sizeof(Scalar) ); CHKPTRQ(t);
686     scale = (2.0/omega) - 1.0;
687 
688     /*  x = (E + U)^{-1} b */
689     for ( i=m-1; i>=0; i-- ) {
690       d    = fshift + a->a[diag[i] + shift];
691       n    = a->i[i+1] - diag[i] - 1;
692       idx  = a->j + diag[i] + (!shift);
693       v    = a->a + diag[i] + (!shift);
694       sum  = b[i];
695       SPARSEDENSEMDOT(sum,xs,v,idx,n);
696       x[i] = omega*(sum/d);
697     }
698 
699     /*  t = b - (2*E - D)x */
700     v = a->a;
701     for ( i=0; i<m; i++ ) { t[i] = b[i] - scale*(v[*diag++ + shift])*x[i]; }
702 
703     /*  t = (E + L)^{-1}t */
704     ts = t + shift; /* shifted by one for index start of a or a->j*/
705     diag = a->diag;
706     for ( i=0; i<m; i++ ) {
707       d    = fshift + a->a[diag[i]+shift];
708       n    = diag[i] - a->i[i];
709       idx  = a->j + a->i[i] + shift;
710       v    = a->a + a->i[i] + shift;
711       sum  = t[i];
712       SPARSEDENSEMDOT(sum,ts,v,idx,n);
713       t[i] = omega*(sum/d);
714     }
715 
716     /*  x = x + t */
717     for ( i=0; i<m; i++ ) { x[i] += t[i]; }
718     PetscFree(t);
719     return 0;
720   }
721   if (flag & SOR_ZERO_INITIAL_GUESS) {
722     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
723       for ( i=0; i<m; i++ ) {
724         d    = fshift + a->a[diag[i]+shift];
725         n    = diag[i] - a->i[i];
726         idx  = a->j + a->i[i] + shift;
727         v    = a->a + a->i[i] + shift;
728         sum  = b[i];
729         SPARSEDENSEMDOT(sum,xs,v,idx,n);
730         x[i] = omega*(sum/d);
731       }
732       xb = x;
733     }
734     else xb = b;
735     if ((flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) &&
736         (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP)) {
737       for ( i=0; i<m; i++ ) {
738         x[i] *= a->a[diag[i]+shift];
739       }
740     }
741     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
742       for ( i=m-1; i>=0; i-- ) {
743         d    = fshift + a->a[diag[i] + shift];
744         n    = a->i[i+1] - diag[i] - 1;
745         idx  = a->j + diag[i] + (!shift);
746         v    = a->a + diag[i] + (!shift);
747         sum  = xb[i];
748         SPARSEDENSEMDOT(sum,xs,v,idx,n);
749         x[i] = omega*(sum/d);
750       }
751     }
752     its--;
753   }
754   while (its--) {
755     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
756       for ( i=0; i<m; i++ ) {
757         d    = fshift + a->a[diag[i]+shift];
758         n    = a->i[i+1] - a->i[i];
759         idx  = a->j + a->i[i] + shift;
760         v    = a->a + a->i[i] + shift;
761         sum  = b[i];
762         SPARSEDENSEMDOT(sum,xs,v,idx,n);
763         x[i] = (1. - omega)*x[i] + omega*(sum/d + x[i]);
764       }
765     }
766     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
767       for ( i=m-1; i>=0; i-- ) {
768         d    = fshift + a->a[diag[i] + shift];
769         n    = a->i[i+1] - a->i[i];
770         idx  = a->j + a->i[i] + shift;
771         v    = a->a + a->i[i] + shift;
772         sum  = b[i];
773         SPARSEDENSEMDOT(sum,xs,v,idx,n);
774         x[i] = (1. - omega)*x[i] + omega*(sum/d + x[i]);
775       }
776     }
777   }
778   return 0;
779 }
780 
781 static int MatGetInfo_SeqAIJ(Mat A,MatInfoType flag,int *nz,int *nzalloc,int *mem)
782 {
783   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
784   *nz      = a->nz;
785   *nzalloc = a->maxnz;
786   *mem     = (int)A->mem;
787   return 0;
788 }
789 
790 extern int MatLUFactorSymbolic_SeqAIJ(Mat,IS,IS,double,Mat*);
791 extern int MatLUFactorNumeric_SeqAIJ(Mat,Mat*);
792 extern int MatLUFactor_SeqAIJ(Mat,IS,IS,double);
793 extern int MatSolve_SeqAIJ(Mat,Vec,Vec);
794 extern int MatSolveAdd_SeqAIJ(Mat,Vec,Vec,Vec);
795 extern int MatSolveTrans_SeqAIJ(Mat,Vec,Vec);
796 extern int MatSolveTransAdd_SeqAIJ(Mat,Vec,Vec,Vec);
797 
798 static int MatZeroRows_SeqAIJ(Mat A,IS is,Scalar *diag)
799 {
800   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
801   int         i,ierr,N, *rows,m = a->m - 1,shift = a->indexshift;
802 
803   ierr = ISGetLocalSize(is,&N); CHKERRQ(ierr);
804   ierr = ISGetIndices(is,&rows); CHKERRQ(ierr);
805   if (diag) {
806     for ( i=0; i<N; i++ ) {
807       if (rows[i] < 0 || rows[i] > m) SETERRQ(1,"MatZeroRows_SeqAIJ:row out of range");
808       if (a->ilen[rows[i]] > 0) { /* in case row was completely empty */
809         a->ilen[rows[i]] = 1;
810         a->a[a->i[rows[i]]+shift] = *diag;
811         a->j[a->i[rows[i]]+shift] = rows[i]+shift;
812       }
813       else {
814         ierr = MatSetValues_SeqAIJ(A,1,&rows[i],1,&rows[i],diag,INSERT_VALUES);
815         CHKERRQ(ierr);
816       }
817     }
818   }
819   else {
820     for ( i=0; i<N; i++ ) {
821       if (rows[i] < 0 || rows[i] > m) SETERRQ(1,"MatZeroRows_SeqAIJ:row out of range");
822       a->ilen[rows[i]] = 0;
823     }
824   }
825   ISRestoreIndices(is,&rows);
826   ierr = MatAssemblyBegin(A,FINAL_ASSEMBLY); CHKERRQ(ierr);
827   ierr = MatAssemblyEnd(A,FINAL_ASSEMBLY); CHKERRQ(ierr);
828   return 0;
829 }
830 
831 static int MatGetSize_SeqAIJ(Mat A,int *m,int *n)
832 {
833   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
834   *m = a->m; *n = a->n;
835   return 0;
836 }
837 
838 static int MatGetOwnershipRange_SeqAIJ(Mat A,int *m,int *n)
839 {
840   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
841   *m = 0; *n = a->m;
842   return 0;
843 }
844 static int MatGetRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v)
845 {
846   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
847   int        *itmp,i,ierr,shift = a->indexshift;
848 
849   if (row < 0 || row >= a->m) SETERRQ(1,"MatGetRow_SeqAIJ:Row out of range");
850 
851   if (!a->assembled) {
852     ierr = MatAssemblyBegin(A,FINAL_ASSEMBLY); CHKERRQ(ierr);
853     ierr = MatAssemblyEnd(A,FINAL_ASSEMBLY); CHKERRQ(ierr);
854   }
855   *nz = a->i[row+1] - a->i[row];
856   if (v) *v = a->a + a->i[row] + shift;
857   if (idx) {
858     if (*nz) {
859       itmp = a->j + a->i[row] + shift;
860       *idx = (int *) PetscMalloc( (*nz)*sizeof(int) ); CHKPTRQ(*idx);
861       for ( i=0; i<(*nz); i++ ) {(*idx)[i] = itmp[i] + shift;}
862     }
863     else *idx = 0;
864   }
865   return 0;
866 }
867 
868 static int MatRestoreRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v)
869 {
870   if (idx) {if (*idx) PetscFree(*idx);}
871   return 0;
872 }
873 
874 static int MatNorm_SeqAIJ(Mat A,NormType type,double *norm)
875 {
876   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
877   Scalar     *v = a->a;
878   double     sum = 0.0;
879   int        i, j,shift = a->indexshift;
880 
881   if (!a->assembled) SETERRQ(1,"MatNorm_SeqAIJ:Not for unassembled matrix");
882   if (type == NORM_FROBENIUS) {
883     for (i=0; i<a->nz; i++ ) {
884 #if defined(PETSC_COMPLEX)
885       sum += real(conj(*v)*(*v)); v++;
886 #else
887       sum += (*v)*(*v); v++;
888 #endif
889     }
890     *norm = sqrt(sum);
891   }
892   else if (type == NORM_1) {
893     double *tmp;
894     int    *jj = a->j;
895     tmp = (double *) PetscMalloc( a->n*sizeof(double) ); CHKPTRQ(tmp);
896     PetscMemzero(tmp,a->n*sizeof(double));
897     *norm = 0.0;
898     for ( j=0; j<a->nz; j++ ) {
899         tmp[*jj++ + shift] += PetscAbsScalar(*v);  v++;
900     }
901     for ( j=0; j<a->n; j++ ) {
902       if (tmp[j] > *norm) *norm = tmp[j];
903     }
904     PetscFree(tmp);
905   }
906   else if (type == NORM_INFINITY) {
907     *norm = 0.0;
908     for ( j=0; j<a->m; j++ ) {
909       v = a->a + a->i[j] + shift;
910       sum = 0.0;
911       for ( i=0; i<a->i[j+1]-a->i[j]; i++ ) {
912         sum += PetscAbsScalar(*v); v++;
913       }
914       if (sum > *norm) *norm = sum;
915     }
916   }
917   else {
918     SETERRQ(1,"MatNorm_SeqAIJ:No support for two norm yet");
919   }
920   return 0;
921 }
922 
923 static int MatTranspose_SeqAIJ(Mat A,Mat *B)
924 {
925   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
926   Mat        C;
927   int        i, ierr, *aj = a->j, *ai = a->i, m = a->m, len, *col;
928   int        shift = a->indexshift;
929   Scalar     *array = a->a;
930 
931   if (!B && m != a->n) SETERRQ(1,"MatTranspose_SeqAIJ:Not for rectangular mat in place");
932   col = (int *) PetscMalloc((1+a->n)*sizeof(int)); CHKPTRQ(col);
933   PetscMemzero(col,(1+a->n)*sizeof(int));
934   if (shift) {
935     for ( i=0; i<ai[m]-1; i++ ) aj[i] -= 1;
936   }
937   for ( i=0; i<ai[m]+shift; i++ ) col[aj[i]] += 1;
938   ierr = MatCreateSeqAIJ(A->comm,a->n,m,0,col,&C); CHKERRQ(ierr);
939   PetscFree(col);
940   for ( i=0; i<m; i++ ) {
941     len = ai[i+1]-ai[i];
942     ierr = MatSetValues(C,len,aj,1,&i,array,INSERT_VALUES); CHKERRQ(ierr);
943     array += len; aj += len;
944   }
945   if (shift) {
946     for ( i=0; i<ai[m]-1; i++ ) aj[i] += 1;
947   }
948 
949   ierr = MatAssemblyBegin(C,FINAL_ASSEMBLY); CHKERRQ(ierr);
950   ierr = MatAssemblyEnd(C,FINAL_ASSEMBLY); CHKERRQ(ierr);
951 
952   if (B) {
953     *B = C;
954   } else {
955     /* This isn't really an in-place transpose */
956     PetscFree(a->a);
957     if (!a->singlemalloc) {PetscFree(a->i); PetscFree(a->j);}
958     if (a->diag) PetscFree(a->diag);
959     if (a->ilen) PetscFree(a->ilen);
960     if (a->imax) PetscFree(a->imax);
961     if (a->solve_work) PetscFree(a->solve_work);
962     PetscFree(a);
963     PetscMemcpy(A,C,sizeof(struct _Mat));
964     PetscHeaderDestroy(C);
965   }
966   return 0;
967 }
968 
969 static int MatScale_SeqAIJ(Mat A,Vec ll,Vec rr)
970 {
971   Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
972   Scalar     *l,*r,x,*v;
973   int        i,j,m = a->m, n = a->n, M, nz = a->nz, *jj,shift = a->indexshift;
974 
975   if (!a->assembled) SETERRQ(1,"MatScale_SeqAIJ:Not for unassembled matrix");
976   if (ll) {
977     VecGetArray(ll,&l); VecGetSize(ll,&m);
978     if (m != a->m) SETERRQ(1,"MatScale_SeqAIJ:Left scaling vector wrong length");
979     v = a->a;
980     for ( i=0; i<m; i++ ) {
981       x = l[i];
982       M = a->i[i+1] - a->i[i];
983       for ( j=0; j<M; j++ ) { (*v++) *= x;}
984     }
985   }
986   if (rr) {
987     VecGetArray(rr,&r); VecGetSize(rr,&n);
988     if (n != a->n) SETERRQ(1,"MatScale_SeqAIJ:Right scaling vector wrong length");
989     v = a->a; jj = a->j;
990     for ( i=0; i<nz; i++ ) {
991       (*v++) *= r[*jj++ + shift];
992     }
993   }
994   return 0;
995 }
996 
997 static int MatGetSubMatrix_SeqAIJ(Mat A,IS isrow,IS iscol,MatGetSubMatrixCall scall,Mat *B)
998 {
999   Mat_SeqAIJ   *a = (Mat_SeqAIJ *) A->data,*c;
1000   int          nznew, *smap, i, k, kstart, kend, ierr, oldcols = a->n,*lens;
1001   register int sum,lensi;
1002   int          *irow, *icol, nrows, ncols, *cwork, shift = a->indexshift,*ssmap;
1003   int          first,step,*starts,*j_new,*i_new,*aj = a->j, *ai = a->i,ii,*ailen = a->ilen;
1004   Scalar       *vwork,*a_new;
1005   Mat          C;
1006 
1007   if (!a->assembled) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:Not for unassembled matrix");
1008   ierr = ISGetIndices(isrow,&irow); CHKERRQ(ierr);
1009   ierr = ISGetSize(isrow,&nrows); CHKERRQ(ierr);
1010   ierr = ISGetSize(iscol,&ncols); CHKERRQ(ierr);
1011 
1012   if (ISStrideGetInfo(iscol,&first,&step) && step == 1) {
1013     /* special case of contiguous rows */
1014     lens   = (int *) PetscMalloc((2*ncols+1)*sizeof(int)); CHKPTRQ(lens);
1015     starts = lens + ncols;
1016     /* loop over new rows determining lens and starting points */
1017     for (i=0; i<nrows; i++) {
1018       kstart  = ai[irow[i]]+shift;
1019       kend    = kstart + ailen[irow[i]];
1020       for ( k=kstart; k<kend; k++ ) {
1021         if (aj[k]+shift >= first) {
1022           starts[i] = k;
1023           break;
1024 	}
1025       }
1026       sum = 0;
1027       while (k < kend) {
1028         if (aj[k++]+shift >= first+ncols) break;
1029         sum++;
1030       }
1031       lens[i] = sum;
1032     }
1033     /* create submatrix */
1034     if (scall == MAT_REUSE_MATRIX) {
1035       int n_cols,n_rows;
1036       ierr = MatGetSize(*B,&n_rows,&n_cols); CHKERRQ(ierr);
1037       if (n_rows != nrows || n_cols != ncols) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:");
1038       ierr = MatZeroEntries(*B); CHKERRQ(ierr);
1039       C = *B;
1040     }
1041     else {
1042       ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr);
1043     }
1044     c = (Mat_SeqAIJ*) C->data;
1045 
1046     /* loop over rows inserting into submatrix */
1047     a_new    = c->a;
1048     j_new    = c->j;
1049     i_new    = c->i;
1050     i_new[0] = -shift;
1051     for (i=0; i<nrows; i++) {
1052       ii    = starts[i];
1053       lensi = lens[i];
1054       for ( k=0; k<lensi; k++ ) {
1055         *j_new++ = aj[ii+k] - first;
1056       }
1057       PetscMemcpy(a_new,a->a + starts[i],lensi*sizeof(Scalar));
1058       a_new      += lensi;
1059       i_new[i+1]  = i_new[i] + lensi;
1060       c->ilen[i]  = lensi;
1061     }
1062     PetscFree(lens);
1063   }
1064   else {
1065     ierr = ISGetIndices(iscol,&icol); CHKERRQ(ierr);
1066     smap  = (int *) PetscMalloc((1+oldcols)*sizeof(int)); CHKPTRQ(smap);
1067     ssmap = smap + shift;
1068     cwork = (int *) PetscMalloc((1+nrows+ncols)*sizeof(int)); CHKPTRQ(cwork);
1069     lens  = cwork + ncols;
1070     vwork = (Scalar *) PetscMalloc((1+ncols)*sizeof(Scalar)); CHKPTRQ(vwork);
1071     PetscMemzero(smap,oldcols*sizeof(int));
1072     for ( i=0; i<ncols; i++ ) smap[icol[i]] = i+1;
1073     /* determine lens of each row */
1074     for (i=0; i<nrows; i++) {
1075       kstart  = ai[irow[i]]+shift;
1076       kend    = kstart + a->ilen[irow[i]];
1077       lens[i] = 0;
1078       for ( k=kstart; k<kend; k++ ) {
1079         if (ssmap[aj[k]]) {
1080           lens[i]++;
1081         }
1082       }
1083     }
1084     /* Create and fill new matrix */
1085     if (scall == MAT_REUSE_MATRIX) {
1086       int n_cols,n_rows;
1087       ierr = MatGetSize(*B,&n_rows,&n_cols); CHKERRQ(ierr);
1088       if (n_rows != nrows || n_cols != ncols) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:");
1089       ierr = MatZeroEntries(*B); CHKERRQ(ierr);
1090       C = *B;
1091     }
1092     else {
1093       ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr);
1094     }
1095     for (i=0; i<nrows; i++) {
1096       nznew  = 0;
1097       kstart = ai[irow[i]]+shift;
1098       kend   = kstart + a->ilen[irow[i]];
1099       for ( k=kstart; k<kend; k++ ) {
1100         if (ssmap[a->j[k]]) {
1101           cwork[nznew]   = ssmap[a->j[k]] - 1;
1102           vwork[nznew++] = a->a[k];
1103         }
1104       }
1105       ierr = MatSetValues(C,1,&i,nznew,cwork,vwork,INSERT_VALUES); CHKERRQ(ierr);
1106     }
1107     /* Free work space */
1108     ierr = ISRestoreIndices(iscol,&icol); CHKERRQ(ierr);
1109     PetscFree(smap); PetscFree(cwork); PetscFree(vwork);
1110   }
1111   ierr = MatAssemblyBegin(C,FINAL_ASSEMBLY); CHKERRQ(ierr);
1112   ierr = MatAssemblyEnd(C,FINAL_ASSEMBLY); CHKERRQ(ierr);
1113 
1114   ierr = ISRestoreIndices(isrow,&irow); CHKERRQ(ierr);
1115   *B = C;
1116   return 0;
1117 }
1118 
1119 /*
1120      note: This can only work for identity for row and col. It would
1121    be good to check this and otherwise generate an error.
1122 */
1123 static int MatILUFactor_SeqAIJ(Mat inA,IS row,IS col,double efill,int fill)
1124 {
1125   Mat_SeqAIJ *a = (Mat_SeqAIJ *) inA->data;
1126   int        ierr;
1127   Mat        outA;
1128 
1129   if (fill != 0) SETERRQ(1,"MatILUFactor_SeqAIJ:Only fill=0 supported");
1130 
1131   outA          = inA;
1132   inA->factor   = FACTOR_LU;
1133   a->row        = row;
1134   a->col        = col;
1135 
1136   a->solve_work = (Scalar *) PetscMalloc( (a->m+1)*sizeof(Scalar)); CHKPTRQ(a->solve_work);
1137 
1138   if (!a->diag) {
1139     ierr = MatMarkDiag_SeqAIJ(inA); CHKERRQ(ierr);
1140   }
1141   ierr = MatLUFactorNumeric_SeqAIJ(inA,&outA); CHKERRQ(ierr);
1142   return 0;
1143 }
1144 
1145 static int MatGetSubMatrices_SeqAIJ(Mat A,int n, IS *irow,IS *icol,MatGetSubMatrixCall scall,
1146                                     Mat **B)
1147 {
1148   int ierr,i;
1149 
1150   if (scall == MAT_INITIAL_MATRIX) {
1151     *B = (Mat *) PetscMalloc( (n+1)*sizeof(Mat) ); CHKPTRQ(*B);
1152   }
1153 
1154   for ( i=0; i<n; i++ ) {
1155     ierr = MatGetSubMatrix(A,irow[i],icol[i],scall,&(*B)[i]); CHKERRQ(ierr);
1156   }
1157   return 0;
1158 }
1159 
1160 static int MatIncreaseOverlap_SeqAIJ(Mat A, int n, IS *is, int ov)
1161 {
1162   int i,m,*idx,ierr;
1163 
1164   for ( i=0; i<n; i++ ) {
1165     ierr = ISGetIndices(is[i],&idx); CHKERRQ(ierr);
1166     ISGetLocalSize(is[i],&m);
1167   }
1168   SETERRQ(1,"MatIncreaseOverlap_SeqAIJ:Not implemented");
1169 }
1170 
1171 int MatPrintHelp_SeqAIJ(Mat A)
1172 {
1173   static int called = 0;
1174   MPI_Comm   comm = A->comm;
1175 
1176   if (called) return 0; else called = 1;
1177   MPIU_printf(comm," Options for MATSEQAIJ and MATMPIAIJ matrix formats (the defaults):\n");
1178   MPIU_printf(comm,"  -mat_lu_pivotthreshold <threshold>\n");
1179   MPIU_printf(comm,"  -mat_aij_oneindex - internal indices begin at 1 instead of the default 0.\n");
1180   MPIU_printf(comm,"  -mat_aij_no_inode  - Do not use inodes\n");
1181   MPIU_printf(comm,"  -mat_aij_inode_limit <limit> - Set inode limit (max limit=5)\n");
1182 #if defined(HAVE_ESSL)
1183   MPIU_printf(comm,"  -mat_aij_essl  - Use IBM sparse LU factorization and solve.\n");
1184 #endif
1185   return 0;
1186 }
1187 /* -------------------------------------------------------------------*/
1188 static struct _MatOps MatOps = {MatSetValues_SeqAIJ,
1189        MatGetRow_SeqAIJ,MatRestoreRow_SeqAIJ,
1190        MatMult_SeqAIJ,MatMultAdd_SeqAIJ,
1191        MatMultTrans_SeqAIJ,MatMultTransAdd_SeqAIJ,
1192        MatSolve_SeqAIJ,MatSolveAdd_SeqAIJ,
1193        MatSolveTrans_SeqAIJ,MatSolveTransAdd_SeqAIJ,
1194        MatLUFactor_SeqAIJ,0,
1195        MatRelax_SeqAIJ,
1196        MatTranspose_SeqAIJ,
1197        MatGetInfo_SeqAIJ,0,
1198        MatGetDiagonal_SeqAIJ,MatScale_SeqAIJ,MatNorm_SeqAIJ,
1199        0,MatAssemblyEnd_SeqAIJ,
1200        MatCompress_SeqAIJ,
1201        MatSetOption_SeqAIJ,MatZeroEntries_SeqAIJ,MatZeroRows_SeqAIJ,
1202        MatGetReordering_SeqAIJ,
1203        MatLUFactorSymbolic_SeqAIJ,MatLUFactorNumeric_SeqAIJ,0,0,
1204        MatGetSize_SeqAIJ,MatGetSize_SeqAIJ,MatGetOwnershipRange_SeqAIJ,
1205        MatILUFactorSymbolic_SeqAIJ,0,
1206        0,0,MatConvert_SeqAIJ,
1207        MatGetSubMatrix_SeqAIJ,0,
1208        MatConvertSameType_SeqAIJ,0,0,
1209        MatILUFactor_SeqAIJ,0,0,
1210        MatGetSubMatrices_SeqAIJ,MatIncreaseOverlap_SeqAIJ,
1211        MatGetValues_SeqAIJ,0,
1212        MatPrintHelp_SeqAIJ};
1213 
1214 extern int MatUseSuperLU_SeqAIJ(Mat);
1215 extern int MatUseEssl_SeqAIJ(Mat);
1216 extern int MatUseDXML_SeqAIJ(Mat);
1217 
1218 /*@C
1219    MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format
1220                      (the default uniprocessor PETSc format).
1221 
1222    Input Parameters:
1223 .  comm - MPI communicator, set to MPI_COMM_SELF
1224 .  m - number of rows
1225 .  n - number of columns
1226 .  nz - number of nonzeros per row (same for all rows)
1227 .  nzz - number of nonzeros per row or null (possibly different for each row)
1228 
1229    Output Parameter:
1230 .  A - the matrix
1231 
1232    Notes:
1233    The AIJ format (also called the Yale sparse matrix format or
1234    compressed row storage), is fully compatible with standard Fortran 77
1235    storage.  That is, the stored row and column indices can begin at
1236    either one (as in Fortran) or zero.  See the users manual for details.
1237 
1238    Specify the preallocated storage with either nz or nnz (not both).
1239    Set nz=PETSC_DEFAULT and nnz=PETSC_NULL for PETSc to control dynamic memory
1240    allocation.
1241 
1242    By default, this format uses inodes (identical nodes) when possible, to
1243    improve numerical efficiency of Matrix vector products and solves. We
1244    search for consecutive rows with the same nonzero structure, thereby
1245    reusing matrix information to achieve increased efficiency.
1246 
1247    Options Database Keys:
1248 $    -mat_aij_no_inode  - Do not use inodes
1249 $    -mat_aij_inode_limit <limit> - Set inode limit (max limit=5)
1250 $    -mat_aij_oneindex - Internally using indexing starting at 1 rather then zero.
1251 .                        Note: You still index entries starting at 0!
1252 
1253 .seealso: MatCreate(), MatCreateMPIAIJ(), MatSetValues()
1254 @*/
1255 int MatCreateSeqAIJ(MPI_Comm comm,int m,int n,int nz,int *nnz, Mat *A)
1256 {
1257   Mat        B;
1258   Mat_SeqAIJ *b;
1259   int        i,len,ierr, flg;
1260 
1261   *A      = 0;
1262   PetscHeaderCreate(B,_Mat,MAT_COOKIE,MATSEQAIJ,comm);
1263   PLogObjectCreate(B);
1264   B->data             = (void *) (b = PetscNew(Mat_SeqAIJ)); CHKPTRQ(b);
1265   PetscMemcpy(&B->ops,&MatOps,sizeof(struct _MatOps));
1266   B->destroy          = MatDestroy_SeqAIJ;
1267   B->view             = MatView_SeqAIJ;
1268   B->factor           = 0;
1269   B->lupivotthreshold = 1.0;
1270   ierr = OptionsGetDouble(PETSC_NULL,"-mat_lu_pivotthreshold",&B->lupivotthreshold, \
1271                           &flg); CHKERRQ(ierr);
1272   b->row              = 0;
1273   b->col              = 0;
1274   b->indexshift       = 0;
1275   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_oneindex", &flg); CHKERRQ(ierr);
1276   if (flg) b->indexshift = -1;
1277 
1278   b->m       = m;
1279   b->n       = n;
1280   b->imax    = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(b->imax);
1281   if (nnz == PETSC_NULL) {
1282     if (nz == PETSC_DEFAULT) nz = 10;
1283     else if (nz <= 0)        nz = 1;
1284     for ( i=0; i<m; i++ ) b->imax[i] = nz;
1285     nz = nz*m;
1286   }
1287   else {
1288     nz = 0;
1289     for ( i=0; i<m; i++ ) {b->imax[i] = nnz[i]; nz += nnz[i];}
1290   }
1291 
1292   /* allocate the matrix space */
1293   len     = nz*(sizeof(int) + sizeof(Scalar)) + (b->m+1)*sizeof(int);
1294   b->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
1295   b->j  = (int *) (b->a + nz);
1296   PetscMemzero(b->j,nz*sizeof(int));
1297   b->i  = b->j + nz;
1298   b->singlemalloc = 1;
1299 
1300   b->i[0] = -b->indexshift;
1301   for (i=1; i<m+1; i++) {
1302     b->i[i] = b->i[i-1] + b->imax[i-1];
1303   }
1304 
1305   /* b->ilen will count nonzeros in each row so far. */
1306   b->ilen = (int *) PetscMalloc((m+1)*sizeof(int));
1307   PLogObjectMemory(B,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ));
1308   for ( i=0; i<b->m; i++ ) { b->ilen[i] = 0;}
1309 
1310   b->nz               = 0;
1311   b->maxnz            = nz;
1312   b->sorted           = 0;
1313   b->roworiented      = 1;
1314   b->nonew            = 0;
1315   b->diag             = 0;
1316   b->assembled        = 0;
1317   b->solve_work       = 0;
1318   b->spptr            = 0;
1319   b->inode.node_count = 0;
1320   b->inode.size       = 0;
1321   b->inode.limit      = 5;
1322   b->inode.max_limit  = 5;
1323 
1324   *A = B;
1325   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_superlu", &flg); CHKERRQ(ierr);
1326   if (flg) { ierr = MatUseSuperLU_SeqAIJ(B); CHKERRQ(ierr); }
1327   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_essl", &flg); CHKERRQ(ierr);
1328   if (flg) { ierr = MatUseEssl_SeqAIJ(B); CHKERRQ(ierr); }
1329   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_dxml", &flg); CHKERRQ(ierr);
1330   if (flg) {
1331     if (!b->indexshift) SETERRQ(1,"MatCreateSeqAIJ:need -mat_aij_oneindex with -mat_aij_dxml");
1332     ierr = MatUseDXML_SeqAIJ(B); CHKERRQ(ierr);
1333   }
1334   ierr = OptionsHasName(PETSC_NULL,"-help", &flg); CHKERRQ(ierr);
1335   if (flg) {ierr = MatPrintHelp(B); CHKERRQ(ierr); }
1336   return 0;
1337 }
1338 
1339 int MatConvertSameType_SeqAIJ(Mat A,Mat *B,int cpvalues)
1340 {
1341   Mat        C;
1342   Mat_SeqAIJ *c,*a = (Mat_SeqAIJ *) A->data;
1343   int        i,len, m = a->m,shift = a->indexshift;
1344 
1345   *B = 0;
1346   if (!a->assembled) SETERRQ(1,"MatConvertSameType_SeqAIJ:Cannot copy unassembled matrix");
1347   PetscHeaderCreate(C,_Mat,MAT_COOKIE,MATSEQAIJ,A->comm);
1348   PLogObjectCreate(C);
1349   C->data       = (void *) (c = PetscNew(Mat_SeqAIJ)); CHKPTRQ(c);
1350   PetscMemcpy(&C->ops,&A->ops,sizeof(struct _MatOps));
1351   C->destroy    = MatDestroy_SeqAIJ;
1352   C->view       = MatView_SeqAIJ;
1353   C->factor     = A->factor;
1354   c->row        = 0;
1355   c->col        = 0;
1356   c->indexshift = shift;
1357 
1358   c->m          = a->m;
1359   c->n          = a->n;
1360 
1361   c->imax       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->imax);
1362   c->ilen       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->ilen);
1363   for ( i=0; i<m; i++ ) {
1364     c->imax[i] = a->imax[i];
1365     c->ilen[i] = a->ilen[i];
1366   }
1367 
1368   /* allocate the matrix space */
1369   c->singlemalloc = 1;
1370   len     = (m+1)*sizeof(int)+(a->i[m])*(sizeof(Scalar)+sizeof(int));
1371   c->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(c->a);
1372   c->j  = (int *) (c->a + a->i[m] + shift);
1373   c->i  = c->j + a->i[m] + shift;
1374   PetscMemcpy(c->i,a->i,(m+1)*sizeof(int));
1375   if (m > 0) {
1376     PetscMemcpy(c->j,a->j,(a->i[m]+shift)*sizeof(int));
1377     if (cpvalues == COPY_VALUES) {
1378       PetscMemcpy(c->a,a->a,(a->i[m]+shift)*sizeof(Scalar));
1379     }
1380   }
1381 
1382   PLogObjectMemory(C,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ));
1383   c->sorted      = a->sorted;
1384   c->roworiented = a->roworiented;
1385   c->nonew       = a->nonew;
1386 
1387   if (a->diag) {
1388     c->diag = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(c->diag);
1389     PLogObjectMemory(C,(m+1)*sizeof(int));
1390     for ( i=0; i<m; i++ ) {
1391       c->diag[i] = a->diag[i];
1392     }
1393   }
1394   else c->diag          = 0;
1395   c->inode.limit        = a->inode.limit;
1396   c->inode.max_limit    = a->inode.max_limit;
1397   if (a->inode.size){
1398     c->inode.size       = (int *) PetscMalloc( m *sizeof(int) ); CHKPTRQ(c->inode.size);
1399     c->inode.node_count = a->inode.node_count;
1400     PetscMemcpy( c->inode.size, a->inode.size, m*sizeof(int));
1401   } else {
1402     c->inode.size       = 0;
1403     c->inode.node_count = 0;
1404   }
1405   c->assembled          = 1;
1406   c->nz                 = a->nz;
1407   c->maxnz              = a->maxnz;
1408   c->solve_work         = 0;
1409   c->spptr              = 0;      /* Dangerous -I'm throwing away a->spptr */
1410 
1411   *B = C;
1412   return 0;
1413 }
1414 
1415 int MatLoad_SeqAIJ(Viewer bview,MatType type,Mat *A)
1416 {
1417   Mat_SeqAIJ   *a;
1418   Mat          B;
1419   int          i, nz, ierr, fd, header[4],size,*rowlengths = 0,M,N,shift;
1420   PetscObject  vobj = (PetscObject) bview;
1421   MPI_Comm     comm = vobj->comm;
1422 
1423   MPI_Comm_size(comm,&size);
1424   if (size > 1) SETERRQ(1,"MatLoad_SeqAIJ:view must have one processor");
1425   ierr = ViewerFileGetDescriptor_Private(bview,&fd); CHKERRQ(ierr);
1426   ierr = SYRead(fd,header,4,SYINT); CHKERRQ(ierr);
1427   if (header[0] != MAT_COOKIE) SETERRQ(1,"MatLoad_SeqAIJ:not matrix object in file");
1428   M = header[1]; N = header[2]; nz = header[3];
1429 
1430   /* read in row lengths */
1431   rowlengths = (int*) PetscMalloc( M*sizeof(int) ); CHKPTRQ(rowlengths);
1432   ierr = SYRead(fd,rowlengths,M,SYINT); CHKERRQ(ierr);
1433 
1434   /* create our matrix */
1435   ierr = MatCreateSeqAIJ(comm,M,N,0,rowlengths,A); CHKERRQ(ierr);
1436   B = *A;
1437   a = (Mat_SeqAIJ *) B->data;
1438   shift = a->indexshift;
1439 
1440   /* read in column indices and adjust for Fortran indexing*/
1441   ierr = SYRead(fd,a->j,nz,SYINT); CHKERRQ(ierr);
1442   if (shift) {
1443     for ( i=0; i<nz; i++ ) {
1444       a->j[i] += 1;
1445     }
1446   }
1447 
1448   /* read in nonzero values */
1449   ierr = SYRead(fd,a->a,nz,SYSCALAR); CHKERRQ(ierr);
1450 
1451   /* set matrix "i" values */
1452   a->i[0] = -shift;
1453   for ( i=1; i<= M; i++ ) {
1454     a->i[i]      = a->i[i-1] + rowlengths[i-1];
1455     a->ilen[i-1] = rowlengths[i-1];
1456   }
1457   PetscFree(rowlengths);
1458 
1459   ierr = MatAssemblyBegin(B,FINAL_ASSEMBLY); CHKERRQ(ierr);
1460   ierr = MatAssemblyEnd(B,FINAL_ASSEMBLY); CHKERRQ(ierr);
1461   return 0;
1462 }
1463 
1464 
1465 
1466