xref: /petsc/src/mat/impls/dense/seq/dense.c (revision 23242f5a347c7ec34b2cd4c88fec47fa748e5b8b)
1 #ifndef lint
2 static char vcid[] = "$Id: dense.c,v 1.29 1995/04/28 15:06:38 curfman Exp bsmith $";
3 #endif
4 
5 /*
6     Standard Fortran style matrices
7 */
8 #include "ptscimpl.h"
9 #include "plapack.h"
10 #include "matimpl.h"
11 #include "math.h"
12 #include "vec/vecimpl.h"
13 
14 typedef struct {
15   Scalar *v;
16   int    roworiented;
17   int    m,n,pad;
18   int    *pivots;   /* pivots in LU factorization */
19 } Mat_Dense;
20 
21 
22 static int MatGetInfo_Dense(Mat matin,int flag,int *nz,int *nzalloc,int *mem)
23 {
24   Mat_Dense *mat = (Mat_Dense *) matin->data;
25   int    i,N = mat->m*mat->n,count = 0;
26   Scalar *v = mat->v;
27   for ( i=0; i<N; i++ ) {if (*v != 0.0) count++; v++;}
28   *nz = count; *nzalloc = N; *mem = N*sizeof(Scalar);
29   return 0;
30 }
31 
32 /* ---------------------------------------------------------------*/
33 /* COMMENT: I have chosen to hide column permutation in the pivots,
34    rather than put it in the Mat->col slot.*/
35 static int MatLUFactor_Dense(Mat matin,IS row,IS col)
36 {
37   Mat_Dense *mat = (Mat_Dense *) matin->data;
38   int    info;
39   if (!mat->pivots) {
40     mat->pivots = (int *) MALLOC( mat->m*sizeof(int) );
41     CHKPTR(mat->pivots);
42   }
43   LAgetrf_(&mat->m,&mat->n,mat->v,&mat->m,mat->pivots,&info);
44   if (info) SETERR(1,"Bad LU factorization");
45   matin->factor = FACTOR_LU;
46   return 0;
47 }
48 static int MatLUFactorSymbolic_Dense(Mat matin,IS row,IS col,Mat *fact)
49 {
50   int ierr;
51   if ((ierr = MatCopy(matin,fact))) SETERR(ierr,0);
52   return 0;
53 }
54 static int MatLUFactorNumeric_Dense(Mat matin,Mat *fact)
55 {
56   return MatLUFactor(*fact,0,0);
57 }
58 static int MatCholeskyFactorSymbolic_Dense(Mat matin,IS row,Mat *fact)
59 {
60   int ierr;
61   if ((ierr = MatCopy(matin,fact))) SETERR(ierr,0);
62   return 0;
63 }
64 static int MatCholeskyFactorNumeric_Dense(Mat matin,Mat *fact)
65 {
66   return MatCholeskyFactor(*fact,0);
67 }
68 static int MatCholeskyFactor_Dense(Mat matin,IS perm)
69 {
70   Mat_Dense    *mat = (Mat_Dense *) matin->data;
71   int       info;
72   if (mat->pivots) {FREE(mat->pivots); mat->pivots = 0;}
73   LApotrf_("L",&mat->n,mat->v,&mat->m,&info);
74   if (info) SETERR(1,"Bad Cholesky factorization");
75   matin->factor = FACTOR_CHOLESKY;
76   return 0;
77 }
78 
79 static int MatSolve_Dense(Mat matin,Vec xx,Vec yy)
80 {
81   Mat_Dense *mat = (Mat_Dense *) matin->data;
82   int    one = 1, info;
83   Scalar *x, *y;
84   VecGetArray(xx,&x); VecGetArray(yy,&y);
85   MEMCPY(y,x,mat->m*sizeof(Scalar));
86   if (matin->factor == FACTOR_LU) {
87     LAgetrs_( "N", &mat->m, &one, mat->v, &mat->m, mat->pivots,
88               y, &mat->m, &info );
89   }
90   else if (matin->factor == FACTOR_CHOLESKY){
91     LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,
92               y, &mat->m, &info );
93   }
94   else SETERR(1,"Matrix must be factored to solve");
95   if (info) SETERR(1,"Bad solve");
96   return 0;
97 }
98 static int MatSolveTrans_Dense(Mat matin,Vec xx,Vec yy)
99 {
100   Mat_Dense *mat = (Mat_Dense *) matin->data;
101   int    one = 1, info;
102   Scalar *x, *y;
103   VecGetArray(xx,&x); VecGetArray(yy,&y);
104   MEMCPY(y,x,mat->m*sizeof(Scalar));
105   /* assume if pivots exist then LU else Cholesky */
106   if (mat->pivots) {
107     LAgetrs_( "T", &mat->m, &one, mat->v, &mat->m, mat->pivots,
108               y, &mat->m, &info );
109   }
110   else {
111     LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,
112               y, &mat->m, &info );
113   }
114   if (info) SETERR(1,"Bad solve");
115   return 0;
116 }
117 static int MatSolveAdd_Dense(Mat matin,Vec xx,Vec zz,Vec yy)
118 {
119   Mat_Dense *mat = (Mat_Dense *) matin->data;
120   int    one = 1, info,ierr;
121   Scalar *x, *y, sone = 1.0;
122   Vec    tmp = 0;
123   VecGetArray(xx,&x); VecGetArray(yy,&y);
124   if (yy == zz) {
125     ierr = VecCreate(yy,&tmp); CHKERR(ierr);
126     ierr = VecCopy(yy,tmp); CHKERR(ierr);
127   }
128   MEMCPY(y,x,mat->m*sizeof(Scalar));
129   /* assume if pivots exist then LU else Cholesky */
130   if (mat->pivots) {
131     LAgetrs_( "N", &mat->m, &one, mat->v, &mat->m, mat->pivots,
132               y, &mat->m, &info );
133   }
134   else {
135     LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,
136               y, &mat->m, &info );
137   }
138   if (info) SETERR(1,"Bad solve");
139   if (tmp) {VecAXPY(&sone,tmp,yy); VecDestroy(tmp);}
140   else VecAXPY(&sone,zz,yy);
141   return 0;
142 }
143 static int MatSolveTransAdd_Dense(Mat matin,Vec xx,Vec zz, Vec yy)
144 {
145   Mat_Dense  *mat = (Mat_Dense *) matin->data;
146   int     one = 1, info,ierr;
147   Scalar  *x, *y, sone = 1.0;
148   Vec     tmp;
149   VecGetArray(xx,&x); VecGetArray(yy,&y);
150   if (yy == zz) {
151     ierr = VecCreate(yy,&tmp); CHKERR(ierr);
152     ierr = VecCopy(yy,tmp); CHKERR(ierr);
153   }
154   MEMCPY(y,x,mat->m*sizeof(Scalar));
155   /* assume if pivots exist then LU else Cholesky */
156   if (mat->pivots) {
157     LAgetrs_( "T", &mat->m, &one, mat->v, &mat->m, mat->pivots,
158               y, &mat->m, &info );
159   }
160   else {
161     LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,
162               y, &mat->m, &info );
163   }
164   if (info) SETERR(1,"Bad solve");
165   if (tmp) {VecAXPY(&sone,tmp,yy); VecDestroy(tmp);}
166   else VecAXPY(&sone,zz,yy);
167   return 0;
168 }
169 /* ------------------------------------------------------------------*/
170 static int MatRelax_Dense(Mat matin,Vec bb,double omega,int flag,double shift,
171                        int its,Vec xx)
172 {
173   Mat_Dense *mat = (Mat_Dense *) matin->data;
174   Scalar *x, *b, *v = mat->v, zero = 0.0, xt;
175   int    o = 1,ierr, m = mat->m, i;
176 
177   if (flag & SOR_ZERO_INITIAL_GUESS) {
178     /* this is a hack fix, should have another version without
179        the second BLdot */
180     if ((ierr = VecSet(&zero,xx))) SETERR(ierr,0);
181   }
182   VecGetArray(xx,&x); VecGetArray(bb,&b);
183   while (its--) {
184     if (flag & SOR_FORWARD_SWEEP){
185       for ( i=0; i<m; i++ ) {
186         xt = b[i]-BLdot_(&m,v+i,&m,x,&o);
187         x[i] = (1. - omega)*x[i] + omega*(xt/(v[i + i*m]+shift) + x[i]);
188       }
189     }
190     if (flag & SOR_BACKWARD_SWEEP) {
191       for ( i=m-1; i>=0; i-- ) {
192         xt = b[i]-BLdot_(&m,v+i,&m,x,&o);
193         x[i] = (1. - omega)*x[i] + omega*(xt/(v[i + i*m]+shift) + x[i]);
194       }
195     }
196   }
197   return 0;
198 }
199 
200 /* -----------------------------------------------------------------*/
201 static int MatMultTrans_Dense(Mat matin,Vec xx,Vec yy)
202 {
203   Mat_Dense *mat = (Mat_Dense *) matin->data;
204   Scalar *v = mat->v, *x, *y;
205   int _One=1;Scalar _DOne=1.0, _DZero=0.0;
206   VecGetArray(xx,&x), VecGetArray(yy,&y);
207   LAgemv_( "T", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),
208          x, &_One, &_DZero, y, &_One );
209   return 0;
210 }
211 static int MatMult_Dense(Mat matin,Vec xx,Vec yy)
212 {
213   Mat_Dense *mat = (Mat_Dense *) matin->data;
214   Scalar *v = mat->v, *x, *y;
215   int _One=1;Scalar _DOne=1.0, _DZero=0.0;
216   VecGetArray(xx,&x); VecGetArray(yy,&y);
217   LAgemv_( "N", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),
218          x, &_One, &_DZero, y, &_One );
219   return 0;
220 }
221 static int MatMultAdd_Dense(Mat matin,Vec xx,Vec zz,Vec yy)
222 {
223   Mat_Dense *mat = (Mat_Dense *) matin->data;
224   Scalar *v = mat->v, *x, *y, *z;
225   int    _One=1; Scalar _DOne=1.0;
226   VecGetArray(xx,&x); VecGetArray(yy,&y); VecGetArray(zz,&z);
227   if (zz != yy) MEMCPY(y,z,mat->m*sizeof(Scalar));
228   LAgemv_( "N", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),
229          x, &_One, &_DOne, y, &_One );
230   return 0;
231 }
232 static int MatMultTransAdd_Dense(Mat matin,Vec xx,Vec zz,Vec yy)
233 {
234   Mat_Dense *mat = (Mat_Dense *) matin->data;
235   Scalar *v = mat->v, *x, *y, *z;
236   int    _One=1;
237   Scalar _DOne=1.0;
238   VecGetArray(xx,&x); VecGetArray(yy,&y);
239   VecGetArray(zz,&z);
240   if (zz != yy) MEMCPY(y,z,mat->m*sizeof(Scalar));
241   LAgemv_( "T", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),
242          x, &_One, &_DOne, y, &_One );
243   return 0;
244 }
245 
246 /* -----------------------------------------------------------------*/
247 static int MatGetRow_Dense(Mat matin,int row,int *ncols,int **cols,
248                         Scalar **vals)
249 {
250   Mat_Dense *mat = (Mat_Dense *) matin->data;
251   Scalar *v;
252   int    i;
253   *ncols = mat->n;
254   if (cols) {
255     *cols = (int *) MALLOC(mat->n*sizeof(int)); CHKPTR(*cols);
256     for ( i=0; i<mat->n; i++ ) *cols[i] = i;
257   }
258   if (vals) {
259     *vals = (Scalar *) MALLOC(mat->n*sizeof(Scalar)); CHKPTR(*vals);
260     v = mat->v + row;
261     for ( i=0; i<mat->n; i++ ) {*vals[i] = *v; v += mat->m;}
262   }
263   return 0;
264 }
265 static int MatRestoreRow_Dense(Mat matin,int row,int *ncols,int **cols,
266                             Scalar **vals)
267 {
268   if (cols) { FREE(*cols); }
269   if (vals) { FREE(*vals); }
270   return 0;
271 }
272 /* ----------------------------------------------------------------*/
273 static int MatInsert_Dense(Mat matin,int m,int *indexm,int n,
274                         int *indexn,Scalar *v,InsertMode addv)
275 {
276   Mat_Dense *mat = (Mat_Dense *) matin->data;
277   int    i,j;
278 
279   if (!mat->roworiented) {
280     if (addv == InsertValues) {
281       for ( j=0; j<n; j++ ) {
282         if (indexn[j] < 0) {*v += m; continue;}
283         for ( i=0; i<m; i++ ) {
284           if (indexm[i] < 0) {*v++; continue;}
285           mat->v[indexn[j]*mat->m + indexm[i]] = *v++;
286         }
287       }
288     }
289     else {
290       for ( j=0; j<n; j++ ) {
291         if (indexn[j] < 0) {*v += m; continue;}
292         for ( i=0; i<m; i++ ) {
293           if (indexm[i] < 0) {*v++; continue;}
294           mat->v[indexn[j]*mat->m + indexm[i]] += *v++;
295         }
296       }
297     }
298   }
299   else {
300     if (addv == InsertValues) {
301       for ( i=0; i<m; i++ ) {
302         if (indexm[i] < 0) {*v += n; continue;}
303         for ( j=0; j<n; j++ ) {
304           if (indexn[j] < 0) {*v++; continue;}
305           mat->v[indexn[j]*mat->m + indexm[i]] = *v++;
306         }
307       }
308     }
309     else {
310       for ( i=0; i<m; i++ ) {
311         if (indexm[i] < 0) {*v += n; continue;}
312         for ( j=0; j<n; j++ ) {
313           if (indexn[j] < 0) {*v++; continue;}
314           mat->v[indexn[j]*mat->m + indexm[i]] += *v++;
315         }
316       }
317     }
318   }
319   return 0;
320 }
321 
322 /* -----------------------------------------------------------------*/
323 static int MatCopy_Dense(Mat matin,Mat *newmat)
324 {
325   Mat_Dense *mat = (Mat_Dense *) matin->data;
326   int ierr;
327   Mat newi;
328   Mat_Dense *l;
329   if ((ierr = MatCreateSequentialDense(matin->comm,mat->m,mat->n,&newi)))
330                                                           SETERR(ierr,0);
331   l = (Mat_Dense *) newi->data;
332   MEMCPY(l->v,mat->v,mat->m*mat->n*sizeof(Scalar));
333   *newmat = newi;
334   return 0;
335 }
336 #include "viewer.h"
337 
338 int MatView_Dense(PetscObject obj,Viewer ptr)
339 {
340   Mat         matin = (Mat) obj;
341   Mat_Dense   *mat = (Mat_Dense *) matin->data;
342   Scalar      *v;
343   int         i,j;
344   PetscObject vobj = (PetscObject) ptr;
345 
346   if (ptr == 0) {
347     ptr = STDOUT_VIEWER; vobj = (PetscObject) ptr;
348   }
349   if (vobj->cookie == VIEWER_COOKIE && vobj->type == MATLAB_VIEWER) {
350     return ViewerMatlabPutArray_Private(ptr,mat->m,mat->n,mat->v);
351   }
352   else {
353     FILE *fd = ViewerFileGetPointer_Private(ptr);
354     for ( i=0; i<mat->m; i++ ) {
355       v = mat->v + i;
356       for ( j=0; j<mat->n; j++ ) {
357 #if defined(PETSC_COMPLEX)
358         fprintf(fd,"%6.4e + %6.4e i ",real(*v),imag(*v)); v += mat->m;
359 #else
360         fprintf(fd,"%6.4e ",*v); v += mat->m;
361 #endif
362       }
363       fprintf(fd,"\n");
364     }
365   }
366   return 0;
367 }
368 
369 
370 static int MatDestroy_Dense(PetscObject obj)
371 {
372   Mat    mat = (Mat) obj;
373   Mat_Dense *l = (Mat_Dense *) mat->data;
374 #if defined(PETSC_LOG)
375   PLogObjectState(obj,"Rows %d Cols %d",l->m,l->n);
376 #endif
377   if (l->pivots) FREE(l->pivots);
378   FREE(l);
379   PLogObjectDestroy(mat);
380   PETSCHEADERDESTROY(mat);
381   return 0;
382 }
383 
384 static int MatTrans_Dense(Mat matin)
385 {
386   Mat_Dense *mat = (Mat_Dense *) matin->data;
387   int    k,j;
388   Scalar *v = mat->v, tmp;
389   if (mat->m != mat->n) {
390     SETERR(1,"Cannot transpose rectangular dense matrix");
391   }
392   for ( j=0; j<mat->m; j++ ) {
393     for ( k=0; k<j; k++ ) {
394       tmp = v[j + k*mat->n];
395       v[j + k*mat->n] = v[k + j*mat->n];
396       v[k + j*mat->n] = tmp;
397     }
398   }
399   return 0;
400 }
401 
402 static int MatEqual_Dense(Mat matin1,Mat matin2)
403 {
404   Mat_Dense *mat1 = (Mat_Dense *) matin1->data;
405   Mat_Dense *mat2 = (Mat_Dense *) matin2->data;
406   int    i;
407   Scalar *v1 = mat1->v, *v2 = mat2->v;
408   if (mat1->m != mat2->m) return 0;
409   if (mat1->n != mat2->n) return 0;
410   for ( i=0; i<mat1->m*mat1->n; i++ ) {
411     if (*v1 != *v2) return 0;
412     v1++; v2++;
413   }
414   return 1;
415 }
416 
417 static int MatGetDiagonal_Dense(Mat matin,Vec v)
418 {
419   Mat_Dense *mat = (Mat_Dense *) matin->data;
420   int    i, n;
421   Scalar *x;
422   CHKTYPE(v,SEQVECTOR);
423   VecGetArray(v,&x); VecGetSize(v,&n);
424   if (n != mat->m) SETERR(1,"Nonconforming matrix and vector");
425   for ( i=0; i<mat->m; i++ ) {
426     x[i] = mat->v[i*mat->m + i];
427   }
428   return 0;
429 }
430 
431 static int MatScale_Dense(Mat matin,Vec ll,Vec rr)
432 {
433   Mat_Dense *mat = (Mat_Dense *) matin->data;
434   Scalar *l,*r,x,*v;
435   int    i,j,m = mat->m, n = mat->n;
436   if (ll) {
437     VecGetArray(ll,&l); VecGetSize(ll,&m);
438     if (m != mat->m) SETERR(1,"Left scaling vector wrong length");
439     for ( i=0; i<m; i++ ) {
440       x = l[i];
441       v = mat->v + i;
442       for ( j=0; j<n; j++ ) { (*v) *= x; v+= m;}
443     }
444   }
445   if (rr) {
446     VecGetArray(rr,&r); VecGetSize(rr,&n);
447     if (n != mat->n) SETERR(1,"Right scaling vector wrong length");
448     for ( i=0; i<n; i++ ) {
449       x = r[i];
450       v = mat->v + i*m;
451       for ( j=0; j<m; j++ ) { (*v++) *= x;}
452     }
453   }
454   return 0;
455 }
456 
457 
458 static int MatNorm_Dense(Mat matin,int type,double *norm)
459 {
460   Mat_Dense *mat = (Mat_Dense *) matin->data;
461   Scalar *v = mat->v;
462   double sum = 0.0;
463   int    i, j;
464   if (type == NORM_FROBENIUS) {
465     for (i=0; i<mat->n*mat->m; i++ ) {
466 #if defined(PETSC_COMPLEX)
467       sum += real(conj(*v)*(*v)); v++;
468 #else
469       sum += (*v)*(*v); v++;
470 #endif
471     }
472     *norm = sqrt(sum);
473   }
474   else if (type == NORM_1) {
475     *norm = 0.0;
476     for ( j=0; j<mat->n; j++ ) {
477       sum = 0.0;
478       for ( i=0; i<mat->m; i++ ) {
479 #if defined(PETSC_COMPLEX)
480         sum += abs(*v++);
481 #else
482         sum += fabs(*v++);
483 #endif
484       }
485       if (sum > *norm) *norm = sum;
486     }
487   }
488   else if (type == NORM_INFINITY) {
489     *norm = 0.0;
490     for ( j=0; j<mat->m; j++ ) {
491       v = mat->v + j;
492       sum = 0.0;
493       for ( i=0; i<mat->n; i++ ) {
494 #if defined(PETSC_COMPLEX)
495         sum += abs(*v); v += mat->m;
496 #else
497         sum += fabs(*v); v += mat->m;
498 #endif
499       }
500       if (sum > *norm) *norm = sum;
501     }
502   }
503   else {
504     SETERR(1,"No support for the two norm yet");
505   }
506   return 0;
507 }
508 
509 static int MatSetOption_Dense(Mat aijin,int op)
510 {
511   Mat_Dense *aij = (Mat_Dense *) aijin->data;
512   if (op == ROW_ORIENTED)            aij->roworiented = 1;
513   else if (op == COLUMN_ORIENTED)    aij->roworiented = 0;
514   /* doesn't care about sorted rows or columns */
515   return 0;
516 }
517 
518 static int MatZero_Dense(Mat A)
519 {
520   Mat_Dense *l = (Mat_Dense *) A->data;
521   MEMSET(l->v,0,l->m*l->n*sizeof(Scalar));
522   return 0;
523 }
524 
525 static int MatZeroRows_Dense(Mat A,IS is,Scalar *diag)
526 {
527   Mat_Dense *l = (Mat_Dense *) A->data;
528   int    n = l->n, i, j,ierr,N, *rows;
529   Scalar *slot;
530   ierr = ISGetLocalSize(is,&N); CHKERR(ierr);
531   ierr = ISGetIndices(is,&rows); CHKERR(ierr);
532   for ( i=0; i<N; i++ ) {
533     slot = l->v + rows[i];
534     for ( j=0; j<n; j++ ) { *slot = 0.0; slot += n;}
535   }
536   if (diag) {
537     for ( i=0; i<N; i++ ) {
538       slot = l->v + (n+1)*rows[i];
539       *slot = *diag;
540     }
541   }
542   ISRestoreIndices(is,&rows);
543   return 0;
544 }
545 
546 static int MatGetSize_Dense(Mat matin,int *m,int *n)
547 {
548   Mat_Dense *mat = (Mat_Dense *) matin->data;
549   *m = mat->m; *n = mat->n;
550   return 0;
551 }
552 
553 static int MatGetArray_Dense(Mat matin,Scalar **array)
554 {
555   Mat_Dense *mat = (Mat_Dense *) matin->data;
556   *array = mat->v;
557   return 0;
558 }
559 
560 
561 static int MatGetSubMatrixInPlace_Dense(Mat matin,IS isrow,IS iscol)
562 {
563   SETERR(1,"MatGetSubMatrixInPlace_Dense not yet done.");
564 }
565 
566 static int MatGetSubMatrix_Dense(Mat matin,IS isrow,IS iscol,Mat *submat)
567 {
568   Mat_Dense *mat = (Mat_Dense *) matin->data;
569   int     nznew, *smap, i, j, ierr, oldcols = mat->n;
570   int     *irow, *icol, nrows, ncols, *cwork, jstart;
571   Scalar  *vwork, *val;
572   Mat     newmat;
573 
574   ierr = ISGetIndices(isrow,&irow); CHKERR(ierr);
575   ierr = ISGetIndices(iscol,&icol); CHKERR(ierr);
576   ierr = ISGetSize(isrow,&nrows); CHKERR(ierr);
577   ierr = ISGetSize(iscol,&ncols); CHKERR(ierr);
578 
579   smap = (int *) MALLOC(oldcols*sizeof(int)); CHKPTR(smap);
580   cwork = (int *) MALLOC(ncols*sizeof(int)); CHKPTR(cwork);
581   vwork = (Scalar *) MALLOC(ncols*sizeof(Scalar)); CHKPTR(vwork);
582   memset((char*)smap,0,oldcols*sizeof(int));
583   for ( i=0; i<ncols; i++ ) smap[icol[i]] = i+1;
584 
585   /* Create and fill new matrix */
586   ierr = MatCreateSequentialDense(matin->comm,nrows,ncols,&newmat);
587          CHKERR(ierr);
588   for (i=0; i<nrows; i++) {
589     nznew = 0;
590     val   = mat->v + irow[i];
591     for (j=0; j<oldcols; j++) {
592       if (smap[j]) {
593         cwork[nznew]   = smap[j] - 1;
594         vwork[nznew++] = val[j * mat->m];
595       }
596     }
597     ierr = MatSetValues(newmat,1,&i,nznew,cwork,vwork,InsertValues);
598            CHKERR(ierr);
599   }
600   ierr = MatBeginAssembly(newmat,FINAL_ASSEMBLY); CHKERR(ierr);
601   ierr = MatEndAssembly(newmat,FINAL_ASSEMBLY); CHKERR(ierr);
602 
603   /* Free work space */
604   FREE(smap); FREE(cwork); FREE(vwork);
605   ierr = ISRestoreIndices(isrow,&irow); CHKERR(ierr);
606   ierr = ISRestoreIndices(iscol,&icol); CHKERR(ierr);
607   *submat = newmat;
608   return 0;
609 }
610 
611 /* -------------------------------------------------------------------*/
612 static struct _MatOps MatOps = {MatInsert_Dense,
613        MatGetRow_Dense, MatRestoreRow_Dense,
614        MatMult_Dense, MatMultAdd_Dense,
615        MatMultTrans_Dense, MatMultTransAdd_Dense,
616        MatSolve_Dense,MatSolveAdd_Dense,
617        MatSolveTrans_Dense,MatSolveTransAdd_Dense,
618        MatLUFactor_Dense,MatCholeskyFactor_Dense,
619        MatRelax_Dense,
620        MatTrans_Dense,
621        MatGetInfo_Dense,MatEqual_Dense,
622        MatCopy_Dense,
623        MatGetDiagonal_Dense,MatScale_Dense,MatNorm_Dense,
624        0,0,
625        0, MatSetOption_Dense,MatZero_Dense,MatZeroRows_Dense,0,
626        MatLUFactorSymbolic_Dense,MatLUFactorNumeric_Dense,
627        MatCholeskyFactorSymbolic_Dense,MatCholeskyFactorNumeric_Dense,
628        MatGetSize_Dense,MatGetSize_Dense,0,
629        0,0,MatGetArray_Dense,0,
630        MatGetSubMatrix_Dense,MatGetSubMatrixInPlace_Dense};
631 
632 /*@
633    MatCreateSequentialDense - Creates a sequential dense matrix that
634    is stored in column major order (the usual Fortran 77 manner). Many
635    of the matrix operations use the BLAS and LAPACK routines.
636 
637    Input Parameters:
638 .  comm - MPI communicator, set to MPI_COMM_SELF
639 .  m - number of rows
640 .  n - number of column
641 
642    Output Parameter:
643 .  newmat - the matrix
644 
645 .keywords: Mat, dense, matrix, LAPACK, BLAS
646 
647 .seealso: MatCreateSequentialAIJ()
648 @*/
649 int MatCreateSequentialDense(MPI_Comm comm,int m,int n,Mat *newmat)
650 {
651   int       size = sizeof(Mat_Dense) + m*n*sizeof(Scalar);
652   Mat mat;
653   Mat_Dense    *l;
654   *newmat        = 0;
655   PETSCHEADERCREATE(mat,_Mat,MAT_COOKIE,MATDENSE,comm);
656   PLogObjectCreate(mat);
657   l              = (Mat_Dense *) MALLOC(size); CHKPTR(l);
658   mat->ops       = &MatOps;
659   mat->destroy   = MatDestroy_Dense;
660   mat->view      = MatView_Dense;
661   mat->data      = (void *) l;
662   mat->factor    = 0;
663 
664   l->m           = m;
665   l->n           = n;
666   l->v           = (Scalar *) (l + 1);
667   l->pivots      = 0;
668   l->roworiented = 1;
669 
670   MEMSET(l->v,0,m*n*sizeof(Scalar));
671   *newmat = mat;
672   return 0;
673 }
674 
675 int MatCreate_Dense(Mat matin,Mat *newmat)
676 {
677   Mat_Dense *m = (Mat_Dense *) matin->data;
678   return MatCreateSequentialDense(matin->comm,m->m,m->n,newmat);
679 }
680