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