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