xref: /petsc/src/mat/impls/dense/seq/dense.c (revision 1a83f524638a4da8317a6bd80eb6d9a2936d8384)
1 
2 /*
3      Defines the basic matrix operations for sequential dense.
4 */
5 
6 #include <../src/mat/impls/dense/seq/dense.h> /*I "petscmat.h" I*/
7 #include <petscblaslapack.h>
8 
9 #include <../src/mat/impls/aij/seq/aij.h>
10 EXTERN_C_BEGIN
11 #undef __FUNCT__
12 #define __FUNCT__ "MatConvert_SeqDense_SeqAIJ"
13 PetscErrorCode  MatConvert_SeqDense_SeqAIJ(Mat A, MatType newtype,MatReuse reuse,Mat *newmat)
14 {
15   Mat            B;
16   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
17   PetscErrorCode ierr;
18   PetscInt       i;
19   PetscInt       *rows;
20   MatScalar      *aa = a->v;
21 
22   PetscFunctionBegin;
23   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
24   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);CHKERRQ(ierr);
25   ierr = MatSetType(B,MATSEQAIJ);CHKERRQ(ierr);
26   ierr = MatSeqAIJSetPreallocation(B,A->cmap->n,PETSC_NULL);CHKERRQ(ierr);
27 
28   ierr = PetscMalloc(A->rmap->n*sizeof(PetscInt),&rows);CHKERRQ(ierr);
29   for (i=0; i<A->rmap->n; i++) rows[i] = i;
30 
31   for (i=0; i<A->cmap->n; i++) {
32     ierr  = MatSetValues(B,A->rmap->n,rows,1,&i,aa,INSERT_VALUES);CHKERRQ(ierr);
33     aa   += a->lda;
34   }
35   ierr = PetscFree(rows);CHKERRQ(ierr);
36   ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
37   ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
38 
39   if (reuse == MAT_REUSE_MATRIX) {
40     ierr = MatHeaderReplace(A,B);CHKERRQ(ierr);
41   } else {
42     *newmat = B;
43   }
44   PetscFunctionReturn(0);
45 }
46 EXTERN_C_END
47 
48 #undef __FUNCT__
49 #define __FUNCT__ "MatAXPY_SeqDense"
50 PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str)
51 {
52   Mat_SeqDense   *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
53   PetscScalar    oalpha = alpha;
54   PetscInt       j;
55   PetscBLASInt   N,m,ldax,lday,one = 1;
56   PetscErrorCode ierr;
57 
58   PetscFunctionBegin;
59   N    = PetscBLASIntCast(X->rmap->n*X->cmap->n);
60   m    = PetscBLASIntCast(X->rmap->n);
61   ldax = PetscBLASIntCast(x->lda);
62   lday = PetscBLASIntCast(y->lda);
63   if (ldax>m || lday>m) {
64     for (j=0; j<X->cmap->n; j++) {
65       BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
66     }
67   } else {
68     BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
69   }
70   ierr = PetscLogFlops(PetscMax(2*N-1,0));CHKERRQ(ierr);
71   PetscFunctionReturn(0);
72 }
73 
74 #undef __FUNCT__
75 #define __FUNCT__ "MatGetInfo_SeqDense"
76 PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
77 {
78   PetscInt     N = A->rmap->n*A->cmap->n;
79 
80   PetscFunctionBegin;
81   info->block_size        = 1.0;
82   info->nz_allocated      = (double)N;
83   info->nz_used           = (double)N;
84   info->nz_unneeded       = (double)0;
85   info->assemblies        = (double)A->num_ass;
86   info->mallocs           = 0;
87   info->memory            = ((PetscObject)A)->mem;
88   info->fill_ratio_given  = 0;
89   info->fill_ratio_needed = 0;
90   info->factor_mallocs    = 0;
91   PetscFunctionReturn(0);
92 }
93 
94 #undef __FUNCT__
95 #define __FUNCT__ "MatScale_SeqDense"
96 PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha)
97 {
98   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
99   PetscScalar    oalpha = alpha;
100   PetscErrorCode ierr;
101   PetscBLASInt   one = 1,j,nz,lda = PetscBLASIntCast(a->lda);
102 
103   PetscFunctionBegin;
104   if (lda>A->rmap->n) {
105     nz = PetscBLASIntCast(A->rmap->n);
106     for (j=0; j<A->cmap->n; j++) {
107       BLASscal_(&nz,&oalpha,a->v+j*lda,&one);
108     }
109   } else {
110     nz = PetscBLASIntCast(A->rmap->n*A->cmap->n);
111     BLASscal_(&nz,&oalpha,a->v,&one);
112   }
113   ierr = PetscLogFlops(nz);CHKERRQ(ierr);
114   PetscFunctionReturn(0);
115 }
116 
117 #undef __FUNCT__
118 #define __FUNCT__ "MatIsHermitian_SeqDense"
119 PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscBool  *fl)
120 {
121   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
122   PetscInt       i,j,m = A->rmap->n,N;
123   PetscScalar    *v = a->v;
124 
125   PetscFunctionBegin;
126   *fl = PETSC_FALSE;
127   if (A->rmap->n != A->cmap->n) PetscFunctionReturn(0);
128   N = a->lda;
129 
130   for (i=0; i<m; i++) {
131     for (j=i+1; j<m; j++) {
132       if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) PetscFunctionReturn(0);
133     }
134   }
135   *fl = PETSC_TRUE;
136   PetscFunctionReturn(0);
137 }
138 
139 #undef __FUNCT__
140 #define __FUNCT__ "MatDuplicateNoCreate_SeqDense"
141 PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
142 {
143   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l;
144   PetscErrorCode ierr;
145   PetscInt       lda = (PetscInt)mat->lda,j,m;
146 
147   PetscFunctionBegin;
148   ierr = PetscLayoutReference(A->rmap,&newi->rmap);CHKERRQ(ierr);
149   ierr = PetscLayoutReference(A->cmap,&newi->cmap);CHKERRQ(ierr);
150   ierr = MatSeqDenseSetPreallocation(newi,PETSC_NULL);CHKERRQ(ierr);
151   if (cpvalues == MAT_COPY_VALUES) {
152     l = (Mat_SeqDense*)newi->data;
153     if (lda>A->rmap->n) {
154       m = A->rmap->n;
155       for (j=0; j<A->cmap->n; j++) {
156 	ierr = PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));CHKERRQ(ierr);
157       }
158     } else {
159       ierr = PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
160     }
161   }
162   newi->assembled = PETSC_TRUE;
163   PetscFunctionReturn(0);
164 }
165 
166 #undef __FUNCT__
167 #define __FUNCT__ "MatDuplicate_SeqDense"
168 PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
169 {
170   PetscErrorCode ierr;
171 
172   PetscFunctionBegin;
173   ierr = MatCreate(((PetscObject)A)->comm,newmat);CHKERRQ(ierr);
174   ierr = MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
175   ierr = MatSetType(*newmat,((PetscObject)A)->type_name);CHKERRQ(ierr);
176   ierr = MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);CHKERRQ(ierr);
177   PetscFunctionReturn(0);
178 }
179 
180 
181 extern PetscErrorCode MatLUFactor_SeqDense(Mat,IS,IS,const MatFactorInfo*);
182 
183 #undef __FUNCT__
184 #define __FUNCT__ "MatLUFactorNumeric_SeqDense"
185 PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
186 {
187   MatFactorInfo  info;
188   PetscErrorCode ierr;
189 
190   PetscFunctionBegin;
191   ierr = MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);CHKERRQ(ierr);
192   ierr = MatLUFactor_SeqDense(fact,0,0,&info);CHKERRQ(ierr);
193   PetscFunctionReturn(0);
194 }
195 
196 #undef __FUNCT__
197 #define __FUNCT__ "MatSolve_SeqDense"
198 PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
199 {
200   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
201   PetscErrorCode ierr;
202   PetscScalar    *x,*y;
203   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
204 
205   PetscFunctionBegin;
206   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
207   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
208   ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
209   if (A->factortype == MAT_FACTOR_LU) {
210 #if defined(PETSC_MISSING_LAPACK_GETRS)
211     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
212 #else
213     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
214     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
215 #endif
216   } else if (A->factortype == MAT_FACTOR_CHOLESKY){
217 #if defined(PETSC_MISSING_LAPACK_POTRS)
218     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
219 #else
220     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
221     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
222 #endif
223   }
224   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
225   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
226   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
227   ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr);
228   PetscFunctionReturn(0);
229 }
230 
231 #undef __FUNCT__
232 #define __FUNCT__ "MatMatSolve_SeqDense"
233 PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X)
234 {
235   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
236   PetscErrorCode ierr;
237   PetscScalar    *b,*x;
238   PetscInt       n;
239   PetscBLASInt   nrhs,info,m=PetscBLASIntCast(A->rmap->n);
240   PetscBool      flg;
241 
242   PetscFunctionBegin;
243   ierr = PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);CHKERRQ(ierr);
244   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
245   ierr = PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);CHKERRQ(ierr);
246   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
247 
248   ierr = MatGetSize(B,PETSC_NULL,&n);CHKERRQ(ierr);
249   nrhs = PetscBLASIntCast(n);
250   ierr = MatDenseGetArray(B,&b);CHKERRQ(ierr);
251   ierr = MatDenseGetArray(X,&x);CHKERRQ(ierr);
252 
253   ierr = PetscMemcpy(x,b,m*nrhs*sizeof(PetscScalar));CHKERRQ(ierr);
254 
255   if (A->factortype == MAT_FACTOR_LU) {
256 #if defined(PETSC_MISSING_LAPACK_GETRS)
257     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
258 #else
259     LAPACKgetrs_("N",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info);
260     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
261 #endif
262   } else if (A->factortype == MAT_FACTOR_CHOLESKY){
263 #if defined(PETSC_MISSING_LAPACK_POTRS)
264     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
265 #else
266     LAPACKpotrs_("L",&m,&nrhs,mat->v,&mat->lda,x,&m,&info);
267     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
268 #endif
269   }
270   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
271 
272   ierr = MatDenseRestoreArray(B,&b);CHKERRQ(ierr);
273   ierr = MatDenseRestoreArray(X,&x);CHKERRQ(ierr);
274   ierr = PetscLogFlops(nrhs*(2.0*m*m - m));CHKERRQ(ierr);
275   PetscFunctionReturn(0);
276 }
277 
278 #undef __FUNCT__
279 #define __FUNCT__ "MatSolveTranspose_SeqDense"
280 PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
281 {
282   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
283   PetscErrorCode ierr;
284   PetscScalar    *x,*y;
285   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
286 
287   PetscFunctionBegin;
288   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
289   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
290   ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
291   /* assume if pivots exist then use LU; else Cholesky */
292   if (mat->pivots) {
293 #if defined(PETSC_MISSING_LAPACK_GETRS)
294     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
295 #else
296     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
297     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
298 #endif
299   } else {
300 #if defined(PETSC_MISSING_LAPACK_POTRS)
301     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
302 #else
303     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
304     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
305 #endif
306   }
307   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
308   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
309   ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr);
310   PetscFunctionReturn(0);
311 }
312 
313 #undef __FUNCT__
314 #define __FUNCT__ "MatSolveAdd_SeqDense"
315 PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
316 {
317   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
318   PetscErrorCode ierr;
319   PetscScalar    *x,*y,sone = 1.0;
320   Vec            tmp = 0;
321   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
322 
323   PetscFunctionBegin;
324   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
325   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
326   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
327   if (yy == zz) {
328     ierr = VecDuplicate(yy,&tmp);CHKERRQ(ierr);
329     ierr = PetscLogObjectParent(A,tmp);CHKERRQ(ierr);
330     ierr = VecCopy(yy,tmp);CHKERRQ(ierr);
331   }
332   ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
333   /* assume if pivots exist then use LU; else Cholesky */
334   if (mat->pivots) {
335 #if defined(PETSC_MISSING_LAPACK_GETRS)
336     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
337 #else
338     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
339     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
340 #endif
341   } else {
342 #if defined(PETSC_MISSING_LAPACK_POTRS)
343     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
344 #else
345     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
346     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
347 #endif
348   }
349   if (tmp) {
350     ierr = VecAXPY(yy,sone,tmp);CHKERRQ(ierr);
351     ierr = VecDestroy(&tmp);CHKERRQ(ierr);
352   } else {
353     ierr = VecAXPY(yy,sone,zz);CHKERRQ(ierr);
354   }
355   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
356   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
357   ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n);CHKERRQ(ierr);
358   PetscFunctionReturn(0);
359 }
360 
361 #undef __FUNCT__
362 #define __FUNCT__ "MatSolveTransposeAdd_SeqDense"
363 PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
364 {
365   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
366   PetscErrorCode ierr;
367   PetscScalar    *x,*y,sone = 1.0;
368   Vec            tmp;
369   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
370 
371   PetscFunctionBegin;
372   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
373   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
374   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
375   if (yy == zz) {
376     ierr = VecDuplicate(yy,&tmp);CHKERRQ(ierr);
377     ierr = PetscLogObjectParent(A,tmp);CHKERRQ(ierr);
378     ierr = VecCopy(yy,tmp);CHKERRQ(ierr);
379   }
380   ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
381   /* assume if pivots exist then use LU; else Cholesky */
382   if (mat->pivots) {
383 #if defined(PETSC_MISSING_LAPACK_GETRS)
384     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
385 #else
386     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
387     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
388 #endif
389   } else {
390 #if defined(PETSC_MISSING_LAPACK_POTRS)
391     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
392 #else
393     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
394     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
395 #endif
396   }
397   if (tmp) {
398     ierr = VecAXPY(yy,sone,tmp);CHKERRQ(ierr);
399     ierr = VecDestroy(&tmp);CHKERRQ(ierr);
400   } else {
401     ierr = VecAXPY(yy,sone,zz);CHKERRQ(ierr);
402   }
403   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
404   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
405   ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n);CHKERRQ(ierr);
406   PetscFunctionReturn(0);
407 }
408 
409 /* ---------------------------------------------------------------*/
410 /* COMMENT: I have chosen to hide row permutation in the pivots,
411    rather than put it in the Mat->row slot.*/
412 #undef __FUNCT__
413 #define __FUNCT__ "MatLUFactor_SeqDense"
414 PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
415 {
416 #if defined(PETSC_MISSING_LAPACK_GETRF)
417   PetscFunctionBegin;
418   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
419 #else
420   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
421   PetscErrorCode ierr;
422   PetscBLASInt   n,m,info;
423 
424   PetscFunctionBegin;
425   n = PetscBLASIntCast(A->cmap->n);
426   m = PetscBLASIntCast(A->rmap->n);
427   if (!mat->pivots) {
428     ierr = PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);CHKERRQ(ierr);
429     ierr = PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));CHKERRQ(ierr);
430   }
431   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
432   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
433   LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
434   ierr = PetscFPTrapPop();CHKERRQ(ierr);
435 
436   if (info<0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to LU factorization");
437   if (info>0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
438   A->ops->solve             = MatSolve_SeqDense;
439   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
440   A->ops->solveadd          = MatSolveAdd_SeqDense;
441   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
442   A->factortype             = MAT_FACTOR_LU;
443 
444   ierr = PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);CHKERRQ(ierr);
445 #endif
446   PetscFunctionReturn(0);
447 }
448 
449 #undef __FUNCT__
450 #define __FUNCT__ "MatCholeskyFactor_SeqDense"
451 PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
452 {
453 #if defined(PETSC_MISSING_LAPACK_POTRF)
454   PetscFunctionBegin;
455   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
456 #else
457   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
458   PetscErrorCode ierr;
459   PetscBLASInt   info,n = PetscBLASIntCast(A->cmap->n);
460 
461   PetscFunctionBegin;
462   ierr = PetscFree(mat->pivots);CHKERRQ(ierr);
463 
464   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
465   LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
466   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
467   A->ops->solve             = MatSolve_SeqDense;
468   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
469   A->ops->solveadd          = MatSolveAdd_SeqDense;
470   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
471   A->factortype             = MAT_FACTOR_CHOLESKY;
472   ierr = PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);CHKERRQ(ierr);
473 #endif
474   PetscFunctionReturn(0);
475 }
476 
477 
478 #undef __FUNCT__
479 #define __FUNCT__ "MatCholeskyFactorNumeric_SeqDense"
480 PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
481 {
482   PetscErrorCode ierr;
483   MatFactorInfo  info;
484 
485   PetscFunctionBegin;
486   info.fill = 1.0;
487   ierr = MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);CHKERRQ(ierr);
488   ierr = MatCholeskyFactor_SeqDense(fact,0,&info);CHKERRQ(ierr);
489   PetscFunctionReturn(0);
490 }
491 
492 #undef __FUNCT__
493 #define __FUNCT__ "MatCholeskyFactorSymbolic_SeqDense"
494 PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
495 {
496   PetscFunctionBegin;
497   fact->assembled                  = PETSC_TRUE;
498   fact->preallocated               = PETSC_TRUE;
499   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
500   PetscFunctionReturn(0);
501 }
502 
503 #undef __FUNCT__
504 #define __FUNCT__ "MatLUFactorSymbolic_SeqDense"
505 PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
506 {
507   PetscFunctionBegin;
508   fact->preallocated         = PETSC_TRUE;
509   fact->assembled            = PETSC_TRUE;
510   fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
511   PetscFunctionReturn(0);
512 }
513 
514 EXTERN_C_BEGIN
515 #undef __FUNCT__
516 #define __FUNCT__ "MatGetFactor_seqdense_petsc"
517 PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
518 {
519   PetscErrorCode ierr;
520 
521   PetscFunctionBegin;
522   ierr = MatCreate(((PetscObject)A)->comm,fact);CHKERRQ(ierr);
523   ierr = MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
524   ierr = MatSetType(*fact,((PetscObject)A)->type_name);CHKERRQ(ierr);
525   if (ftype == MAT_FACTOR_LU){
526     (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
527   } else {
528     (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
529   }
530   (*fact)->factortype = ftype;
531   PetscFunctionReturn(0);
532 }
533 EXTERN_C_END
534 
535 /* ------------------------------------------------------------------*/
536 #undef __FUNCT__
537 #define __FUNCT__ "MatSOR_SeqDense"
538 PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
539 {
540   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
541   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
542   PetscErrorCode ierr;
543   PetscInt       m = A->rmap->n,i;
544   PetscBLASInt   o = 1,bm = PetscBLASIntCast(m);
545 
546   PetscFunctionBegin;
547   if (flag & SOR_ZERO_INITIAL_GUESS) {
548     /* this is a hack fix, should have another version without the second BLASdot */
549     ierr = VecSet(xx,zero);CHKERRQ(ierr);
550   }
551   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
552   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
553   its  = its*lits;
554   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
555   while (its--) {
556     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
557       for (i=0; i<m; i++) {
558         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
559         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
560       }
561     }
562     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
563       for (i=m-1; i>=0; i--) {
564         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
565         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
566       }
567     }
568   }
569   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
570   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
571   PetscFunctionReturn(0);
572 }
573 
574 /* -----------------------------------------------------------------*/
575 #undef __FUNCT__
576 #define __FUNCT__ "MatMultTranspose_SeqDense"
577 PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
578 {
579   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
580   PetscScalar    *v = mat->v,*x,*y;
581   PetscErrorCode ierr;
582   PetscBLASInt   m, n,_One=1;
583   PetscScalar    _DOne=1.0,_DZero=0.0;
584 
585   PetscFunctionBegin;
586   m = PetscBLASIntCast(A->rmap->n);
587   n = PetscBLASIntCast(A->cmap->n);
588   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
589   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
590   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
591   BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
592   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
593   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
594   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr);
595   PetscFunctionReturn(0);
596 }
597 
598 #undef __FUNCT__
599 #define __FUNCT__ "MatMult_SeqDense"
600 PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
601 {
602   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
603   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
604   PetscErrorCode ierr;
605   PetscBLASInt   m, n, _One=1;
606 
607   PetscFunctionBegin;
608   m = PetscBLASIntCast(A->rmap->n);
609   n = PetscBLASIntCast(A->cmap->n);
610   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
611   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
612   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
613   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
614   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
615   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
616   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);CHKERRQ(ierr);
617   PetscFunctionReturn(0);
618 }
619 
620 #undef __FUNCT__
621 #define __FUNCT__ "MatMultAdd_SeqDense"
622 PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
623 {
624   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
625   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
626   PetscErrorCode ierr;
627   PetscBLASInt   m, n, _One=1;
628 
629   PetscFunctionBegin;
630   m = PetscBLASIntCast(A->rmap->n);
631   n = PetscBLASIntCast(A->cmap->n);
632   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
633   if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);}
634   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
635   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
636   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
637   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
638   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
639   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr);
640   PetscFunctionReturn(0);
641 }
642 
643 #undef __FUNCT__
644 #define __FUNCT__ "MatMultTransposeAdd_SeqDense"
645 PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
646 {
647   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
648   PetscScalar    *v = mat->v,*x,*y;
649   PetscErrorCode ierr;
650   PetscBLASInt   m, n, _One=1;
651   PetscScalar    _DOne=1.0;
652 
653   PetscFunctionBegin;
654   m = PetscBLASIntCast(A->rmap->n);
655   n = PetscBLASIntCast(A->cmap->n);
656   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
657   if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);}
658   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
659   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
660   BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
661   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
662   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
663   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr);
664   PetscFunctionReturn(0);
665 }
666 
667 /* -----------------------------------------------------------------*/
668 #undef __FUNCT__
669 #define __FUNCT__ "MatGetRow_SeqDense"
670 PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
671 {
672   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
673   PetscScalar    *v;
674   PetscErrorCode ierr;
675   PetscInt       i;
676 
677   PetscFunctionBegin;
678   *ncols = A->cmap->n;
679   if (cols) {
680     ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);CHKERRQ(ierr);
681     for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
682   }
683   if (vals) {
684     ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);CHKERRQ(ierr);
685     v    = mat->v + row;
686     for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
687   }
688   PetscFunctionReturn(0);
689 }
690 
691 #undef __FUNCT__
692 #define __FUNCT__ "MatRestoreRow_SeqDense"
693 PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
694 {
695   PetscErrorCode ierr;
696   PetscFunctionBegin;
697   if (cols) {ierr = PetscFree(*cols);CHKERRQ(ierr);}
698   if (vals) {ierr = PetscFree(*vals);CHKERRQ(ierr); }
699   PetscFunctionReturn(0);
700 }
701 /* ----------------------------------------------------------------*/
702 #undef __FUNCT__
703 #define __FUNCT__ "MatSetValues_SeqDense"
704 PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
705 {
706   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
707   PetscInt     i,j,idx=0;
708 
709   PetscFunctionBegin;
710   if (v) PetscValidScalarPointer(v,6);
711   if (!mat->roworiented) {
712     if (addv == INSERT_VALUES) {
713       for (j=0; j<n; j++) {
714         if (indexn[j] < 0) {idx += m; continue;}
715 #if defined(PETSC_USE_DEBUG)
716         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
717 #endif
718         for (i=0; i<m; i++) {
719           if (indexm[i] < 0) {idx++; continue;}
720 #if defined(PETSC_USE_DEBUG)
721           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
722 #endif
723           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
724         }
725       }
726     } else {
727       for (j=0; j<n; j++) {
728         if (indexn[j] < 0) {idx += m; continue;}
729 #if defined(PETSC_USE_DEBUG)
730         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
731 #endif
732         for (i=0; i<m; i++) {
733           if (indexm[i] < 0) {idx++; continue;}
734 #if defined(PETSC_USE_DEBUG)
735           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
736 #endif
737           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
738         }
739       }
740     }
741   } else {
742     if (addv == INSERT_VALUES) {
743       for (i=0; i<m; i++) {
744         if (indexm[i] < 0) { idx += n; continue;}
745 #if defined(PETSC_USE_DEBUG)
746         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
747 #endif
748         for (j=0; j<n; j++) {
749           if (indexn[j] < 0) { idx++; continue;}
750 #if defined(PETSC_USE_DEBUG)
751           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
752 #endif
753           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
754         }
755       }
756     } else {
757       for (i=0; i<m; i++) {
758         if (indexm[i] < 0) { idx += n; continue;}
759 #if defined(PETSC_USE_DEBUG)
760         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
761 #endif
762         for (j=0; j<n; j++) {
763           if (indexn[j] < 0) { idx++; continue;}
764 #if defined(PETSC_USE_DEBUG)
765           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
766 #endif
767           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
768         }
769       }
770     }
771   }
772   PetscFunctionReturn(0);
773 }
774 
775 #undef __FUNCT__
776 #define __FUNCT__ "MatGetValues_SeqDense"
777 PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
778 {
779   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
780   PetscInt     i,j;
781 
782   PetscFunctionBegin;
783   /* row-oriented output */
784   for (i=0; i<m; i++) {
785     if (indexm[i] < 0) {v += n;continue;}
786     if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
787     for (j=0; j<n; j++) {
788       if (indexn[j] < 0) {v++; continue;}
789       if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
790       *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
791     }
792   }
793   PetscFunctionReturn(0);
794 }
795 
796 /* -----------------------------------------------------------------*/
797 
798 #undef __FUNCT__
799 #define __FUNCT__ "MatLoad_SeqDense"
800 PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
801 {
802   Mat_SeqDense   *a;
803   PetscErrorCode ierr;
804   PetscInt       *scols,i,j,nz,header[4];
805   int            fd;
806   PetscMPIInt    size;
807   PetscInt       *rowlengths = 0,M,N,*cols,grows,gcols;
808   PetscScalar    *vals,*svals,*v,*w;
809   MPI_Comm       comm = ((PetscObject)viewer)->comm;
810 
811   PetscFunctionBegin;
812   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
813   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
814   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
815   ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr);
816   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
817   M = header[1]; N = header[2]; nz = header[3];
818 
819   /* set global size if not set already*/
820   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
821     ierr = MatSetSizes(newmat,M,N,M,N);CHKERRQ(ierr);
822   } else {
823     /* if sizes and type are already set, check if the vector global sizes are correct */
824     ierr = MatGetSize(newmat,&grows,&gcols);CHKERRQ(ierr);
825     if (M != grows ||  N != gcols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,grows,gcols);
826   }
827   ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr);
828 
829   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
830     a    = (Mat_SeqDense*)newmat->data;
831     v    = a->v;
832     /* Allocate some temp space to read in the values and then flip them
833        from row major to column major */
834     ierr = PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);CHKERRQ(ierr);
835     /* read in nonzero values */
836     ierr = PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);CHKERRQ(ierr);
837     /* now flip the values and store them in the matrix*/
838     for (j=0; j<N; j++) {
839       for (i=0; i<M; i++) {
840         *v++ =w[i*N+j];
841       }
842     }
843     ierr = PetscFree(w);CHKERRQ(ierr);
844   } else {
845     /* read row lengths */
846     ierr = PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);CHKERRQ(ierr);
847     ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr);
848 
849     a = (Mat_SeqDense*)newmat->data;
850     v = a->v;
851 
852     /* read column indices and nonzeros */
853     ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&scols);CHKERRQ(ierr);
854     cols = scols;
855     ierr = PetscBinaryRead(fd,cols,nz,PETSC_INT);CHKERRQ(ierr);
856     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);CHKERRQ(ierr);
857     vals = svals;
858     ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);CHKERRQ(ierr);
859 
860     /* insert into matrix */
861     for (i=0; i<M; i++) {
862       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
863       svals += rowlengths[i]; scols += rowlengths[i];
864     }
865     ierr = PetscFree(vals);CHKERRQ(ierr);
866     ierr = PetscFree(cols);CHKERRQ(ierr);
867     ierr = PetscFree(rowlengths);CHKERRQ(ierr);
868   }
869   ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
870   ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
871 
872   PetscFunctionReturn(0);
873 }
874 
875 #undef __FUNCT__
876 #define __FUNCT__ "MatView_SeqDense_ASCII"
877 static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
878 {
879   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
880   PetscErrorCode    ierr;
881   PetscInt          i,j;
882   const char        *name;
883   PetscScalar       *v;
884   PetscViewerFormat format;
885 #if defined(PETSC_USE_COMPLEX)
886   PetscBool         allreal = PETSC_TRUE;
887 #endif
888 
889   PetscFunctionBegin;
890   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
891   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
892     PetscFunctionReturn(0);  /* do nothing for now */
893   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
894     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
895     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr);
896     for (i=0; i<A->rmap->n; i++) {
897       v = a->v + i;
898       ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
899       for (j=0; j<A->cmap->n; j++) {
900 #if defined(PETSC_USE_COMPLEX)
901         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
902           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));CHKERRQ(ierr);
903         } else if (PetscRealPart(*v)) {
904           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));CHKERRQ(ierr);
905         }
906 #else
907         if (*v) {
908           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);CHKERRQ(ierr);
909         }
910 #endif
911         v += a->lda;
912       }
913       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
914     }
915     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
916   } else {
917     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
918 #if defined(PETSC_USE_COMPLEX)
919     /* determine if matrix has all real values */
920     v = a->v;
921     for (i=0; i<A->rmap->n*A->cmap->n; i++) {
922 	if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
923     }
924 #endif
925     if (format == PETSC_VIEWER_ASCII_MATLAB) {
926       ierr = PetscObjectGetName((PetscObject)A,&name);CHKERRQ(ierr);
927       ierr = PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);CHKERRQ(ierr);
928       ierr = PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
929       ierr = PetscViewerASCIIPrintf(viewer,"%s = [\n",name);CHKERRQ(ierr);
930     } else {
931       ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr);
932     }
933 
934     for (i=0; i<A->rmap->n; i++) {
935       v = a->v + i;
936       for (j=0; j<A->cmap->n; j++) {
937 #if defined(PETSC_USE_COMPLEX)
938         if (allreal) {
939           ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)PetscRealPart(*v));CHKERRQ(ierr);
940         } else {
941           ierr = PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei ",(double)PetscRealPart(*v),(double)PetscImaginaryPart(*v));CHKERRQ(ierr);
942         }
943 #else
944         ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)*v);CHKERRQ(ierr);
945 #endif
946 	v += a->lda;
947       }
948       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
949     }
950     if (format == PETSC_VIEWER_ASCII_MATLAB) {
951       ierr = PetscViewerASCIIPrintf(viewer,"];\n");CHKERRQ(ierr);
952     }
953     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
954   }
955   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
956   PetscFunctionReturn(0);
957 }
958 
959 #undef __FUNCT__
960 #define __FUNCT__ "MatView_SeqDense_Binary"
961 static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
962 {
963   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
964   PetscErrorCode    ierr;
965   int               fd;
966   PetscInt          ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
967   PetscScalar       *v,*anonz,*vals;
968   PetscViewerFormat format;
969 
970   PetscFunctionBegin;
971   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
972 
973   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
974   if (format == PETSC_VIEWER_NATIVE) {
975     /* store the matrix as a dense matrix */
976     ierr = PetscMalloc(4*sizeof(PetscInt),&col_lens);CHKERRQ(ierr);
977     col_lens[0] = MAT_FILE_CLASSID;
978     col_lens[1] = m;
979     col_lens[2] = n;
980     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
981     ierr = PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
982     ierr = PetscFree(col_lens);CHKERRQ(ierr);
983 
984     /* write out matrix, by rows */
985     ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
986     v    = a->v;
987     for (j=0; j<n; j++) {
988       for (i=0; i<m; i++) {
989         vals[j + i*n] = *v++;
990       }
991     }
992     ierr = PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
993     ierr = PetscFree(vals);CHKERRQ(ierr);
994   } else {
995     ierr = PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);CHKERRQ(ierr);
996     col_lens[0] = MAT_FILE_CLASSID;
997     col_lens[1] = m;
998     col_lens[2] = n;
999     col_lens[3] = nz;
1000 
1001     /* store lengths of each row and write (including header) to file */
1002     for (i=0; i<m; i++) col_lens[4+i] = n;
1003     ierr = PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1004 
1005     /* Possibly should write in smaller increments, not whole matrix at once? */
1006     /* store column indices (zero start index) */
1007     ict = 0;
1008     for (i=0; i<m; i++) {
1009       for (j=0; j<n; j++) col_lens[ict++] = j;
1010     }
1011     ierr = PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
1012     ierr = PetscFree(col_lens);CHKERRQ(ierr);
1013 
1014     /* store nonzero values */
1015     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);CHKERRQ(ierr);
1016     ict  = 0;
1017     for (i=0; i<m; i++) {
1018       v = a->v + i;
1019       for (j=0; j<n; j++) {
1020         anonz[ict++] = *v; v += a->lda;
1021       }
1022     }
1023     ierr = PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
1024     ierr = PetscFree(anonz);CHKERRQ(ierr);
1025   }
1026   PetscFunctionReturn(0);
1027 }
1028 
1029 #undef __FUNCT__
1030 #define __FUNCT__ "MatView_SeqDense_Draw_Zoom"
1031 PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1032 {
1033   Mat               A = (Mat) Aa;
1034   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
1035   PetscErrorCode    ierr;
1036   PetscInt          m = A->rmap->n,n = A->cmap->n,color,i,j;
1037   PetscScalar       *v = a->v;
1038   PetscViewer       viewer;
1039   PetscDraw         popup;
1040   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1041   PetscViewerFormat format;
1042 
1043   PetscFunctionBegin;
1044 
1045   ierr = PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);CHKERRQ(ierr);
1046   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
1047   ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
1048 
1049   /* Loop over matrix elements drawing boxes */
1050   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1051     /* Blue for negative and Red for positive */
1052     color = PETSC_DRAW_BLUE;
1053     for (j = 0; j < n; j++) {
1054       x_l = j;
1055       x_r = x_l + 1.0;
1056       for (i = 0; i < m; i++) {
1057         y_l = m - i - 1.0;
1058         y_r = y_l + 1.0;
1059 #if defined(PETSC_USE_COMPLEX)
1060         if (PetscRealPart(v[j*m+i]) >  0.) {
1061           color = PETSC_DRAW_RED;
1062         } else if (PetscRealPart(v[j*m+i]) <  0.) {
1063           color = PETSC_DRAW_BLUE;
1064         } else {
1065           continue;
1066         }
1067 #else
1068         if (v[j*m+i] >  0.) {
1069           color = PETSC_DRAW_RED;
1070         } else if (v[j*m+i] <  0.) {
1071           color = PETSC_DRAW_BLUE;
1072         } else {
1073           continue;
1074         }
1075 #endif
1076         ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
1077       }
1078     }
1079   } else {
1080     /* use contour shading to indicate magnitude of values */
1081     /* first determine max of all nonzero values */
1082     for (i = 0; i < m*n; i++) {
1083       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1084     }
1085     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1086     ierr  = PetscDrawGetPopup(draw,&popup);CHKERRQ(ierr);
1087     if (popup) {ierr  = PetscDrawScalePopup(popup,0.0,maxv);CHKERRQ(ierr);}
1088     for (j = 0; j < n; j++) {
1089       x_l = j;
1090       x_r = x_l + 1.0;
1091       for (i = 0; i < m; i++) {
1092         y_l   = m - i - 1.0;
1093         y_r   = y_l + 1.0;
1094         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1095         ierr  = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
1096       }
1097     }
1098   }
1099   PetscFunctionReturn(0);
1100 }
1101 
1102 #undef __FUNCT__
1103 #define __FUNCT__ "MatView_SeqDense_Draw"
1104 PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1105 {
1106   PetscDraw      draw;
1107   PetscBool      isnull;
1108   PetscReal      xr,yr,xl,yl,h,w;
1109   PetscErrorCode ierr;
1110 
1111   PetscFunctionBegin;
1112   ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
1113   ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
1114   if (isnull) PetscFunctionReturn(0);
1115 
1116   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr);
1117   xr  = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1118   xr += w;    yr += h;  xl = -w;     yl = -h;
1119   ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr);
1120   ierr = PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);CHKERRQ(ierr);
1121   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);CHKERRQ(ierr);
1122   PetscFunctionReturn(0);
1123 }
1124 
1125 #undef __FUNCT__
1126 #define __FUNCT__ "MatView_SeqDense"
1127 PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1128 {
1129   PetscErrorCode ierr;
1130   PetscBool      iascii,isbinary,isdraw;
1131 
1132   PetscFunctionBegin;
1133   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1134   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1135   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
1136 
1137   if (iascii) {
1138     ierr = MatView_SeqDense_ASCII(A,viewer);CHKERRQ(ierr);
1139   } else if (isbinary) {
1140     ierr = MatView_SeqDense_Binary(A,viewer);CHKERRQ(ierr);
1141   } else if (isdraw) {
1142     ierr = MatView_SeqDense_Draw(A,viewer);CHKERRQ(ierr);
1143   } else {
1144     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1145   }
1146   PetscFunctionReturn(0);
1147 }
1148 
1149 #undef __FUNCT__
1150 #define __FUNCT__ "MatDestroy_SeqDense"
1151 PetscErrorCode MatDestroy_SeqDense(Mat mat)
1152 {
1153   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;
1154   PetscErrorCode ierr;
1155 
1156   PetscFunctionBegin;
1157 #if defined(PETSC_USE_LOG)
1158   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1159 #endif
1160   ierr = PetscFree(l->pivots);CHKERRQ(ierr);
1161   if (!l->user_alloc) {ierr = PetscFree(l->v);CHKERRQ(ierr);}
1162   ierr = PetscFree(mat->data);CHKERRQ(ierr);
1163 
1164   ierr = PetscObjectChangeTypeName((PetscObject)mat,0);CHKERRQ(ierr);
1165   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatDenseGetArray_C","",PETSC_NULL);CHKERRQ(ierr);
1166   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatDenseRestoreArray_C","",PETSC_NULL);CHKERRQ(ierr);
1167   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);CHKERRQ(ierr);
1168   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1169   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1170   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1171   PetscFunctionReturn(0);
1172 }
1173 
1174 #undef __FUNCT__
1175 #define __FUNCT__ "MatTranspose_SeqDense"
1176 PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1177 {
1178   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1179   PetscErrorCode ierr;
1180   PetscInt       k,j,m,n,M;
1181   PetscScalar    *v,tmp;
1182 
1183   PetscFunctionBegin;
1184   v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1185   if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1186     if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1187     else {
1188       for (j=0; j<m; j++) {
1189         for (k=0; k<j; k++) {
1190           tmp = v[j + k*M];
1191           v[j + k*M] = v[k + j*M];
1192           v[k + j*M] = tmp;
1193         }
1194       }
1195     }
1196   } else { /* out-of-place transpose */
1197     Mat          tmat;
1198     Mat_SeqDense *tmatd;
1199     PetscScalar  *v2;
1200 
1201     if (reuse == MAT_INITIAL_MATRIX) {
1202       ierr  = MatCreate(((PetscObject)A)->comm,&tmat);CHKERRQ(ierr);
1203       ierr  = MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);CHKERRQ(ierr);
1204       ierr  = MatSetType(tmat,((PetscObject)A)->type_name);CHKERRQ(ierr);
1205       ierr  = MatSeqDenseSetPreallocation(tmat,PETSC_NULL);CHKERRQ(ierr);
1206     } else {
1207       tmat = *matout;
1208     }
1209     tmatd = (Mat_SeqDense*)tmat->data;
1210     v = mat->v; v2 = tmatd->v;
1211     for (j=0; j<n; j++) {
1212       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1213     }
1214     ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1215     ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1216     *matout = tmat;
1217   }
1218   PetscFunctionReturn(0);
1219 }
1220 
1221 #undef __FUNCT__
1222 #define __FUNCT__ "MatEqual_SeqDense"
1223 PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool  *flg)
1224 {
1225   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1226   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1227   PetscInt     i,j;
1228   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;
1229 
1230   PetscFunctionBegin;
1231   if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1232   if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1233   for (i=0; i<A1->rmap->n; i++) {
1234     v1 = mat1->v+i; v2 = mat2->v+i;
1235     for (j=0; j<A1->cmap->n; j++) {
1236       if (*v1 != *v2) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1237       v1 += mat1->lda; v2 += mat2->lda;
1238     }
1239   }
1240   *flg = PETSC_TRUE;
1241   PetscFunctionReturn(0);
1242 }
1243 
1244 #undef __FUNCT__
1245 #define __FUNCT__ "MatGetDiagonal_SeqDense"
1246 PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1247 {
1248   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1249   PetscErrorCode ierr;
1250   PetscInt       i,n,len;
1251   PetscScalar    *x,zero = 0.0;
1252 
1253   PetscFunctionBegin;
1254   ierr = VecSet(v,zero);CHKERRQ(ierr);
1255   ierr = VecGetSize(v,&n);CHKERRQ(ierr);
1256   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1257   len = PetscMin(A->rmap->n,A->cmap->n);
1258   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1259   for (i=0; i<len; i++) {
1260     x[i] = mat->v[i*mat->lda + i];
1261   }
1262   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1263   PetscFunctionReturn(0);
1264 }
1265 
1266 #undef __FUNCT__
1267 #define __FUNCT__ "MatDiagonalScale_SeqDense"
1268 PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1269 {
1270   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1271   PetscScalar    *l,*r,x,*v;
1272   PetscErrorCode ierr;
1273   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n;
1274 
1275   PetscFunctionBegin;
1276   if (ll) {
1277     ierr = VecGetSize(ll,&m);CHKERRQ(ierr);
1278     ierr = VecGetArray(ll,&l);CHKERRQ(ierr);
1279     if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1280     for (i=0; i<m; i++) {
1281       x = l[i];
1282       v = mat->v + i;
1283       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1284     }
1285     ierr = VecRestoreArray(ll,&l);CHKERRQ(ierr);
1286     ierr = PetscLogFlops(n*m);CHKERRQ(ierr);
1287   }
1288   if (rr) {
1289     ierr = VecGetSize(rr,&n);CHKERRQ(ierr);
1290     ierr = VecGetArray(rr,&r);CHKERRQ(ierr);
1291     if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1292     for (i=0; i<n; i++) {
1293       x = r[i];
1294       v = mat->v + i*m;
1295       for (j=0; j<m; j++) { (*v++) *= x;}
1296     }
1297     ierr = VecRestoreArray(rr,&r);CHKERRQ(ierr);
1298     ierr = PetscLogFlops(n*m);CHKERRQ(ierr);
1299   }
1300   PetscFunctionReturn(0);
1301 }
1302 
1303 #undef __FUNCT__
1304 #define __FUNCT__ "MatNorm_SeqDense"
1305 PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1306 {
1307   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1308   PetscScalar  *v = mat->v;
1309   PetscReal    sum = 0.0;
1310   PetscInt     lda=mat->lda,m=A->rmap->n,i,j;
1311   PetscErrorCode ierr;
1312 
1313   PetscFunctionBegin;
1314   if (type == NORM_FROBENIUS) {
1315     if (lda>m) {
1316       for (j=0; j<A->cmap->n; j++) {
1317 	v = mat->v+j*lda;
1318 	for (i=0; i<m; i++) {
1319 #if defined(PETSC_USE_COMPLEX)
1320 	  sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1321 #else
1322 	  sum += (*v)*(*v); v++;
1323 #endif
1324 	}
1325       }
1326     } else {
1327       for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1328 #if defined(PETSC_USE_COMPLEX)
1329 	sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1330 #else
1331 	sum += (*v)*(*v); v++;
1332 #endif
1333       }
1334     }
1335     *nrm = PetscSqrtReal(sum);
1336     ierr = PetscLogFlops(2.0*A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1337   } else if (type == NORM_1) {
1338     *nrm = 0.0;
1339     for (j=0; j<A->cmap->n; j++) {
1340       v = mat->v + j*mat->lda;
1341       sum = 0.0;
1342       for (i=0; i<A->rmap->n; i++) {
1343         sum += PetscAbsScalar(*v);  v++;
1344       }
1345       if (sum > *nrm) *nrm = sum;
1346     }
1347     ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1348   } else if (type == NORM_INFINITY) {
1349     *nrm = 0.0;
1350     for (j=0; j<A->rmap->n; j++) {
1351       v = mat->v + j;
1352       sum = 0.0;
1353       for (i=0; i<A->cmap->n; i++) {
1354         sum += PetscAbsScalar(*v); v += mat->lda;
1355       }
1356       if (sum > *nrm) *nrm = sum;
1357     }
1358     ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1359   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1360   PetscFunctionReturn(0);
1361 }
1362 
1363 #undef __FUNCT__
1364 #define __FUNCT__ "MatSetOption_SeqDense"
1365 PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool  flg)
1366 {
1367   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1368   PetscErrorCode ierr;
1369 
1370   PetscFunctionBegin;
1371   switch (op) {
1372   case MAT_ROW_ORIENTED:
1373     aij->roworiented = flg;
1374     break;
1375   case MAT_NEW_NONZERO_LOCATIONS:
1376   case MAT_NEW_NONZERO_LOCATION_ERR:
1377   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1378   case MAT_NEW_DIAGONALS:
1379   case MAT_KEEP_NONZERO_PATTERN:
1380   case MAT_IGNORE_OFF_PROC_ENTRIES:
1381   case MAT_USE_HASH_TABLE:
1382   case MAT_IGNORE_LOWER_TRIANGULAR:
1383     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
1384     break;
1385   case MAT_SPD:
1386   case MAT_SYMMETRIC:
1387   case MAT_STRUCTURALLY_SYMMETRIC:
1388   case MAT_HERMITIAN:
1389   case MAT_SYMMETRY_ETERNAL:
1390     /* These options are handled directly by MatSetOption() */
1391     break;
1392   default:
1393     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1394   }
1395   PetscFunctionReturn(0);
1396 }
1397 
1398 #undef __FUNCT__
1399 #define __FUNCT__ "MatZeroEntries_SeqDense"
1400 PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1401 {
1402   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1403   PetscErrorCode ierr;
1404   PetscInt       lda=l->lda,m=A->rmap->n,j;
1405 
1406   PetscFunctionBegin;
1407   if (lda>m) {
1408     for (j=0; j<A->cmap->n; j++) {
1409       ierr = PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));CHKERRQ(ierr);
1410     }
1411   } else {
1412     ierr = PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1413   }
1414   PetscFunctionReturn(0);
1415 }
1416 
1417 #undef __FUNCT__
1418 #define __FUNCT__ "MatZeroRows_SeqDense"
1419 PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1420 {
1421   PetscErrorCode    ierr;
1422   Mat_SeqDense      *l = (Mat_SeqDense*)A->data;
1423   PetscInt          m = l->lda, n = A->cmap->n, i,j;
1424   PetscScalar       *slot,*bb;
1425   const PetscScalar *xx;
1426 
1427   PetscFunctionBegin;
1428 #if defined(PETSC_USE_DEBUG)
1429   for (i=0; i<N; i++) {
1430     if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1431     if (rows[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested to be zeroed greater than or equal number of rows %D",rows[i],A->rmap->n);
1432   }
1433 #endif
1434 
1435   /* fix right hand side if needed */
1436   if (x && b) {
1437     ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
1438     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
1439     for (i=0; i<N; i++) {
1440       bb[rows[i]] = diag*xx[rows[i]];
1441     }
1442     ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
1443     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
1444   }
1445 
1446   for (i=0; i<N; i++) {
1447     slot = l->v + rows[i];
1448     for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1449   }
1450   if (diag != 0.0) {
1451     if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1452     for (i=0; i<N; i++) {
1453       slot = l->v + (m+1)*rows[i];
1454       *slot = diag;
1455     }
1456   }
1457   PetscFunctionReturn(0);
1458 }
1459 
1460 #undef __FUNCT__
1461 #define __FUNCT__ "MatDenseGetArray_SeqDense"
1462 PetscErrorCode MatDenseGetArray_SeqDense(Mat A,PetscScalar *array[])
1463 {
1464   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1465 
1466   PetscFunctionBegin;
1467   if (mat->lda != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows");
1468   *array = mat->v;
1469   PetscFunctionReturn(0);
1470 }
1471 
1472 #undef __FUNCT__
1473 #define __FUNCT__ "MatDenseRestoreArray_SeqDense"
1474 PetscErrorCode MatDenseRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1475 {
1476   PetscFunctionBegin;
1477   *array = 0; /* user cannot accidently use the array later */
1478   PetscFunctionReturn(0);
1479 }
1480 
1481 #undef __FUNCT__
1482 #define __FUNCT__ "MatDenseGetArray"
1483 /*@C
1484    MatDenseGetArray - gives access to the array where the data for a SeqDense matrix is stored
1485 
1486    Not Collective
1487 
1488    Input Parameter:
1489 .  mat - a MATSEQDENSE matrix
1490 
1491    Output Parameter:
1492 .   array - pointer to the data
1493 
1494    Level: intermediate
1495 
1496 .seealso: MatDenseRestoreArray()
1497 @*/
1498 PetscErrorCode  MatDenseGetArray(Mat A,PetscScalar **array)
1499 {
1500   PetscErrorCode ierr;
1501 
1502   PetscFunctionBegin;
1503   ierr = PetscUseMethod(A,"MatDenseGetArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
1504   PetscFunctionReturn(0);
1505 }
1506 
1507 #undef __FUNCT__
1508 #define __FUNCT__ "MatDenseRestoreArray"
1509 /*@C
1510    MatDenseRestoreArray - returns access to the array where the data for a SeqDense matrix is stored obtained by MatDenseGetArray()
1511 
1512    Not Collective
1513 
1514    Input Parameters:
1515 .  mat - a MATSEQDENSE matrix
1516 .  array - pointer to the data
1517 
1518    Level: intermediate
1519 
1520 .seealso: MatDenseGetArray()
1521 @*/
1522 PetscErrorCode  MatDenseRestoreArray(Mat A,PetscScalar **array)
1523 {
1524   PetscErrorCode ierr;
1525 
1526   PetscFunctionBegin;
1527   ierr = PetscUseMethod(A,"MatDenseRestoreArray_C",(Mat,PetscScalar**),(A,array));CHKERRQ(ierr);
1528   PetscFunctionReturn(0);
1529 }
1530 
1531 #undef __FUNCT__
1532 #define __FUNCT__ "MatGetSubMatrix_SeqDense"
1533 static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1534 {
1535   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1536   PetscErrorCode ierr;
1537   PetscInt       i,j,nrows,ncols;
1538   const PetscInt *irow,*icol;
1539   PetscScalar    *av,*bv,*v = mat->v;
1540   Mat            newmat;
1541 
1542   PetscFunctionBegin;
1543   ierr = ISGetIndices(isrow,&irow);CHKERRQ(ierr);
1544   ierr = ISGetIndices(iscol,&icol);CHKERRQ(ierr);
1545   ierr = ISGetLocalSize(isrow,&nrows);CHKERRQ(ierr);
1546   ierr = ISGetLocalSize(iscol,&ncols);CHKERRQ(ierr);
1547 
1548   /* Check submatrixcall */
1549   if (scall == MAT_REUSE_MATRIX) {
1550     PetscInt n_cols,n_rows;
1551     ierr = MatGetSize(*B,&n_rows,&n_cols);CHKERRQ(ierr);
1552     if (n_rows != nrows || n_cols != ncols) {
1553       /* resize the result matrix to match number of requested rows/columns */
1554       ierr = MatSetSizes(*B,nrows,ncols,nrows,ncols);CHKERRQ(ierr);
1555     }
1556     newmat = *B;
1557   } else {
1558     /* Create and fill new matrix */
1559     ierr = MatCreate(((PetscObject)A)->comm,&newmat);CHKERRQ(ierr);
1560     ierr = MatSetSizes(newmat,nrows,ncols,nrows,ncols);CHKERRQ(ierr);
1561     ierr = MatSetType(newmat,((PetscObject)A)->type_name);CHKERRQ(ierr);
1562     ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr);
1563   }
1564 
1565   /* Now extract the data pointers and do the copy,column at a time */
1566   bv = ((Mat_SeqDense*)newmat->data)->v;
1567 
1568   for (i=0; i<ncols; i++) {
1569     av = v + mat->lda*icol[i];
1570     for (j=0; j<nrows; j++) {
1571       *bv++ = av[irow[j]];
1572     }
1573   }
1574 
1575   /* Assemble the matrices so that the correct flags are set */
1576   ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1577   ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1578 
1579   /* Free work space */
1580   ierr = ISRestoreIndices(isrow,&irow);CHKERRQ(ierr);
1581   ierr = ISRestoreIndices(iscol,&icol);CHKERRQ(ierr);
1582   *B = newmat;
1583   PetscFunctionReturn(0);
1584 }
1585 
1586 #undef __FUNCT__
1587 #define __FUNCT__ "MatGetSubMatrices_SeqDense"
1588 PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1589 {
1590   PetscErrorCode ierr;
1591   PetscInt       i;
1592 
1593   PetscFunctionBegin;
1594   if (scall == MAT_INITIAL_MATRIX) {
1595     ierr = PetscMalloc((n+1)*sizeof(Mat),B);CHKERRQ(ierr);
1596   }
1597 
1598   for (i=0; i<n; i++) {
1599     ierr = MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);CHKERRQ(ierr);
1600   }
1601   PetscFunctionReturn(0);
1602 }
1603 
1604 #undef __FUNCT__
1605 #define __FUNCT__ "MatAssemblyBegin_SeqDense"
1606 PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1607 {
1608   PetscFunctionBegin;
1609   PetscFunctionReturn(0);
1610 }
1611 
1612 #undef __FUNCT__
1613 #define __FUNCT__ "MatAssemblyEnd_SeqDense"
1614 PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1615 {
1616   PetscFunctionBegin;
1617   PetscFunctionReturn(0);
1618 }
1619 
1620 #undef __FUNCT__
1621 #define __FUNCT__ "MatCopy_SeqDense"
1622 PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1623 {
1624   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1625   PetscErrorCode ierr;
1626   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1627 
1628   PetscFunctionBegin;
1629   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1630   if (A->ops->copy != B->ops->copy) {
1631     ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr);
1632     PetscFunctionReturn(0);
1633   }
1634   if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1635   if (lda1>m || lda2>m) {
1636     for (j=0; j<n; j++) {
1637       ierr = PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));CHKERRQ(ierr);
1638     }
1639   } else {
1640     ierr = PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1641   }
1642   PetscFunctionReturn(0);
1643 }
1644 
1645 #undef __FUNCT__
1646 #define __FUNCT__ "MatSetUp_SeqDense"
1647 PetscErrorCode MatSetUp_SeqDense(Mat A)
1648 {
1649   PetscErrorCode ierr;
1650 
1651   PetscFunctionBegin;
1652   ierr =  MatSeqDenseSetPreallocation(A,0);CHKERRQ(ierr);
1653   PetscFunctionReturn(0);
1654 }
1655 
1656 #undef __FUNCT__
1657 #define __FUNCT__ "MatConjugate_SeqDense"
1658 static PetscErrorCode MatConjugate_SeqDense(Mat A)
1659 {
1660   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1661   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1662   PetscScalar    *aa = a->v;
1663 
1664   PetscFunctionBegin;
1665   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1666   PetscFunctionReturn(0);
1667 }
1668 
1669 #undef __FUNCT__
1670 #define __FUNCT__ "MatRealPart_SeqDense"
1671 static PetscErrorCode MatRealPart_SeqDense(Mat A)
1672 {
1673   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1674   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1675   PetscScalar    *aa = a->v;
1676 
1677   PetscFunctionBegin;
1678   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1679   PetscFunctionReturn(0);
1680 }
1681 
1682 #undef __FUNCT__
1683 #define __FUNCT__ "MatImaginaryPart_SeqDense"
1684 static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1685 {
1686   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1687   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1688   PetscScalar    *aa = a->v;
1689 
1690   PetscFunctionBegin;
1691   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1692   PetscFunctionReturn(0);
1693 }
1694 
1695 /* ----------------------------------------------------------------*/
1696 #undef __FUNCT__
1697 #define __FUNCT__ "MatMatMult_SeqDense_SeqDense"
1698 PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1699 {
1700   PetscErrorCode ierr;
1701 
1702   PetscFunctionBegin;
1703   if (scall == MAT_INITIAL_MATRIX){
1704     ierr = MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1705   }
1706   ierr = MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1707   PetscFunctionReturn(0);
1708 }
1709 
1710 #undef __FUNCT__
1711 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqDense"
1712 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1713 {
1714   PetscErrorCode ierr;
1715   PetscInt       m=A->rmap->n,n=B->cmap->n;
1716   Mat            Cmat;
1717 
1718   PetscFunctionBegin;
1719   if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n);
1720   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1721   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1722   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1723   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1724   Cmat->assembled    = PETSC_TRUE;
1725   Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense;
1726   *C = Cmat;
1727   PetscFunctionReturn(0);
1728 }
1729 
1730 #undef __FUNCT__
1731 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqDense"
1732 PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1733 {
1734   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1735   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1736   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1737   PetscBLASInt   m,n,k;
1738   PetscScalar    _DOne=1.0,_DZero=0.0;
1739 
1740   PetscFunctionBegin;
1741   m = PetscBLASIntCast(A->rmap->n);
1742   n = PetscBLASIntCast(B->cmap->n);
1743   k = PetscBLASIntCast(A->cmap->n);
1744   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1745   PetscFunctionReturn(0);
1746 }
1747 
1748 #undef __FUNCT__
1749 #define __FUNCT__ "MatTransposeMatMult_SeqDense_SeqDense"
1750 PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1751 {
1752   PetscErrorCode ierr;
1753 
1754   PetscFunctionBegin;
1755   if (scall == MAT_INITIAL_MATRIX){
1756     ierr = MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1757   }
1758   ierr = MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1759   PetscFunctionReturn(0);
1760 }
1761 
1762 #undef __FUNCT__
1763 #define __FUNCT__ "MatTransposeMatMultSymbolic_SeqDense_SeqDense"
1764 PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1765 {
1766   PetscErrorCode ierr;
1767   PetscInt       m=A->cmap->n,n=B->cmap->n;
1768   Mat            Cmat;
1769 
1770   PetscFunctionBegin;
1771   if (A->rmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->rmap->n %d != B->rmap->n %d\n",A->rmap->n,B->rmap->n);
1772   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1773   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1774   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1775   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1776   Cmat->assembled = PETSC_TRUE;
1777   *C = Cmat;
1778   PetscFunctionReturn(0);
1779 }
1780 
1781 #undef __FUNCT__
1782 #define __FUNCT__ "MatTransposeMatMultNumeric_SeqDense_SeqDense"
1783 PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1784 {
1785   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1786   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1787   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1788   PetscBLASInt   m,n,k;
1789   PetscScalar    _DOne=1.0,_DZero=0.0;
1790 
1791   PetscFunctionBegin;
1792   m = PetscBLASIntCast(A->cmap->n);
1793   n = PetscBLASIntCast(B->cmap->n);
1794   k = PetscBLASIntCast(A->rmap->n);
1795   /*
1796      Note the m and n arguments below are the number rows and columns of A', not A!
1797   */
1798   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1799   PetscFunctionReturn(0);
1800 }
1801 
1802 #undef __FUNCT__
1803 #define __FUNCT__ "MatGetRowMax_SeqDense"
1804 PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1805 {
1806   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1807   PetscErrorCode ierr;
1808   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1809   PetscScalar    *x;
1810   MatScalar      *aa = a->v;
1811 
1812   PetscFunctionBegin;
1813   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1814 
1815   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1816   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1817   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1818   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1819   for (i=0; i<m; i++) {
1820     x[i] = aa[i]; if (idx) idx[i] = 0;
1821     for (j=1; j<n; j++){
1822       if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1823     }
1824   }
1825   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1826   PetscFunctionReturn(0);
1827 }
1828 
1829 #undef __FUNCT__
1830 #define __FUNCT__ "MatGetRowMaxAbs_SeqDense"
1831 PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1832 {
1833   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1834   PetscErrorCode ierr;
1835   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1836   PetscScalar    *x;
1837   PetscReal      atmp;
1838   MatScalar      *aa = a->v;
1839 
1840   PetscFunctionBegin;
1841   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1842 
1843   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1844   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1845   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1846   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1847   for (i=0; i<m; i++) {
1848     x[i] = PetscAbsScalar(aa[i]);
1849     for (j=1; j<n; j++){
1850       atmp = PetscAbsScalar(aa[i+m*j]);
1851       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1852     }
1853   }
1854   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1855   PetscFunctionReturn(0);
1856 }
1857 
1858 #undef __FUNCT__
1859 #define __FUNCT__ "MatGetRowMin_SeqDense"
1860 PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1861 {
1862   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1863   PetscErrorCode ierr;
1864   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1865   PetscScalar    *x;
1866   MatScalar      *aa = a->v;
1867 
1868   PetscFunctionBegin;
1869   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1870 
1871   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1872   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1873   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1874   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1875   for (i=0; i<m; i++) {
1876     x[i] = aa[i]; if (idx) idx[i] = 0;
1877     for (j=1; j<n; j++){
1878       if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1879     }
1880   }
1881   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1882   PetscFunctionReturn(0);
1883 }
1884 
1885 #undef __FUNCT__
1886 #define __FUNCT__ "MatGetColumnVector_SeqDense"
1887 PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1888 {
1889   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1890   PetscErrorCode ierr;
1891   PetscScalar    *x;
1892 
1893   PetscFunctionBegin;
1894   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1895 
1896   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1897   ierr = PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1898   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1899   PetscFunctionReturn(0);
1900 }
1901 
1902 
1903 #undef __FUNCT__
1904 #define __FUNCT__ "MatGetColumnNorms_SeqDense"
1905 PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1906 {
1907   PetscErrorCode ierr;
1908   PetscInt       i,j,m,n;
1909   PetscScalar    *a;
1910 
1911   PetscFunctionBegin;
1912   ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
1913   ierr = PetscMemzero(norms,n*sizeof(PetscReal));CHKERRQ(ierr);
1914   ierr = MatDenseGetArray(A,&a);CHKERRQ(ierr);
1915   if (type == NORM_2) {
1916     for (i=0; i<n; i++ ){
1917       for (j=0; j<m; j++) {
1918 	norms[i] += PetscAbsScalar(a[j]*a[j]);
1919       }
1920       a += m;
1921     }
1922   } else if (type == NORM_1) {
1923     for (i=0; i<n; i++ ){
1924       for (j=0; j<m; j++) {
1925 	norms[i] += PetscAbsScalar(a[j]);
1926       }
1927       a += m;
1928     }
1929   } else if (type == NORM_INFINITY) {
1930     for (i=0; i<n; i++ ){
1931       for (j=0; j<m; j++) {
1932 	norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1933       }
1934       a += m;
1935     }
1936   } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1937   ierr = MatDenseRestoreArray(A,&a);CHKERRQ(ierr);
1938   if (type == NORM_2) {
1939     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1940   }
1941   PetscFunctionReturn(0);
1942 }
1943 
1944 #undef __FUNCT__
1945 #define __FUNCT__ "MatSetRandom_SeqDense"
1946 static PetscErrorCode  MatSetRandom_SeqDense(Mat x,PetscRandom rctx)
1947 {
1948   PetscErrorCode ierr;
1949   PetscScalar    *a;
1950   PetscInt       m,n,i;
1951 
1952   PetscFunctionBegin;
1953   ierr = MatGetSize(x,&m,&n);CHKERRQ(ierr);
1954   ierr = MatDenseGetArray(x,&a);CHKERRQ(ierr);
1955   for (i=0; i<m*n; i++) {
1956     ierr = PetscRandomGetValue(rctx,a+i);CHKERRQ(ierr);
1957   }
1958   ierr = MatDenseRestoreArray(x,&a);CHKERRQ(ierr);
1959   PetscFunctionReturn(0);
1960 }
1961 
1962 
1963 /* -------------------------------------------------------------------*/
1964 static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1965        MatGetRow_SeqDense,
1966        MatRestoreRow_SeqDense,
1967        MatMult_SeqDense,
1968 /* 4*/ MatMultAdd_SeqDense,
1969        MatMultTranspose_SeqDense,
1970        MatMultTransposeAdd_SeqDense,
1971        0,
1972        0,
1973        0,
1974 /*10*/ 0,
1975        MatLUFactor_SeqDense,
1976        MatCholeskyFactor_SeqDense,
1977        MatSOR_SeqDense,
1978        MatTranspose_SeqDense,
1979 /*15*/ MatGetInfo_SeqDense,
1980        MatEqual_SeqDense,
1981        MatGetDiagonal_SeqDense,
1982        MatDiagonalScale_SeqDense,
1983        MatNorm_SeqDense,
1984 /*20*/ MatAssemblyBegin_SeqDense,
1985        MatAssemblyEnd_SeqDense,
1986        MatSetOption_SeqDense,
1987        MatZeroEntries_SeqDense,
1988 /*24*/ MatZeroRows_SeqDense,
1989        0,
1990        0,
1991        0,
1992        0,
1993 /*29*/ MatSetUp_SeqDense,
1994        0,
1995        0,
1996        0,
1997        0,
1998 /*34*/ MatDuplicate_SeqDense,
1999        0,
2000        0,
2001        0,
2002        0,
2003 /*39*/ MatAXPY_SeqDense,
2004        MatGetSubMatrices_SeqDense,
2005        0,
2006        MatGetValues_SeqDense,
2007        MatCopy_SeqDense,
2008 /*44*/ MatGetRowMax_SeqDense,
2009        MatScale_SeqDense,
2010        0,
2011        0,
2012        0,
2013 /*49*/ MatSetRandom_SeqDense,
2014        0,
2015        0,
2016        0,
2017        0,
2018 /*54*/ 0,
2019        0,
2020        0,
2021        0,
2022        0,
2023 /*59*/ 0,
2024        MatDestroy_SeqDense,
2025        MatView_SeqDense,
2026        0,
2027        0,
2028 /*64*/ 0,
2029        0,
2030        0,
2031        0,
2032        0,
2033 /*69*/ MatGetRowMaxAbs_SeqDense,
2034        0,
2035        0,
2036        0,
2037        0,
2038 /*74*/ 0,
2039        0,
2040        0,
2041        0,
2042        0,
2043 /*79*/ 0,
2044        0,
2045        0,
2046        0,
2047 /*83*/ MatLoad_SeqDense,
2048        0,
2049        MatIsHermitian_SeqDense,
2050        0,
2051        0,
2052        0,
2053 /*89*/ MatMatMult_SeqDense_SeqDense,
2054        MatMatMultSymbolic_SeqDense_SeqDense,
2055        MatMatMultNumeric_SeqDense_SeqDense,
2056        0,
2057        0,
2058 /*94*/ 0,
2059        0,
2060        0,
2061        0,
2062        0,
2063 /*99*/ 0,
2064        0,
2065        0,
2066        MatConjugate_SeqDense,
2067        0,
2068 /*104*/0,
2069        MatRealPart_SeqDense,
2070        MatImaginaryPart_SeqDense,
2071        0,
2072        0,
2073 /*109*/MatMatSolve_SeqDense,
2074        0,
2075        MatGetRowMin_SeqDense,
2076        MatGetColumnVector_SeqDense,
2077        0,
2078 /*114*/0,
2079        0,
2080        0,
2081        0,
2082        0,
2083 /*119*/0,
2084        0,
2085        0,
2086        0,
2087        0,
2088 /*124*/0,
2089        MatGetColumnNorms_SeqDense,
2090        0,
2091        0,
2092        0,
2093 /*129*/0,
2094        MatTransposeMatMult_SeqDense_SeqDense,
2095        MatTransposeMatMultSymbolic_SeqDense_SeqDense,
2096        MatTransposeMatMultNumeric_SeqDense_SeqDense,
2097 };
2098 
2099 #undef __FUNCT__
2100 #define __FUNCT__ "MatCreateSeqDense"
2101 /*@C
2102    MatCreateSeqDense - Creates a sequential dense matrix that
2103    is stored in column major order (the usual Fortran 77 manner). Many
2104    of the matrix operations use the BLAS and LAPACK routines.
2105 
2106    Collective on MPI_Comm
2107 
2108    Input Parameters:
2109 +  comm - MPI communicator, set to PETSC_COMM_SELF
2110 .  m - number of rows
2111 .  n - number of columns
2112 -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
2113    to control all matrix memory allocation.
2114 
2115    Output Parameter:
2116 .  A - the matrix
2117 
2118    Notes:
2119    The data input variable is intended primarily for Fortran programmers
2120    who wish to allocate their own matrix memory space.  Most users should
2121    set data=PETSC_NULL.
2122 
2123    Level: intermediate
2124 
2125 .keywords: dense, matrix, LAPACK, BLAS
2126 
2127 .seealso: MatCreate(), MatCreateDense(), MatSetValues()
2128 @*/
2129 PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2130 {
2131   PetscErrorCode ierr;
2132 
2133   PetscFunctionBegin;
2134   ierr = MatCreate(comm,A);CHKERRQ(ierr);
2135   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
2136   ierr = MatSetType(*A,MATSEQDENSE);CHKERRQ(ierr);
2137   ierr = MatSeqDenseSetPreallocation(*A,data);CHKERRQ(ierr);
2138   PetscFunctionReturn(0);
2139 }
2140 
2141 #undef __FUNCT__
2142 #define __FUNCT__ "MatSeqDenseSetPreallocation"
2143 /*@C
2144    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
2145 
2146    Collective on MPI_Comm
2147 
2148    Input Parameters:
2149 +  A - the matrix
2150 -  data - the array (or PETSC_NULL)
2151 
2152    Notes:
2153    The data input variable is intended primarily for Fortran programmers
2154    who wish to allocate their own matrix memory space.  Most users should
2155    need not call this routine.
2156 
2157    Level: intermediate
2158 
2159 .keywords: dense, matrix, LAPACK, BLAS
2160 
2161 .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA()
2162 
2163 @*/
2164 PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2165 {
2166   PetscErrorCode ierr;
2167 
2168   PetscFunctionBegin;
2169   ierr = PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));CHKERRQ(ierr);
2170   PetscFunctionReturn(0);
2171 }
2172 
2173 EXTERN_C_BEGIN
2174 #undef __FUNCT__
2175 #define __FUNCT__ "MatSeqDenseSetPreallocation_SeqDense"
2176 PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2177 {
2178   Mat_SeqDense   *b;
2179   PetscErrorCode ierr;
2180 
2181   PetscFunctionBegin;
2182   B->preallocated = PETSC_TRUE;
2183 
2184   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
2185   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
2186 
2187   b       = (Mat_SeqDense*)B->data;
2188   b->Mmax = B->rmap->n;
2189   b->Nmax = B->cmap->n;
2190   if (b->lda <= 0 || b->changelda) b->lda = B->rmap->n;
2191 
2192   if (!data) { /* petsc-allocated storage */
2193     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2194     ierr = PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);CHKERRQ(ierr);
2195     ierr = PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2196     ierr = PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2197     b->user_alloc = PETSC_FALSE;
2198   } else { /* user-allocated storage */
2199     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2200     b->v          = data;
2201     b->user_alloc = PETSC_TRUE;
2202   }
2203   B->assembled = PETSC_TRUE;
2204   PetscFunctionReturn(0);
2205 }
2206 EXTERN_C_END
2207 
2208 #undef __FUNCT__
2209 #define __FUNCT__ "MatSeqDenseSetLDA"
2210 /*@C
2211   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2212 
2213   Input parameter:
2214 + A - the matrix
2215 - lda - the leading dimension
2216 
2217   Notes:
2218   This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2219   it asserts that the preallocation has a leading dimension (the LDA parameter
2220   of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2221 
2222   Level: intermediate
2223 
2224 .keywords: dense, matrix, LAPACK, BLAS
2225 
2226 .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2227 
2228 @*/
2229 PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2230 {
2231   Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2232 
2233   PetscFunctionBegin;
2234   if (lda < B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n);
2235   b->lda       = lda;
2236   b->changelda = PETSC_FALSE;
2237   b->Mmax      = PetscMax(b->Mmax,lda);
2238   PetscFunctionReturn(0);
2239 }
2240 
2241 /*MC
2242    MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2243 
2244    Options Database Keys:
2245 . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2246 
2247   Level: beginner
2248 
2249 .seealso: MatCreateSeqDense()
2250 
2251 M*/
2252 
2253 EXTERN_C_BEGIN
2254 #undef __FUNCT__
2255 #define __FUNCT__ "MatCreate_SeqDense"
2256 PetscErrorCode  MatCreate_SeqDense(Mat B)
2257 {
2258   Mat_SeqDense   *b;
2259   PetscErrorCode ierr;
2260   PetscMPIInt    size;
2261 
2262   PetscFunctionBegin;
2263   ierr = MPI_Comm_size(((PetscObject)B)->comm,&size);CHKERRQ(ierr);
2264   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2265 
2266   ierr            = PetscNewLog(B,Mat_SeqDense,&b);CHKERRQ(ierr);
2267   ierr            = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
2268   B->data         = (void*)b;
2269 
2270   b->pivots       = 0;
2271   b->roworiented  = PETSC_TRUE;
2272   b->v            = 0;
2273   b->changelda    = PETSC_FALSE;
2274 
2275   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatDenseGetArray_C","MatDenseGetArray_SeqDense",MatDenseGetArray_SeqDense);CHKERRQ(ierr);
2276   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatDenseRestoreArray_C","MatDenseRestoreArray_SeqDense",MatDenseRestoreArray_SeqDense);CHKERRQ(ierr);
2277 
2278   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);CHKERRQ(ierr);
2279   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2280                                      "MatGetFactor_seqdense_petsc",
2281                                       MatGetFactor_seqdense_petsc);CHKERRQ(ierr);
2282   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2283                                     "MatSeqDenseSetPreallocation_SeqDense",
2284                                      MatSeqDenseSetPreallocation_SeqDense);CHKERRQ(ierr);
2285 
2286   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2287                                      "MatMatMult_SeqAIJ_SeqDense",
2288                                       MatMatMult_SeqAIJ_SeqDense);CHKERRQ(ierr);
2289 
2290 
2291   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2292                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2293                                       MatMatMultSymbolic_SeqAIJ_SeqDense);CHKERRQ(ierr);
2294   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2295                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2296                                       MatMatMultNumeric_SeqAIJ_SeqDense);CHKERRQ(ierr);
2297   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);CHKERRQ(ierr);
2298   PetscFunctionReturn(0);
2299 }
2300 EXTERN_C_END
2301