xref: /petsc/src/mat/impls/aij/seq/aij.c (revision ee0de897fec99be7c10c7637bbd068d61b2ce625)
1 #ifndef lint
2 static char vcid[] = "$Id: aij.c,v 1.134 1996/01/12 21:36:32 balay Exp bsmith $";
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:Not for 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 MatDiagonalScale_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,"MatDiagonalScale_SeqAIJ:Not for unassembled matrix");
976   if (ll) {
977     VecGetArray(ll,&l); VecGetSize(ll,&m);
978     if (m != a->m) SETERRQ(1,"MatDiagonalScale_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,"MatDiagonalScale_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 #include "pinclude/plapack.h"
1146 static int MatScale_SeqAIJ(Scalar *alpha,Mat inA)
1147 {
1148   Mat_SeqAIJ *a = (Mat_SeqAIJ *) inA->data;
1149   int        one = 1;
1150   if (!a->assembled) SETERRQ(1,"MatScale_SeqAIJ:Not for unassembled matrix");
1151   BLscal_( &a->nz, alpha, a->a, &one );
1152   PLogFlops(a->nz);
1153   return 0;
1154 }
1155 
1156 static int MatGetSubMatrices_SeqAIJ(Mat A,int n, IS *irow,IS *icol,MatGetSubMatrixCall scall,
1157                                     Mat **B)
1158 {
1159   int ierr,i;
1160 
1161   if (scall == MAT_INITIAL_MATRIX) {
1162     *B = (Mat *) PetscMalloc( (n+1)*sizeof(Mat) ); CHKPTRQ(*B);
1163   }
1164 
1165   for ( i=0; i<n; i++ ) {
1166     ierr = MatGetSubMatrix(A,irow[i],icol[i],scall,&(*B)[i]); CHKERRQ(ierr);
1167   }
1168   return 0;
1169 }
1170 
1171 static int MatIncreaseOverlap_SeqAIJ(Mat A, int n, IS *is, int ov)
1172 {
1173   int i,m,*idx,ierr;
1174 
1175   for ( i=0; i<n; i++ ) {
1176     ierr = ISGetIndices(is[i],&idx); CHKERRQ(ierr);
1177     ISGetLocalSize(is[i],&m);
1178   }
1179   SETERRQ(1,"MatIncreaseOverlap_SeqAIJ:Not implemented");
1180 }
1181 
1182 int MatPrintHelp_SeqAIJ(Mat A)
1183 {
1184   static int called = 0;
1185   MPI_Comm   comm = A->comm;
1186 
1187   if (called) return 0; else called = 1;
1188   MPIU_printf(comm," Options for MATSEQAIJ and MATMPIAIJ matrix formats (the defaults):\n");
1189   MPIU_printf(comm,"  -mat_lu_pivotthreshold <threshold>\n");
1190   MPIU_printf(comm,"  -mat_aij_oneindex - internal indices begin at 1 instead of the default 0.\n");
1191   MPIU_printf(comm,"  -mat_aij_no_inode  - Do not use inodes\n");
1192   MPIU_printf(comm,"  -mat_aij_inode_limit <limit> - Set inode limit (max limit=5)\n");
1193 #if defined(HAVE_ESSL)
1194   MPIU_printf(comm,"  -mat_aij_essl  - Use IBM sparse LU factorization and solve.\n");
1195 #endif
1196   return 0;
1197 }
1198 /* -------------------------------------------------------------------*/
1199 static struct _MatOps MatOps = {MatSetValues_SeqAIJ,
1200        MatGetRow_SeqAIJ,MatRestoreRow_SeqAIJ,
1201        MatMult_SeqAIJ,MatMultAdd_SeqAIJ,
1202        MatMultTrans_SeqAIJ,MatMultTransAdd_SeqAIJ,
1203        MatSolve_SeqAIJ,MatSolveAdd_SeqAIJ,
1204        MatSolveTrans_SeqAIJ,MatSolveTransAdd_SeqAIJ,
1205        MatLUFactor_SeqAIJ,0,
1206        MatRelax_SeqAIJ,
1207        MatTranspose_SeqAIJ,
1208        MatGetInfo_SeqAIJ,0,
1209        MatGetDiagonal_SeqAIJ,MatDiagonalScale_SeqAIJ,MatNorm_SeqAIJ,
1210        0,MatAssemblyEnd_SeqAIJ,
1211        MatCompress_SeqAIJ,
1212        MatSetOption_SeqAIJ,MatZeroEntries_SeqAIJ,MatZeroRows_SeqAIJ,
1213        MatGetReordering_SeqAIJ,
1214        MatLUFactorSymbolic_SeqAIJ,MatLUFactorNumeric_SeqAIJ,0,0,
1215        MatGetSize_SeqAIJ,MatGetSize_SeqAIJ,MatGetOwnershipRange_SeqAIJ,
1216        MatILUFactorSymbolic_SeqAIJ,0,
1217        0,0,MatConvert_SeqAIJ,
1218        MatGetSubMatrix_SeqAIJ,0,
1219        MatConvertSameType_SeqAIJ,0,0,
1220        MatILUFactor_SeqAIJ,0,0,
1221        MatGetSubMatrices_SeqAIJ,MatIncreaseOverlap_SeqAIJ,
1222        MatGetValues_SeqAIJ,0,
1223        MatPrintHelp_SeqAIJ,
1224        MatScale_SeqAIJ};
1225 
1226 extern int MatUseSuperLU_SeqAIJ(Mat);
1227 extern int MatUseEssl_SeqAIJ(Mat);
1228 extern int MatUseDXML_SeqAIJ(Mat);
1229 
1230 /*@C
1231    MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format
1232                      (the default uniprocessor PETSc format).
1233 
1234    Input Parameters:
1235 .  comm - MPI communicator, set to MPI_COMM_SELF
1236 .  m - number of rows
1237 .  n - number of columns
1238 .  nz - number of nonzeros per row (same for all rows)
1239 .  nzz - number of nonzeros per row or null (possibly different for each row)
1240 
1241    Output Parameter:
1242 .  A - the matrix
1243 
1244    Notes:
1245    The AIJ format (also called the Yale sparse matrix format or
1246    compressed row storage), is fully compatible with standard Fortran 77
1247    storage.  That is, the stored row and column indices can begin at
1248    either one (as in Fortran) or zero.  See the users manual for details.
1249 
1250    Specify the preallocated storage with either nz or nnz (not both).
1251    Set nz=PETSC_DEFAULT and nnz=PETSC_NULL for PETSc to control dynamic memory
1252    allocation.
1253 
1254    By default, this format uses inodes (identical nodes) when possible, to
1255    improve numerical efficiency of Matrix vector products and solves. We
1256    search for consecutive rows with the same nonzero structure, thereby
1257    reusing matrix information to achieve increased efficiency.
1258 
1259    Options Database Keys:
1260 $    -mat_aij_no_inode  - Do not use inodes
1261 $    -mat_aij_inode_limit <limit> - Set inode limit (max limit=5)
1262 $    -mat_aij_oneindex - Internally using indexing starting at 1 rather then zero.
1263 .                        Note: You still index entries starting at 0!
1264 
1265 .seealso: MatCreate(), MatCreateMPIAIJ(), MatSetValues()
1266 @*/
1267 int MatCreateSeqAIJ(MPI_Comm comm,int m,int n,int nz,int *nnz, Mat *A)
1268 {
1269   Mat        B;
1270   Mat_SeqAIJ *b;
1271   int        i,len,ierr, flg;
1272 
1273   *A      = 0;
1274   PetscHeaderCreate(B,_Mat,MAT_COOKIE,MATSEQAIJ,comm);
1275   PLogObjectCreate(B);
1276   B->data             = (void *) (b = PetscNew(Mat_SeqAIJ)); CHKPTRQ(b);
1277   PetscMemcpy(&B->ops,&MatOps,sizeof(struct _MatOps));
1278   B->destroy          = MatDestroy_SeqAIJ;
1279   B->view             = MatView_SeqAIJ;
1280   B->factor           = 0;
1281   B->lupivotthreshold = 1.0;
1282   ierr = OptionsGetDouble(PETSC_NULL,"-mat_lu_pivotthreshold",&B->lupivotthreshold, \
1283                           &flg); CHKERRQ(ierr);
1284   b->row              = 0;
1285   b->col              = 0;
1286   b->indexshift       = 0;
1287   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_oneindex", &flg); CHKERRQ(ierr);
1288   if (flg) b->indexshift = -1;
1289 
1290   b->m       = m;
1291   b->n       = n;
1292   b->imax    = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(b->imax);
1293   if (nnz == PETSC_NULL) {
1294     if (nz == PETSC_DEFAULT) nz = 10;
1295     else if (nz <= 0)        nz = 1;
1296     for ( i=0; i<m; i++ ) b->imax[i] = nz;
1297     nz = nz*m;
1298   }
1299   else {
1300     nz = 0;
1301     for ( i=0; i<m; i++ ) {b->imax[i] = nnz[i]; nz += nnz[i];}
1302   }
1303 
1304   /* allocate the matrix space */
1305   len     = nz*(sizeof(int) + sizeof(Scalar)) + (b->m+1)*sizeof(int);
1306   b->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a);
1307   b->j  = (int *) (b->a + nz);
1308   PetscMemzero(b->j,nz*sizeof(int));
1309   b->i  = b->j + nz;
1310   b->singlemalloc = 1;
1311 
1312   b->i[0] = -b->indexshift;
1313   for (i=1; i<m+1; i++) {
1314     b->i[i] = b->i[i-1] + b->imax[i-1];
1315   }
1316 
1317   /* b->ilen will count nonzeros in each row so far. */
1318   b->ilen = (int *) PetscMalloc((m+1)*sizeof(int));
1319   PLogObjectMemory(B,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ));
1320   for ( i=0; i<b->m; i++ ) { b->ilen[i] = 0;}
1321 
1322   b->nz               = 0;
1323   b->maxnz            = nz;
1324   b->sorted           = 0;
1325   b->roworiented      = 1;
1326   b->nonew            = 0;
1327   b->diag             = 0;
1328   b->assembled        = 0;
1329   b->solve_work       = 0;
1330   b->spptr            = 0;
1331   b->inode.node_count = 0;
1332   b->inode.size       = 0;
1333   b->inode.limit      = 5;
1334   b->inode.max_limit  = 5;
1335 
1336   *A = B;
1337   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_superlu", &flg); CHKERRQ(ierr);
1338   if (flg) { ierr = MatUseSuperLU_SeqAIJ(B); CHKERRQ(ierr); }
1339   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_essl", &flg); CHKERRQ(ierr);
1340   if (flg) { ierr = MatUseEssl_SeqAIJ(B); CHKERRQ(ierr); }
1341   ierr = OptionsHasName(PETSC_NULL,"-mat_aij_dxml", &flg); CHKERRQ(ierr);
1342   if (flg) {
1343     if (!b->indexshift) SETERRQ(1,"MatCreateSeqAIJ:need -mat_aij_oneindex with -mat_aij_dxml");
1344     ierr = MatUseDXML_SeqAIJ(B); CHKERRQ(ierr);
1345   }
1346   ierr = OptionsHasName(PETSC_NULL,"-help", &flg); CHKERRQ(ierr);
1347   if (flg) {ierr = MatPrintHelp(B); CHKERRQ(ierr); }
1348   return 0;
1349 }
1350 
1351 int MatConvertSameType_SeqAIJ(Mat A,Mat *B,int cpvalues)
1352 {
1353   Mat        C;
1354   Mat_SeqAIJ *c,*a = (Mat_SeqAIJ *) A->data;
1355   int        i,len, m = a->m,shift = a->indexshift;
1356 
1357   *B = 0;
1358   if (!a->assembled) SETERRQ(1,"MatConvertSameType_SeqAIJ:Not for unassembled matrix");
1359   PetscHeaderCreate(C,_Mat,MAT_COOKIE,MATSEQAIJ,A->comm);
1360   PLogObjectCreate(C);
1361   C->data       = (void *) (c = PetscNew(Mat_SeqAIJ)); CHKPTRQ(c);
1362   PetscMemcpy(&C->ops,&A->ops,sizeof(struct _MatOps));
1363   C->destroy    = MatDestroy_SeqAIJ;
1364   C->view       = MatView_SeqAIJ;
1365   C->factor     = A->factor;
1366   c->row        = 0;
1367   c->col        = 0;
1368   c->indexshift = shift;
1369 
1370   c->m          = a->m;
1371   c->n          = a->n;
1372 
1373   c->imax       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->imax);
1374   c->ilen       = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->ilen);
1375   for ( i=0; i<m; i++ ) {
1376     c->imax[i] = a->imax[i];
1377     c->ilen[i] = a->ilen[i];
1378   }
1379 
1380   /* allocate the matrix space */
1381   c->singlemalloc = 1;
1382   len     = (m+1)*sizeof(int)+(a->i[m])*(sizeof(Scalar)+sizeof(int));
1383   c->a  = (Scalar *) PetscMalloc( len ); CHKPTRQ(c->a);
1384   c->j  = (int *) (c->a + a->i[m] + shift);
1385   c->i  = c->j + a->i[m] + shift;
1386   PetscMemcpy(c->i,a->i,(m+1)*sizeof(int));
1387   if (m > 0) {
1388     PetscMemcpy(c->j,a->j,(a->i[m]+shift)*sizeof(int));
1389     if (cpvalues == COPY_VALUES) {
1390       PetscMemcpy(c->a,a->a,(a->i[m]+shift)*sizeof(Scalar));
1391     }
1392   }
1393 
1394   PLogObjectMemory(C,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ));
1395   c->sorted      = a->sorted;
1396   c->roworiented = a->roworiented;
1397   c->nonew       = a->nonew;
1398 
1399   if (a->diag) {
1400     c->diag = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(c->diag);
1401     PLogObjectMemory(C,(m+1)*sizeof(int));
1402     for ( i=0; i<m; i++ ) {
1403       c->diag[i] = a->diag[i];
1404     }
1405   }
1406   else c->diag          = 0;
1407   c->inode.limit        = a->inode.limit;
1408   c->inode.max_limit    = a->inode.max_limit;
1409   if (a->inode.size){
1410     c->inode.size       = (int *) PetscMalloc( m *sizeof(int) ); CHKPTRQ(c->inode.size);
1411     c->inode.node_count = a->inode.node_count;
1412     PetscMemcpy( c->inode.size, a->inode.size, m*sizeof(int));
1413   } else {
1414     c->inode.size       = 0;
1415     c->inode.node_count = 0;
1416   }
1417   c->assembled          = 1;
1418   c->nz                 = a->nz;
1419   c->maxnz              = a->maxnz;
1420   c->solve_work         = 0;
1421   c->spptr              = 0;      /* Dangerous -I'm throwing away a->spptr */
1422 
1423   *B = C;
1424   return 0;
1425 }
1426 
1427 int MatLoad_SeqAIJ(Viewer bview,MatType type,Mat *A)
1428 {
1429   Mat_SeqAIJ   *a;
1430   Mat          B;
1431   int          i, nz, ierr, fd, header[4],size,*rowlengths = 0,M,N,shift;
1432   PetscObject  vobj = (PetscObject) bview;
1433   MPI_Comm     comm = vobj->comm;
1434 
1435   MPI_Comm_size(comm,&size);
1436   if (size > 1) SETERRQ(1,"MatLoad_SeqAIJ:view must have one processor");
1437   ierr = ViewerFileGetDescriptor_Private(bview,&fd); CHKERRQ(ierr);
1438   ierr = SYRead(fd,header,4,SYINT); CHKERRQ(ierr);
1439   if (header[0] != MAT_COOKIE) SETERRQ(1,"MatLoad_SeqAIJ:not matrix object in file");
1440   M = header[1]; N = header[2]; nz = header[3];
1441 
1442   /* read in row lengths */
1443   rowlengths = (int*) PetscMalloc( M*sizeof(int) ); CHKPTRQ(rowlengths);
1444   ierr = SYRead(fd,rowlengths,M,SYINT); CHKERRQ(ierr);
1445 
1446   /* create our matrix */
1447   ierr = MatCreateSeqAIJ(comm,M,N,0,rowlengths,A); CHKERRQ(ierr);
1448   B = *A;
1449   a = (Mat_SeqAIJ *) B->data;
1450   shift = a->indexshift;
1451 
1452   /* read in column indices and adjust for Fortran indexing*/
1453   ierr = SYRead(fd,a->j,nz,SYINT); CHKERRQ(ierr);
1454   if (shift) {
1455     for ( i=0; i<nz; i++ ) {
1456       a->j[i] += 1;
1457     }
1458   }
1459 
1460   /* read in nonzero values */
1461   ierr = SYRead(fd,a->a,nz,SYSCALAR); CHKERRQ(ierr);
1462 
1463   /* set matrix "i" values */
1464   a->i[0] = -shift;
1465   for ( i=1; i<= M; i++ ) {
1466     a->i[i]      = a->i[i-1] + rowlengths[i-1];
1467     a->ilen[i-1] = rowlengths[i-1];
1468   }
1469   PetscFree(rowlengths);
1470 
1471   ierr = MatAssemblyBegin(B,FINAL_ASSEMBLY); CHKERRQ(ierr);
1472   ierr = MatAssemblyEnd(B,FINAL_ASSEMBLY); CHKERRQ(ierr);
1473   return 0;
1474 }
1475 
1476 
1477 
1478