xref: /petsc/src/mat/impls/dense/seq/dense.c (revision b45d2f2cb7e031d9c0de5873eca80614ca7b863b)
1 
2 /*
3      Defines the basic matrix operations for sequential dense.
4 */
5 
6 #include <../src/mat/impls/dense/seq/dense.h>
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 = PetscTypeCompareAny((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 = PetscTypeCompareAny((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 = MatGetArray(B,&b);CHKERRQ(ierr);
251   ierr = MatGetArray(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 = MatRestoreArray(B,&b);CHKERRQ(ierr);
273   ierr = MatRestoreArray(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->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
499   PetscFunctionReturn(0);
500 }
501 
502 #undef __FUNCT__
503 #define __FUNCT__ "MatLUFactorSymbolic_SeqDense"
504 PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
505 {
506   PetscFunctionBegin;
507   fact->preallocated         = PETSC_TRUE;
508   fact->assembled            = PETSC_TRUE;
509   fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
510   PetscFunctionReturn(0);
511 }
512 
513 EXTERN_C_BEGIN
514 #undef __FUNCT__
515 #define __FUNCT__ "MatGetFactor_seqdense_petsc"
516 PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
517 {
518   PetscErrorCode ierr;
519 
520   PetscFunctionBegin;
521   ierr = MatCreate(((PetscObject)A)->comm,fact);CHKERRQ(ierr);
522   ierr = MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
523   ierr = MatSetType(*fact,((PetscObject)A)->type_name);CHKERRQ(ierr);
524   if (ftype == MAT_FACTOR_LU){
525     (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
526   } else {
527     (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
528   }
529   (*fact)->factortype = ftype;
530   PetscFunctionReturn(0);
531 }
532 EXTERN_C_END
533 
534 /* ------------------------------------------------------------------*/
535 #undef __FUNCT__
536 #define __FUNCT__ "MatSOR_SeqDense"
537 PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
538 {
539   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
540   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
541   PetscErrorCode ierr;
542   PetscInt       m = A->rmap->n,i;
543   PetscBLASInt   o = 1,bm = PetscBLASIntCast(m);
544 
545   PetscFunctionBegin;
546   if (flag & SOR_ZERO_INITIAL_GUESS) {
547     /* this is a hack fix, should have another version without the second BLASdot */
548     ierr = VecSet(xx,zero);CHKERRQ(ierr);
549   }
550   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
551   ierr = VecGetArray(bb,&b);CHKERRQ(ierr);
552   its  = its*lits;
553   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
554   while (its--) {
555     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
556       for (i=0; i<m; i++) {
557         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
558         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
559       }
560     }
561     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
562       for (i=m-1; i>=0; i--) {
563         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
564         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
565       }
566     }
567   }
568   ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr);
569   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
570   PetscFunctionReturn(0);
571 }
572 
573 /* -----------------------------------------------------------------*/
574 #undef __FUNCT__
575 #define __FUNCT__ "MatMultTranspose_SeqDense"
576 PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
577 {
578   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
579   PetscScalar    *v = mat->v,*x,*y;
580   PetscErrorCode ierr;
581   PetscBLASInt   m, n,_One=1;
582   PetscScalar    _DOne=1.0,_DZero=0.0;
583 
584   PetscFunctionBegin;
585   m = PetscBLASIntCast(A->rmap->n);
586   n = PetscBLASIntCast(A->cmap->n);
587   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
588   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
589   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
590   BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
591   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
592   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
593   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr);
594   PetscFunctionReturn(0);
595 }
596 
597 #undef __FUNCT__
598 #define __FUNCT__ "MatMult_SeqDense"
599 PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
600 {
601   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
602   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
603   PetscErrorCode ierr;
604   PetscBLASInt   m, n, _One=1;
605 
606   PetscFunctionBegin;
607   m = PetscBLASIntCast(A->rmap->n);
608   n = PetscBLASIntCast(A->cmap->n);
609   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
610   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
611   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
612   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
613   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
614   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
615   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);CHKERRQ(ierr);
616   PetscFunctionReturn(0);
617 }
618 
619 #undef __FUNCT__
620 #define __FUNCT__ "MatMultAdd_SeqDense"
621 PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
622 {
623   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
624   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
625   PetscErrorCode ierr;
626   PetscBLASInt   m, n, _One=1;
627 
628   PetscFunctionBegin;
629   m = PetscBLASIntCast(A->rmap->n);
630   n = PetscBLASIntCast(A->cmap->n);
631   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
632   if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);}
633   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
634   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
635   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
636   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
637   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
638   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr);
639   PetscFunctionReturn(0);
640 }
641 
642 #undef __FUNCT__
643 #define __FUNCT__ "MatMultTransposeAdd_SeqDense"
644 PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
645 {
646   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
647   PetscScalar    *v = mat->v,*x,*y;
648   PetscErrorCode ierr;
649   PetscBLASInt   m, n, _One=1;
650   PetscScalar    _DOne=1.0;
651 
652   PetscFunctionBegin;
653   m = PetscBLASIntCast(A->rmap->n);
654   n = PetscBLASIntCast(A->cmap->n);
655   if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0);
656   if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);}
657   ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
658   ierr = VecGetArray(yy,&y);CHKERRQ(ierr);
659   BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
660   ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
661   ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr);
662   ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr);
663   PetscFunctionReturn(0);
664 }
665 
666 /* -----------------------------------------------------------------*/
667 #undef __FUNCT__
668 #define __FUNCT__ "MatGetRow_SeqDense"
669 PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
670 {
671   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
672   PetscScalar    *v;
673   PetscErrorCode ierr;
674   PetscInt       i;
675 
676   PetscFunctionBegin;
677   *ncols = A->cmap->n;
678   if (cols) {
679     ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);CHKERRQ(ierr);
680     for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
681   }
682   if (vals) {
683     ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);CHKERRQ(ierr);
684     v    = mat->v + row;
685     for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
686   }
687   PetscFunctionReturn(0);
688 }
689 
690 #undef __FUNCT__
691 #define __FUNCT__ "MatRestoreRow_SeqDense"
692 PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
693 {
694   PetscErrorCode ierr;
695   PetscFunctionBegin;
696   if (cols) {ierr = PetscFree(*cols);CHKERRQ(ierr);}
697   if (vals) {ierr = PetscFree(*vals);CHKERRQ(ierr); }
698   PetscFunctionReturn(0);
699 }
700 /* ----------------------------------------------------------------*/
701 #undef __FUNCT__
702 #define __FUNCT__ "MatSetValues_SeqDense"
703 PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
704 {
705   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
706   PetscInt     i,j,idx=0;
707 
708   PetscFunctionBegin;
709   if (v) PetscValidScalarPointer(v,6);
710   if (!mat->roworiented) {
711     if (addv == INSERT_VALUES) {
712       for (j=0; j<n; j++) {
713         if (indexn[j] < 0) {idx += m; continue;}
714 #if defined(PETSC_USE_DEBUG)
715         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);
716 #endif
717         for (i=0; i<m; i++) {
718           if (indexm[i] < 0) {idx++; continue;}
719 #if defined(PETSC_USE_DEBUG)
720           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);
721 #endif
722           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
723         }
724       }
725     } else {
726       for (j=0; j<n; j++) {
727         if (indexn[j] < 0) {idx += m; continue;}
728 #if defined(PETSC_USE_DEBUG)
729         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);
730 #endif
731         for (i=0; i<m; i++) {
732           if (indexm[i] < 0) {idx++; continue;}
733 #if defined(PETSC_USE_DEBUG)
734           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);
735 #endif
736           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
737         }
738       }
739     }
740   } else {
741     if (addv == INSERT_VALUES) {
742       for (i=0; i<m; i++) {
743         if (indexm[i] < 0) { idx += n; continue;}
744 #if defined(PETSC_USE_DEBUG)
745         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);
746 #endif
747         for (j=0; j<n; j++) {
748           if (indexn[j] < 0) { idx++; continue;}
749 #if defined(PETSC_USE_DEBUG)
750           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);
751 #endif
752           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
753         }
754       }
755     } else {
756       for (i=0; i<m; i++) {
757         if (indexm[i] < 0) { idx += n; continue;}
758 #if defined(PETSC_USE_DEBUG)
759         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);
760 #endif
761         for (j=0; j<n; j++) {
762           if (indexn[j] < 0) { idx++; continue;}
763 #if defined(PETSC_USE_DEBUG)
764           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);
765 #endif
766           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
767         }
768       }
769     }
770   }
771   PetscFunctionReturn(0);
772 }
773 
774 #undef __FUNCT__
775 #define __FUNCT__ "MatGetValues_SeqDense"
776 PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
777 {
778   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
779   PetscInt     i,j;
780 
781   PetscFunctionBegin;
782   /* row-oriented output */
783   for (i=0; i<m; i++) {
784     if (indexm[i] < 0) {v += n;continue;}
785     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);
786     for (j=0; j<n; j++) {
787       if (indexn[j] < 0) {v++; continue;}
788       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);
789       *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
790     }
791   }
792   PetscFunctionReturn(0);
793 }
794 
795 /* -----------------------------------------------------------------*/
796 
797 #undef __FUNCT__
798 #define __FUNCT__ "MatLoad_SeqDense"
799 PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
800 {
801   Mat_SeqDense   *a;
802   PetscErrorCode ierr;
803   PetscInt       *scols,i,j,nz,header[4];
804   int            fd;
805   PetscMPIInt    size;
806   PetscInt       *rowlengths = 0,M,N,*cols,grows,gcols;
807   PetscScalar    *vals,*svals,*v,*w;
808   MPI_Comm       comm = ((PetscObject)viewer)->comm;
809 
810   PetscFunctionBegin;
811   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
812   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
813   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
814   ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr);
815   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
816   M = header[1]; N = header[2]; nz = header[3];
817 
818   /* set global size if not set already*/
819   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
820     ierr = MatSetSizes(newmat,M,N,M,N);CHKERRQ(ierr);
821   } else {
822     /* if sizes and type are already set, check if the vector global sizes are correct */
823     ierr = MatGetSize(newmat,&grows,&gcols);CHKERRQ(ierr);
824     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);
825   }
826   ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr);
827 
828   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
829     a    = (Mat_SeqDense*)newmat->data;
830     v    = a->v;
831     /* Allocate some temp space to read in the values and then flip them
832        from row major to column major */
833     ierr = PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);CHKERRQ(ierr);
834     /* read in nonzero values */
835     ierr = PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);CHKERRQ(ierr);
836     /* now flip the values and store them in the matrix*/
837     for (j=0; j<N; j++) {
838       for (i=0; i<M; i++) {
839         *v++ =w[i*N+j];
840       }
841     }
842     ierr = PetscFree(w);CHKERRQ(ierr);
843   } else {
844     /* read row lengths */
845     ierr = PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);CHKERRQ(ierr);
846     ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr);
847 
848     a = (Mat_SeqDense*)newmat->data;
849     v = a->v;
850 
851     /* read column indices and nonzeros */
852     ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&scols);CHKERRQ(ierr);
853     cols = scols;
854     ierr = PetscBinaryRead(fd,cols,nz,PETSC_INT);CHKERRQ(ierr);
855     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);CHKERRQ(ierr);
856     vals = svals;
857     ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);CHKERRQ(ierr);
858 
859     /* insert into matrix */
860     for (i=0; i<M; i++) {
861       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
862       svals += rowlengths[i]; scols += rowlengths[i];
863     }
864     ierr = PetscFree(vals);CHKERRQ(ierr);
865     ierr = PetscFree(cols);CHKERRQ(ierr);
866     ierr = PetscFree(rowlengths);CHKERRQ(ierr);
867   }
868   ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
869   ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
870 
871   PetscFunctionReturn(0);
872 }
873 
874 #undef __FUNCT__
875 #define __FUNCT__ "MatView_SeqDense_ASCII"
876 static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
877 {
878   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
879   PetscErrorCode    ierr;
880   PetscInt          i,j;
881   const char        *name;
882   PetscScalar       *v;
883   PetscViewerFormat format;
884 #if defined(PETSC_USE_COMPLEX)
885   PetscBool         allreal = PETSC_TRUE;
886 #endif
887 
888   PetscFunctionBegin;
889   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
890   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
891     PetscFunctionReturn(0);  /* do nothing for now */
892   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
893     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
894     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr);
895     for (i=0; i<A->rmap->n; i++) {
896       v = a->v + i;
897       ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr);
898       for (j=0; j<A->cmap->n; j++) {
899 #if defined(PETSC_USE_COMPLEX)
900         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
901           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));CHKERRQ(ierr);
902         } else if (PetscRealPart(*v)) {
903           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));CHKERRQ(ierr);
904         }
905 #else
906         if (*v) {
907           ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);CHKERRQ(ierr);
908         }
909 #endif
910         v += a->lda;
911       }
912       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
913     }
914     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
915   } else {
916     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
917 #if defined(PETSC_USE_COMPLEX)
918     /* determine if matrix has all real values */
919     v = a->v;
920     for (i=0; i<A->rmap->n*A->cmap->n; i++) {
921 	if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
922     }
923 #endif
924     if (format == PETSC_VIEWER_ASCII_MATLAB) {
925       ierr = PetscObjectGetName((PetscObject)A,&name);CHKERRQ(ierr);
926       ierr = PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);CHKERRQ(ierr);
927       ierr = PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
928       ierr = PetscViewerASCIIPrintf(viewer,"%s = [\n",name);CHKERRQ(ierr);
929     } else {
930       ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr);
931     }
932 
933     for (i=0; i<A->rmap->n; i++) {
934       v = a->v + i;
935       for (j=0; j<A->cmap->n; j++) {
936 #if defined(PETSC_USE_COMPLEX)
937         if (allreal) {
938           ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));CHKERRQ(ierr);
939         } else {
940           ierr = PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei ",PetscRealPart(*v),PetscImaginaryPart(*v));CHKERRQ(ierr);
941         }
942 #else
943         ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);CHKERRQ(ierr);
944 #endif
945 	v += a->lda;
946       }
947       ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
948     }
949     if (format == PETSC_VIEWER_ASCII_MATLAB) {
950       ierr = PetscViewerASCIIPrintf(viewer,"];\n");CHKERRQ(ierr);
951     }
952     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
953   }
954   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
955   PetscFunctionReturn(0);
956 }
957 
958 #undef __FUNCT__
959 #define __FUNCT__ "MatView_SeqDense_Binary"
960 static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
961 {
962   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
963   PetscErrorCode    ierr;
964   int               fd;
965   PetscInt          ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
966   PetscScalar       *v,*anonz,*vals;
967   PetscViewerFormat format;
968 
969   PetscFunctionBegin;
970   ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
971 
972   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
973   if (format == PETSC_VIEWER_NATIVE) {
974     /* store the matrix as a dense matrix */
975     ierr = PetscMalloc(4*sizeof(PetscInt),&col_lens);CHKERRQ(ierr);
976     col_lens[0] = MAT_FILE_CLASSID;
977     col_lens[1] = m;
978     col_lens[2] = n;
979     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
980     ierr = PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
981     ierr = PetscFree(col_lens);CHKERRQ(ierr);
982 
983     /* write out matrix, by rows */
984     ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
985     v    = a->v;
986     for (j=0; j<n; j++) {
987       for (i=0; i<m; i++) {
988         vals[j + i*n] = *v++;
989       }
990     }
991     ierr = PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
992     ierr = PetscFree(vals);CHKERRQ(ierr);
993   } else {
994     ierr = PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);CHKERRQ(ierr);
995     col_lens[0] = MAT_FILE_CLASSID;
996     col_lens[1] = m;
997     col_lens[2] = n;
998     col_lens[3] = nz;
999 
1000     /* store lengths of each row and write (including header) to file */
1001     for (i=0; i<m; i++) col_lens[4+i] = n;
1002     ierr = PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr);
1003 
1004     /* Possibly should write in smaller increments, not whole matrix at once? */
1005     /* store column indices (zero start index) */
1006     ict = 0;
1007     for (i=0; i<m; i++) {
1008       for (j=0; j<n; j++) col_lens[ict++] = j;
1009     }
1010     ierr = PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
1011     ierr = PetscFree(col_lens);CHKERRQ(ierr);
1012 
1013     /* store nonzero values */
1014     ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);CHKERRQ(ierr);
1015     ict  = 0;
1016     for (i=0; i<m; i++) {
1017       v = a->v + i;
1018       for (j=0; j<n; j++) {
1019         anonz[ict++] = *v; v += a->lda;
1020       }
1021     }
1022     ierr = PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
1023     ierr = PetscFree(anonz);CHKERRQ(ierr);
1024   }
1025   PetscFunctionReturn(0);
1026 }
1027 
1028 #undef __FUNCT__
1029 #define __FUNCT__ "MatView_SeqDense_Draw_Zoom"
1030 PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1031 {
1032   Mat               A = (Mat) Aa;
1033   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
1034   PetscErrorCode    ierr;
1035   PetscInt          m = A->rmap->n,n = A->cmap->n,color,i,j;
1036   PetscScalar       *v = a->v;
1037   PetscViewer       viewer;
1038   PetscDraw         popup;
1039   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1040   PetscViewerFormat format;
1041 
1042   PetscFunctionBegin;
1043 
1044   ierr = PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);CHKERRQ(ierr);
1045   ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
1046   ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
1047 
1048   /* Loop over matrix elements drawing boxes */
1049   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1050     /* Blue for negative and Red for positive */
1051     color = PETSC_DRAW_BLUE;
1052     for(j = 0; j < n; j++) {
1053       x_l = j;
1054       x_r = x_l + 1.0;
1055       for(i = 0; i < m; i++) {
1056         y_l = m - i - 1.0;
1057         y_r = y_l + 1.0;
1058 #if defined(PETSC_USE_COMPLEX)
1059         if (PetscRealPart(v[j*m+i]) >  0.) {
1060           color = PETSC_DRAW_RED;
1061         } else if (PetscRealPart(v[j*m+i]) <  0.) {
1062           color = PETSC_DRAW_BLUE;
1063         } else {
1064           continue;
1065         }
1066 #else
1067         if (v[j*m+i] >  0.) {
1068           color = PETSC_DRAW_RED;
1069         } else if (v[j*m+i] <  0.) {
1070           color = PETSC_DRAW_BLUE;
1071         } else {
1072           continue;
1073         }
1074 #endif
1075         ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
1076       }
1077     }
1078   } else {
1079     /* use contour shading to indicate magnitude of values */
1080     /* first determine max of all nonzero values */
1081     for(i = 0; i < m*n; i++) {
1082       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1083     }
1084     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1085     ierr  = PetscDrawGetPopup(draw,&popup);CHKERRQ(ierr);
1086     if (popup) {ierr  = PetscDrawScalePopup(popup,0.0,maxv);CHKERRQ(ierr);}
1087     for(j = 0; j < n; j++) {
1088       x_l = j;
1089       x_r = x_l + 1.0;
1090       for(i = 0; i < m; i++) {
1091         y_l   = m - i - 1.0;
1092         y_r   = y_l + 1.0;
1093         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1094         ierr  = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr);
1095       }
1096     }
1097   }
1098   PetscFunctionReturn(0);
1099 }
1100 
1101 #undef __FUNCT__
1102 #define __FUNCT__ "MatView_SeqDense_Draw"
1103 PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1104 {
1105   PetscDraw      draw;
1106   PetscBool      isnull;
1107   PetscReal      xr,yr,xl,yl,h,w;
1108   PetscErrorCode ierr;
1109 
1110   PetscFunctionBegin;
1111   ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
1112   ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
1113   if (isnull) PetscFunctionReturn(0);
1114 
1115   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr);
1116   xr  = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1117   xr += w;    yr += h;  xl = -w;     yl = -h;
1118   ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr);
1119   ierr = PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);CHKERRQ(ierr);
1120   ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);CHKERRQ(ierr);
1121   PetscFunctionReturn(0);
1122 }
1123 
1124 #undef __FUNCT__
1125 #define __FUNCT__ "MatView_SeqDense"
1126 PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1127 {
1128   PetscErrorCode ierr;
1129   PetscBool      iascii,isbinary,isdraw;
1130 
1131   PetscFunctionBegin;
1132   ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1133   ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1134   ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
1135 
1136   if (iascii) {
1137     ierr = MatView_SeqDense_ASCII(A,viewer);CHKERRQ(ierr);
1138   } else if (isbinary) {
1139     ierr = MatView_SeqDense_Binary(A,viewer);CHKERRQ(ierr);
1140   } else if (isdraw) {
1141     ierr = MatView_SeqDense_Draw(A,viewer);CHKERRQ(ierr);
1142   } else {
1143     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1144   }
1145   PetscFunctionReturn(0);
1146 }
1147 
1148 #undef __FUNCT__
1149 #define __FUNCT__ "MatDestroy_SeqDense"
1150 PetscErrorCode MatDestroy_SeqDense(Mat mat)
1151 {
1152   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;
1153   PetscErrorCode ierr;
1154 
1155   PetscFunctionBegin;
1156 #if defined(PETSC_USE_LOG)
1157   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1158 #endif
1159   ierr = PetscFree(l->pivots);CHKERRQ(ierr);
1160   if (!l->user_alloc) {ierr = PetscFree(l->v);CHKERRQ(ierr);}
1161   ierr = PetscFree(mat->data);CHKERRQ(ierr);
1162 
1163   ierr = PetscObjectChangeTypeName((PetscObject)mat,0);CHKERRQ(ierr);
1164   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);CHKERRQ(ierr);
1165   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1166   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1167   ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr);
1168   PetscFunctionReturn(0);
1169 }
1170 
1171 #undef __FUNCT__
1172 #define __FUNCT__ "MatTranspose_SeqDense"
1173 PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1174 {
1175   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1176   PetscErrorCode ierr;
1177   PetscInt       k,j,m,n,M;
1178   PetscScalar    *v,tmp;
1179 
1180   PetscFunctionBegin;
1181   v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1182   if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1183     if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1184     else {
1185       for (j=0; j<m; j++) {
1186         for (k=0; k<j; k++) {
1187           tmp = v[j + k*M];
1188           v[j + k*M] = v[k + j*M];
1189           v[k + j*M] = tmp;
1190         }
1191       }
1192     }
1193   } else { /* out-of-place transpose */
1194     Mat          tmat;
1195     Mat_SeqDense *tmatd;
1196     PetscScalar  *v2;
1197 
1198     if (reuse == MAT_INITIAL_MATRIX) {
1199       ierr  = MatCreate(((PetscObject)A)->comm,&tmat);CHKERRQ(ierr);
1200       ierr  = MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);CHKERRQ(ierr);
1201       ierr  = MatSetType(tmat,((PetscObject)A)->type_name);CHKERRQ(ierr);
1202       ierr  = MatSeqDenseSetPreallocation(tmat,PETSC_NULL);CHKERRQ(ierr);
1203     } else {
1204       tmat = *matout;
1205     }
1206     tmatd = (Mat_SeqDense*)tmat->data;
1207     v = mat->v; v2 = tmatd->v;
1208     for (j=0; j<n; j++) {
1209       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1210     }
1211     ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1212     ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1213     *matout = tmat;
1214   }
1215   PetscFunctionReturn(0);
1216 }
1217 
1218 #undef __FUNCT__
1219 #define __FUNCT__ "MatEqual_SeqDense"
1220 PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool  *flg)
1221 {
1222   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1223   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1224   PetscInt     i,j;
1225   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;
1226 
1227   PetscFunctionBegin;
1228   if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1229   if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1230   for (i=0; i<A1->rmap->n; i++) {
1231     v1 = mat1->v+i; v2 = mat2->v+i;
1232     for (j=0; j<A1->cmap->n; j++) {
1233       if (*v1 != *v2) {*flg = PETSC_FALSE; PetscFunctionReturn(0);}
1234       v1 += mat1->lda; v2 += mat2->lda;
1235     }
1236   }
1237   *flg = PETSC_TRUE;
1238   PetscFunctionReturn(0);
1239 }
1240 
1241 #undef __FUNCT__
1242 #define __FUNCT__ "MatGetDiagonal_SeqDense"
1243 PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1244 {
1245   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1246   PetscErrorCode ierr;
1247   PetscInt       i,n,len;
1248   PetscScalar    *x,zero = 0.0;
1249 
1250   PetscFunctionBegin;
1251   ierr = VecSet(v,zero);CHKERRQ(ierr);
1252   ierr = VecGetSize(v,&n);CHKERRQ(ierr);
1253   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1254   len = PetscMin(A->rmap->n,A->cmap->n);
1255   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1256   for (i=0; i<len; i++) {
1257     x[i] = mat->v[i*mat->lda + i];
1258   }
1259   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1260   PetscFunctionReturn(0);
1261 }
1262 
1263 #undef __FUNCT__
1264 #define __FUNCT__ "MatDiagonalScale_SeqDense"
1265 PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1266 {
1267   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1268   PetscScalar    *l,*r,x,*v;
1269   PetscErrorCode ierr;
1270   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n;
1271 
1272   PetscFunctionBegin;
1273   if (ll) {
1274     ierr = VecGetSize(ll,&m);CHKERRQ(ierr);
1275     ierr = VecGetArray(ll,&l);CHKERRQ(ierr);
1276     if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1277     for (i=0; i<m; i++) {
1278       x = l[i];
1279       v = mat->v + i;
1280       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1281     }
1282     ierr = VecRestoreArray(ll,&l);CHKERRQ(ierr);
1283     ierr = PetscLogFlops(n*m);CHKERRQ(ierr);
1284   }
1285   if (rr) {
1286     ierr = VecGetSize(rr,&n);CHKERRQ(ierr);
1287     ierr = VecGetArray(rr,&r);CHKERRQ(ierr);
1288     if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1289     for (i=0; i<n; i++) {
1290       x = r[i];
1291       v = mat->v + i*m;
1292       for (j=0; j<m; j++) { (*v++) *= x;}
1293     }
1294     ierr = VecRestoreArray(rr,&r);CHKERRQ(ierr);
1295     ierr = PetscLogFlops(n*m);CHKERRQ(ierr);
1296   }
1297   PetscFunctionReturn(0);
1298 }
1299 
1300 #undef __FUNCT__
1301 #define __FUNCT__ "MatNorm_SeqDense"
1302 PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1303 {
1304   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1305   PetscScalar  *v = mat->v;
1306   PetscReal    sum = 0.0;
1307   PetscInt     lda=mat->lda,m=A->rmap->n,i,j;
1308   PetscErrorCode ierr;
1309 
1310   PetscFunctionBegin;
1311   if (type == NORM_FROBENIUS) {
1312     if (lda>m) {
1313       for (j=0; j<A->cmap->n; j++) {
1314 	v = mat->v+j*lda;
1315 	for (i=0; i<m; i++) {
1316 #if defined(PETSC_USE_COMPLEX)
1317 	  sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1318 #else
1319 	  sum += (*v)*(*v); v++;
1320 #endif
1321 	}
1322       }
1323     } else {
1324       for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1325 #if defined(PETSC_USE_COMPLEX)
1326 	sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1327 #else
1328 	sum += (*v)*(*v); v++;
1329 #endif
1330       }
1331     }
1332     *nrm = PetscSqrtReal(sum);
1333     ierr = PetscLogFlops(2.0*A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1334   } else if (type == NORM_1) {
1335     *nrm = 0.0;
1336     for (j=0; j<A->cmap->n; j++) {
1337       v = mat->v + j*mat->lda;
1338       sum = 0.0;
1339       for (i=0; i<A->rmap->n; i++) {
1340         sum += PetscAbsScalar(*v);  v++;
1341       }
1342       if (sum > *nrm) *nrm = sum;
1343     }
1344     ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1345   } else if (type == NORM_INFINITY) {
1346     *nrm = 0.0;
1347     for (j=0; j<A->rmap->n; j++) {
1348       v = mat->v + j;
1349       sum = 0.0;
1350       for (i=0; i<A->cmap->n; i++) {
1351         sum += PetscAbsScalar(*v); v += mat->lda;
1352       }
1353       if (sum > *nrm) *nrm = sum;
1354     }
1355     ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr);
1356   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1357   PetscFunctionReturn(0);
1358 }
1359 
1360 #undef __FUNCT__
1361 #define __FUNCT__ "MatSetOption_SeqDense"
1362 PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool  flg)
1363 {
1364   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1365   PetscErrorCode ierr;
1366 
1367   PetscFunctionBegin;
1368   switch (op) {
1369   case MAT_ROW_ORIENTED:
1370     aij->roworiented = flg;
1371     break;
1372   case MAT_NEW_NONZERO_LOCATIONS:
1373   case MAT_NEW_NONZERO_LOCATION_ERR:
1374   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1375   case MAT_NEW_DIAGONALS:
1376   case MAT_KEEP_NONZERO_PATTERN:
1377   case MAT_IGNORE_OFF_PROC_ENTRIES:
1378   case MAT_USE_HASH_TABLE:
1379   case MAT_SYMMETRIC:
1380   case MAT_STRUCTURALLY_SYMMETRIC:
1381   case MAT_HERMITIAN:
1382   case MAT_SYMMETRY_ETERNAL:
1383   case MAT_IGNORE_LOWER_TRIANGULAR:
1384     ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr);
1385     break;
1386   default:
1387     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1388   }
1389   PetscFunctionReturn(0);
1390 }
1391 
1392 #undef __FUNCT__
1393 #define __FUNCT__ "MatZeroEntries_SeqDense"
1394 PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1395 {
1396   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1397   PetscErrorCode ierr;
1398   PetscInt       lda=l->lda,m=A->rmap->n,j;
1399 
1400   PetscFunctionBegin;
1401   if (lda>m) {
1402     for (j=0; j<A->cmap->n; j++) {
1403       ierr = PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));CHKERRQ(ierr);
1404     }
1405   } else {
1406     ierr = PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1407   }
1408   PetscFunctionReturn(0);
1409 }
1410 
1411 #undef __FUNCT__
1412 #define __FUNCT__ "MatZeroRows_SeqDense"
1413 PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1414 {
1415   PetscErrorCode    ierr;
1416   Mat_SeqDense      *l = (Mat_SeqDense*)A->data;
1417   PetscInt          m = l->lda, n = A->cmap->n, i,j;
1418   PetscScalar       *slot,*bb;
1419   const PetscScalar *xx;
1420 
1421   PetscFunctionBegin;
1422 #if defined(PETSC_USE_DEBUG)
1423   for (i=0; i<N; i++) {
1424     if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1425     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);
1426   }
1427 #endif
1428 
1429   /* fix right hand side if needed */
1430   if (x && b) {
1431     ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
1432     ierr = VecGetArray(b,&bb);CHKERRQ(ierr);
1433     for (i=0; i<N; i++) {
1434       bb[rows[i]] = diag*xx[rows[i]];
1435     }
1436     ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
1437     ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr);
1438   }
1439 
1440   for (i=0; i<N; i++) {
1441     slot = l->v + rows[i];
1442     for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1443   }
1444   if (diag != 0.0) {
1445     if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1446     for (i=0; i<N; i++) {
1447       slot = l->v + (m+1)*rows[i];
1448       *slot = diag;
1449     }
1450   }
1451   PetscFunctionReturn(0);
1452 }
1453 
1454 #undef __FUNCT__
1455 #define __FUNCT__ "MatGetArray_SeqDense"
1456 PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1457 {
1458   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1459 
1460   PetscFunctionBegin;
1461   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");
1462   *array = mat->v;
1463   PetscFunctionReturn(0);
1464 }
1465 
1466 #undef __FUNCT__
1467 #define __FUNCT__ "MatRestoreArray_SeqDense"
1468 PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1469 {
1470   PetscFunctionBegin;
1471   *array = 0; /* user cannot accidently use the array later */
1472   PetscFunctionReturn(0);
1473 }
1474 
1475 #undef __FUNCT__
1476 #define __FUNCT__ "MatGetSubMatrix_SeqDense"
1477 static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1478 {
1479   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1480   PetscErrorCode ierr;
1481   PetscInt       i,j,nrows,ncols;
1482   const PetscInt *irow,*icol;
1483   PetscScalar    *av,*bv,*v = mat->v;
1484   Mat            newmat;
1485 
1486   PetscFunctionBegin;
1487   ierr = ISGetIndices(isrow,&irow);CHKERRQ(ierr);
1488   ierr = ISGetIndices(iscol,&icol);CHKERRQ(ierr);
1489   ierr = ISGetLocalSize(isrow,&nrows);CHKERRQ(ierr);
1490   ierr = ISGetLocalSize(iscol,&ncols);CHKERRQ(ierr);
1491 
1492   /* Check submatrixcall */
1493   if (scall == MAT_REUSE_MATRIX) {
1494     PetscInt n_cols,n_rows;
1495     ierr = MatGetSize(*B,&n_rows,&n_cols);CHKERRQ(ierr);
1496     if (n_rows != nrows || n_cols != ncols) {
1497       /* resize the result matrix to match number of requested rows/columns */
1498       ierr = MatSetSizes(*B,nrows,ncols,nrows,ncols);CHKERRQ(ierr);
1499     }
1500     newmat = *B;
1501   } else {
1502     /* Create and fill new matrix */
1503     ierr = MatCreate(((PetscObject)A)->comm,&newmat);CHKERRQ(ierr);
1504     ierr = MatSetSizes(newmat,nrows,ncols,nrows,ncols);CHKERRQ(ierr);
1505     ierr = MatSetType(newmat,((PetscObject)A)->type_name);CHKERRQ(ierr);
1506     ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr);
1507   }
1508 
1509   /* Now extract the data pointers and do the copy,column at a time */
1510   bv = ((Mat_SeqDense*)newmat->data)->v;
1511 
1512   for (i=0; i<ncols; i++) {
1513     av = v + mat->lda*icol[i];
1514     for (j=0; j<nrows; j++) {
1515       *bv++ = av[irow[j]];
1516     }
1517   }
1518 
1519   /* Assemble the matrices so that the correct flags are set */
1520   ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1521   ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1522 
1523   /* Free work space */
1524   ierr = ISRestoreIndices(isrow,&irow);CHKERRQ(ierr);
1525   ierr = ISRestoreIndices(iscol,&icol);CHKERRQ(ierr);
1526   *B = newmat;
1527   PetscFunctionReturn(0);
1528 }
1529 
1530 #undef __FUNCT__
1531 #define __FUNCT__ "MatGetSubMatrices_SeqDense"
1532 PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1533 {
1534   PetscErrorCode ierr;
1535   PetscInt       i;
1536 
1537   PetscFunctionBegin;
1538   if (scall == MAT_INITIAL_MATRIX) {
1539     ierr = PetscMalloc((n+1)*sizeof(Mat),B);CHKERRQ(ierr);
1540   }
1541 
1542   for (i=0; i<n; i++) {
1543     ierr = MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);CHKERRQ(ierr);
1544   }
1545   PetscFunctionReturn(0);
1546 }
1547 
1548 #undef __FUNCT__
1549 #define __FUNCT__ "MatAssemblyBegin_SeqDense"
1550 PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1551 {
1552   PetscFunctionBegin;
1553   PetscFunctionReturn(0);
1554 }
1555 
1556 #undef __FUNCT__
1557 #define __FUNCT__ "MatAssemblyEnd_SeqDense"
1558 PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1559 {
1560   PetscFunctionBegin;
1561   PetscFunctionReturn(0);
1562 }
1563 
1564 #undef __FUNCT__
1565 #define __FUNCT__ "MatCopy_SeqDense"
1566 PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1567 {
1568   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1569   PetscErrorCode ierr;
1570   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1571 
1572   PetscFunctionBegin;
1573   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1574   if (A->ops->copy != B->ops->copy) {
1575     ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr);
1576     PetscFunctionReturn(0);
1577   }
1578   if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1579   if (lda1>m || lda2>m) {
1580     for (j=0; j<n; j++) {
1581       ierr = PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));CHKERRQ(ierr);
1582     }
1583   } else {
1584     ierr = PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1585   }
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 #undef __FUNCT__
1590 #define __FUNCT__ "MatSetUp_SeqDense"
1591 PetscErrorCode MatSetUp_SeqDense(Mat A)
1592 {
1593   PetscErrorCode ierr;
1594 
1595   PetscFunctionBegin;
1596   ierr =  MatSeqDenseSetPreallocation(A,0);CHKERRQ(ierr);
1597   PetscFunctionReturn(0);
1598 }
1599 
1600 #undef __FUNCT__
1601 #define __FUNCT__ "MatSetSizes_SeqDense"
1602 PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1603 {
1604   PetscFunctionBegin;
1605   /* this will not be called before lda, Mmax,  and Nmax have been set */
1606   m = PetscMax(m,M);
1607   n = PetscMax(n,N);
1608 
1609   /*  if (m > a->Mmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot yet resize number rows of dense matrix larger then its initial size %d, requested %d",a->lda,(int)m);
1610     if (n > a->Nmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot yet resize number columns of dense matrix larger then its initial size %d, requested %d",a->Nmax,(int)n);
1611   */
1612   A->rmap->n = A->rmap->N = m;
1613   A->cmap->n = A->cmap->N = n;
1614   PetscFunctionReturn(0);
1615 }
1616 
1617 #undef __FUNCT__
1618 #define __FUNCT__ "MatConjugate_SeqDense"
1619 static PetscErrorCode MatConjugate_SeqDense(Mat A)
1620 {
1621   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1622   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1623   PetscScalar    *aa = a->v;
1624 
1625   PetscFunctionBegin;
1626   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1627   PetscFunctionReturn(0);
1628 }
1629 
1630 #undef __FUNCT__
1631 #define __FUNCT__ "MatRealPart_SeqDense"
1632 static PetscErrorCode MatRealPart_SeqDense(Mat A)
1633 {
1634   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1635   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1636   PetscScalar    *aa = a->v;
1637 
1638   PetscFunctionBegin;
1639   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1640   PetscFunctionReturn(0);
1641 }
1642 
1643 #undef __FUNCT__
1644 #define __FUNCT__ "MatImaginaryPart_SeqDense"
1645 static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1646 {
1647   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1648   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1649   PetscScalar    *aa = a->v;
1650 
1651   PetscFunctionBegin;
1652   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1653   PetscFunctionReturn(0);
1654 }
1655 
1656 /* ----------------------------------------------------------------*/
1657 #undef __FUNCT__
1658 #define __FUNCT__ "MatMatMult_SeqDense_SeqDense"
1659 PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1660 {
1661   PetscErrorCode ierr;
1662 
1663   PetscFunctionBegin;
1664   if (scall == MAT_INITIAL_MATRIX){
1665     ierr = MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1666   }
1667   ierr = MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1668   PetscFunctionReturn(0);
1669 }
1670 
1671 #undef __FUNCT__
1672 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqDense"
1673 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1674 {
1675   PetscErrorCode ierr;
1676   PetscInt       m=A->rmap->n,n=B->cmap->n;
1677   Mat            Cmat;
1678 
1679   PetscFunctionBegin;
1680   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);
1681   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1682   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1683   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1684   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1685   Cmat->assembled    = PETSC_TRUE;
1686   Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense;
1687   *C = Cmat;
1688   PetscFunctionReturn(0);
1689 }
1690 
1691 #undef __FUNCT__
1692 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqDense"
1693 PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1694 {
1695   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1696   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1697   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1698   PetscBLASInt   m,n,k;
1699   PetscScalar    _DOne=1.0,_DZero=0.0;
1700 
1701   PetscFunctionBegin;
1702   m = PetscBLASIntCast(A->rmap->n);
1703   n = PetscBLASIntCast(B->cmap->n);
1704   k = PetscBLASIntCast(A->cmap->n);
1705   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1706   PetscFunctionReturn(0);
1707 }
1708 
1709 #undef __FUNCT__
1710 #define __FUNCT__ "MatTransposeMatMult_SeqDense_SeqDense"
1711 PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1712 {
1713   PetscErrorCode ierr;
1714 
1715   PetscFunctionBegin;
1716   if (scall == MAT_INITIAL_MATRIX){
1717     ierr = MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1718   }
1719   ierr = MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1720   PetscFunctionReturn(0);
1721 }
1722 
1723 #undef __FUNCT__
1724 #define __FUNCT__ "MatTransposeMatMultSymbolic_SeqDense_SeqDense"
1725 PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1726 {
1727   PetscErrorCode ierr;
1728   PetscInt       m=A->cmap->n,n=B->cmap->n;
1729   Mat            Cmat;
1730 
1731   PetscFunctionBegin;
1732   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);
1733   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1734   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1735   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1736   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1737   Cmat->assembled = PETSC_TRUE;
1738   *C = Cmat;
1739   PetscFunctionReturn(0);
1740 }
1741 
1742 #undef __FUNCT__
1743 #define __FUNCT__ "MatTransposeMatMultNumeric_SeqDense_SeqDense"
1744 PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1745 {
1746   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1747   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1748   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1749   PetscBLASInt   m,n,k;
1750   PetscScalar    _DOne=1.0,_DZero=0.0;
1751 
1752   PetscFunctionBegin;
1753   m = PetscBLASIntCast(A->cmap->n);
1754   n = PetscBLASIntCast(B->cmap->n);
1755   k = PetscBLASIntCast(A->rmap->n);
1756   /*
1757      Note the m and n arguments below are the number rows and columns of A', not A!
1758   */
1759   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1760   PetscFunctionReturn(0);
1761 }
1762 
1763 #undef __FUNCT__
1764 #define __FUNCT__ "MatGetRowMax_SeqDense"
1765 PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1766 {
1767   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1768   PetscErrorCode ierr;
1769   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1770   PetscScalar    *x;
1771   MatScalar      *aa = a->v;
1772 
1773   PetscFunctionBegin;
1774   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1775 
1776   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1777   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1778   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1779   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1780   for (i=0; i<m; i++) {
1781     x[i] = aa[i]; if (idx) idx[i] = 0;
1782     for (j=1; j<n; j++){
1783       if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1784     }
1785   }
1786   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1787   PetscFunctionReturn(0);
1788 }
1789 
1790 #undef __FUNCT__
1791 #define __FUNCT__ "MatGetRowMaxAbs_SeqDense"
1792 PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1793 {
1794   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1795   PetscErrorCode ierr;
1796   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1797   PetscScalar    *x;
1798   PetscReal      atmp;
1799   MatScalar      *aa = a->v;
1800 
1801   PetscFunctionBegin;
1802   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1803 
1804   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1805   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1806   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1807   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1808   for (i=0; i<m; i++) {
1809     x[i] = PetscAbsScalar(aa[i]);
1810     for (j=1; j<n; j++){
1811       atmp = PetscAbsScalar(aa[i+m*j]);
1812       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1813     }
1814   }
1815   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1816   PetscFunctionReturn(0);
1817 }
1818 
1819 #undef __FUNCT__
1820 #define __FUNCT__ "MatGetRowMin_SeqDense"
1821 PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1822 {
1823   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1824   PetscErrorCode ierr;
1825   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1826   PetscScalar    *x;
1827   MatScalar      *aa = a->v;
1828 
1829   PetscFunctionBegin;
1830   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1831 
1832   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1833   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1834   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1835   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1836   for (i=0; i<m; i++) {
1837     x[i] = aa[i]; if (idx) idx[i] = 0;
1838     for (j=1; j<n; j++){
1839       if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1840     }
1841   }
1842   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1843   PetscFunctionReturn(0);
1844 }
1845 
1846 #undef __FUNCT__
1847 #define __FUNCT__ "MatGetColumnVector_SeqDense"
1848 PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1849 {
1850   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1851   PetscErrorCode ierr;
1852   PetscScalar    *x;
1853 
1854   PetscFunctionBegin;
1855   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1856 
1857   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1858   ierr = PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1859   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1860   PetscFunctionReturn(0);
1861 }
1862 
1863 
1864 #undef __FUNCT__
1865 #define __FUNCT__ "MatGetColumnNorms_SeqDense"
1866 PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1867 {
1868   PetscErrorCode ierr;
1869   PetscInt       i,j,m,n;
1870   PetscScalar    *a;
1871 
1872   PetscFunctionBegin;
1873   ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
1874   ierr = PetscMemzero(norms,n*sizeof(PetscReal));CHKERRQ(ierr);
1875   ierr = MatGetArray(A,&a);CHKERRQ(ierr);
1876   if (type == NORM_2) {
1877     for (i=0; i<n; i++ ){
1878       for (j=0; j<m; j++) {
1879 	norms[i] += PetscAbsScalar(a[j]*a[j]);
1880       }
1881       a += m;
1882     }
1883   } else if (type == NORM_1) {
1884     for (i=0; i<n; i++ ){
1885       for (j=0; j<m; j++) {
1886 	norms[i] += PetscAbsScalar(a[j]);
1887       }
1888       a += m;
1889     }
1890   } else if (type == NORM_INFINITY) {
1891     for (i=0; i<n; i++ ){
1892       for (j=0; j<m; j++) {
1893 	norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1894       }
1895       a += m;
1896     }
1897   } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1898   if (type == NORM_2) {
1899     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1900   }
1901   PetscFunctionReturn(0);
1902 }
1903 
1904 /* -------------------------------------------------------------------*/
1905 static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1906        MatGetRow_SeqDense,
1907        MatRestoreRow_SeqDense,
1908        MatMult_SeqDense,
1909 /* 4*/ MatMultAdd_SeqDense,
1910        MatMultTranspose_SeqDense,
1911        MatMultTransposeAdd_SeqDense,
1912        0,
1913        0,
1914        0,
1915 /*10*/ 0,
1916        MatLUFactor_SeqDense,
1917        MatCholeskyFactor_SeqDense,
1918        MatSOR_SeqDense,
1919        MatTranspose_SeqDense,
1920 /*15*/ MatGetInfo_SeqDense,
1921        MatEqual_SeqDense,
1922        MatGetDiagonal_SeqDense,
1923        MatDiagonalScale_SeqDense,
1924        MatNorm_SeqDense,
1925 /*20*/ MatAssemblyBegin_SeqDense,
1926        MatAssemblyEnd_SeqDense,
1927        MatSetOption_SeqDense,
1928        MatZeroEntries_SeqDense,
1929 /*24*/ MatZeroRows_SeqDense,
1930        0,
1931        0,
1932        0,
1933        0,
1934 /*29*/ MatSetUp_SeqDense,
1935        0,
1936        0,
1937        MatGetArray_SeqDense,
1938        MatRestoreArray_SeqDense,
1939 /*34*/ MatDuplicate_SeqDense,
1940        0,
1941        0,
1942        0,
1943        0,
1944 /*39*/ MatAXPY_SeqDense,
1945        MatGetSubMatrices_SeqDense,
1946        0,
1947        MatGetValues_SeqDense,
1948        MatCopy_SeqDense,
1949 /*44*/ MatGetRowMax_SeqDense,
1950        MatScale_SeqDense,
1951        0,
1952        0,
1953        0,
1954 /*49*/ 0,
1955        0,
1956        0,
1957        0,
1958        0,
1959 /*54*/ 0,
1960        0,
1961        0,
1962        0,
1963        0,
1964 /*59*/ 0,
1965        MatDestroy_SeqDense,
1966        MatView_SeqDense,
1967        0,
1968        0,
1969 /*64*/ 0,
1970        0,
1971        0,
1972        0,
1973        0,
1974 /*69*/ MatGetRowMaxAbs_SeqDense,
1975        0,
1976        0,
1977        0,
1978        0,
1979 /*74*/ 0,
1980        0,
1981        0,
1982        0,
1983        0,
1984 /*79*/ 0,
1985        0,
1986        0,
1987        0,
1988 /*83*/ MatLoad_SeqDense,
1989        0,
1990        MatIsHermitian_SeqDense,
1991        0,
1992        0,
1993        0,
1994 /*89*/ MatMatMult_SeqDense_SeqDense,
1995        MatMatMultSymbolic_SeqDense_SeqDense,
1996        MatMatMultNumeric_SeqDense_SeqDense,
1997        0,
1998        0,
1999 /*94*/ 0,
2000        0,
2001        0,
2002        0,
2003        0,
2004 /*99*/ 0,
2005        0,
2006        0,
2007        MatConjugate_SeqDense,
2008        MatSetSizes_SeqDense,
2009 /*104*/0,
2010        MatRealPart_SeqDense,
2011        MatImaginaryPart_SeqDense,
2012        0,
2013        0,
2014 /*109*/MatMatSolve_SeqDense,
2015        0,
2016        MatGetRowMin_SeqDense,
2017        MatGetColumnVector_SeqDense,
2018        0,
2019 /*114*/0,
2020        0,
2021        0,
2022        0,
2023        0,
2024 /*119*/0,
2025        0,
2026        0,
2027        0,
2028        0,
2029 /*124*/0,
2030        MatGetColumnNorms_SeqDense,
2031        0,
2032        0,
2033        0,
2034 /*129*/0,
2035        MatTransposeMatMult_SeqDense_SeqDense,
2036        MatTransposeMatMultSymbolic_SeqDense_SeqDense,
2037        MatTransposeMatMultNumeric_SeqDense_SeqDense,
2038 };
2039 
2040 #undef __FUNCT__
2041 #define __FUNCT__ "MatCreateSeqDense"
2042 /*@C
2043    MatCreateSeqDense - Creates a sequential dense matrix that
2044    is stored in column major order (the usual Fortran 77 manner). Many
2045    of the matrix operations use the BLAS and LAPACK routines.
2046 
2047    Collective on MPI_Comm
2048 
2049    Input Parameters:
2050 +  comm - MPI communicator, set to PETSC_COMM_SELF
2051 .  m - number of rows
2052 .  n - number of columns
2053 -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
2054    to control all matrix memory allocation.
2055 
2056    Output Parameter:
2057 .  A - the matrix
2058 
2059    Notes:
2060    The data input variable is intended primarily for Fortran programmers
2061    who wish to allocate their own matrix memory space.  Most users should
2062    set data=PETSC_NULL.
2063 
2064    Level: intermediate
2065 
2066 .keywords: dense, matrix, LAPACK, BLAS
2067 
2068 .seealso: MatCreate(), MatCreateDense(), MatSetValues()
2069 @*/
2070 PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2071 {
2072   PetscErrorCode ierr;
2073 
2074   PetscFunctionBegin;
2075   ierr = MatCreate(comm,A);CHKERRQ(ierr);
2076   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
2077   ierr = MatSetType(*A,MATSEQDENSE);CHKERRQ(ierr);
2078   ierr = MatSeqDenseSetPreallocation(*A,data);CHKERRQ(ierr);
2079   PetscFunctionReturn(0);
2080 }
2081 
2082 #undef __FUNCT__
2083 #define __FUNCT__ "MatSeqDenseSetPreallocation"
2084 /*@C
2085    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
2086 
2087    Collective on MPI_Comm
2088 
2089    Input Parameters:
2090 +  A - the matrix
2091 -  data - the array (or PETSC_NULL)
2092 
2093    Notes:
2094    The data input variable is intended primarily for Fortran programmers
2095    who wish to allocate their own matrix memory space.  Most users should
2096    need not call this routine.
2097 
2098    Level: intermediate
2099 
2100 .keywords: dense, matrix, LAPACK, BLAS
2101 
2102 .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA()
2103 
2104 @*/
2105 PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2106 {
2107   PetscErrorCode ierr;
2108 
2109   PetscFunctionBegin;
2110   ierr = PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));CHKERRQ(ierr);
2111   PetscFunctionReturn(0);
2112 }
2113 
2114 EXTERN_C_BEGIN
2115 #undef __FUNCT__
2116 #define __FUNCT__ "MatSeqDenseSetPreallocation_SeqDense"
2117 PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2118 {
2119   Mat_SeqDense   *b;
2120   PetscErrorCode ierr;
2121 
2122   PetscFunctionBegin;
2123   B->preallocated = PETSC_TRUE;
2124 
2125   ierr = PetscLayoutSetBlockSize(B->rmap,1);CHKERRQ(ierr);
2126   ierr = PetscLayoutSetBlockSize(B->cmap,1);CHKERRQ(ierr);
2127   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
2128   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
2129 
2130   b       = (Mat_SeqDense*)B->data;
2131   b->Mmax = B->rmap->n;
2132   b->Nmax = B->cmap->n;
2133   if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;
2134 
2135   if (!data) { /* petsc-allocated storage */
2136     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2137     ierr = PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);CHKERRQ(ierr);
2138     ierr = PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2139     ierr = PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2140     b->user_alloc = PETSC_FALSE;
2141   } else { /* user-allocated storage */
2142     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2143     b->v          = data;
2144     b->user_alloc = PETSC_TRUE;
2145   }
2146   B->assembled = PETSC_TRUE;
2147   PetscFunctionReturn(0);
2148 }
2149 EXTERN_C_END
2150 
2151 #undef __FUNCT__
2152 #define __FUNCT__ "MatSeqDenseSetLDA"
2153 /*@C
2154   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2155 
2156   Input parameter:
2157 + A - the matrix
2158 - lda - the leading dimension
2159 
2160   Notes:
2161   This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2162   it asserts that the preallocation has a leading dimension (the LDA parameter
2163   of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2164 
2165   Level: intermediate
2166 
2167 .keywords: dense, matrix, LAPACK, BLAS
2168 
2169 .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2170 
2171 @*/
2172 PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2173 {
2174   Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2175 
2176   PetscFunctionBegin;
2177   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);
2178   b->lda       = lda;
2179   b->changelda = PETSC_FALSE;
2180   b->Mmax      = PetscMax(b->Mmax,lda);
2181   PetscFunctionReturn(0);
2182 }
2183 
2184 /*MC
2185    MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2186 
2187    Options Database Keys:
2188 . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2189 
2190   Level: beginner
2191 
2192 .seealso: MatCreateSeqDense()
2193 
2194 M*/
2195 
2196 EXTERN_C_BEGIN
2197 #undef __FUNCT__
2198 #define __FUNCT__ "MatCreate_SeqDense"
2199 PetscErrorCode  MatCreate_SeqDense(Mat B)
2200 {
2201   Mat_SeqDense   *b;
2202   PetscErrorCode ierr;
2203   PetscMPIInt    size;
2204 
2205   PetscFunctionBegin;
2206   ierr = MPI_Comm_size(((PetscObject)B)->comm,&size);CHKERRQ(ierr);
2207   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2208 
2209   ierr            = PetscNewLog(B,Mat_SeqDense,&b);CHKERRQ(ierr);
2210   ierr            = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
2211   B->data         = (void*)b;
2212 
2213   b->pivots       = 0;
2214   b->roworiented  = PETSC_TRUE;
2215   b->v            = 0;
2216   b->changelda    = PETSC_FALSE;
2217 
2218 
2219   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);CHKERRQ(ierr);
2220   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2221                                      "MatGetFactor_seqdense_petsc",
2222                                       MatGetFactor_seqdense_petsc);CHKERRQ(ierr);
2223   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2224                                     "MatSeqDenseSetPreallocation_SeqDense",
2225                                      MatSeqDenseSetPreallocation_SeqDense);CHKERRQ(ierr);
2226 
2227   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2228                                      "MatMatMult_SeqAIJ_SeqDense",
2229                                       MatMatMult_SeqAIJ_SeqDense);CHKERRQ(ierr);
2230 
2231 
2232   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2233                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2234                                       MatMatMultSymbolic_SeqAIJ_SeqDense);CHKERRQ(ierr);
2235   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2236                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2237                                       MatMatMultNumeric_SeqAIJ_SeqDense);CHKERRQ(ierr);
2238   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);CHKERRQ(ierr);
2239   PetscFunctionReturn(0);
2240 }
2241 EXTERN_C_END
2242