xref: /petsc/src/mat/impls/dense/seq/dense.c (revision 78bcb3b52ebb0257bd94ec69c8880a625fddfc8c)
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__ "MatSetBlockSize_SeqDense"
1619 PetscErrorCode MatSetBlockSize_SeqDense(Mat A,PetscInt bs)
1620 {
1621   PetscErrorCode ierr;
1622 
1623   PetscFunctionBegin;
1624   ierr = PetscLayoutSetBlockSize(A->rmap,bs);CHKERRQ(ierr);
1625   ierr = PetscLayoutSetBlockSize(A->cmap,bs);CHKERRQ(ierr);
1626   PetscFunctionReturn(0);
1627 }
1628 
1629 #undef __FUNCT__
1630 #define __FUNCT__ "MatConjugate_SeqDense"
1631 static PetscErrorCode MatConjugate_SeqDense(Mat A)
1632 {
1633   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1634   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1635   PetscScalar    *aa = a->v;
1636 
1637   PetscFunctionBegin;
1638   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1639   PetscFunctionReturn(0);
1640 }
1641 
1642 #undef __FUNCT__
1643 #define __FUNCT__ "MatRealPart_SeqDense"
1644 static PetscErrorCode MatRealPart_SeqDense(Mat A)
1645 {
1646   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1647   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1648   PetscScalar    *aa = a->v;
1649 
1650   PetscFunctionBegin;
1651   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1652   PetscFunctionReturn(0);
1653 }
1654 
1655 #undef __FUNCT__
1656 #define __FUNCT__ "MatImaginaryPart_SeqDense"
1657 static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1658 {
1659   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1660   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1661   PetscScalar    *aa = a->v;
1662 
1663   PetscFunctionBegin;
1664   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1665   PetscFunctionReturn(0);
1666 }
1667 
1668 /* ----------------------------------------------------------------*/
1669 #undef __FUNCT__
1670 #define __FUNCT__ "MatMatMult_SeqDense_SeqDense"
1671 PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1672 {
1673   PetscErrorCode ierr;
1674 
1675   PetscFunctionBegin;
1676   if (scall == MAT_INITIAL_MATRIX){
1677     ierr = MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1678   }
1679   ierr = MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1680   PetscFunctionReturn(0);
1681 }
1682 
1683 #undef __FUNCT__
1684 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqDense"
1685 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1686 {
1687   PetscErrorCode ierr;
1688   PetscInt       m=A->rmap->n,n=B->cmap->n;
1689   Mat            Cmat;
1690 
1691   PetscFunctionBegin;
1692   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);
1693   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1694   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1695   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1696   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1697   Cmat->assembled    = PETSC_TRUE;
1698   Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense;
1699   *C = Cmat;
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 #undef __FUNCT__
1704 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqDense"
1705 PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1706 {
1707   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1708   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1709   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1710   PetscBLASInt   m,n,k;
1711   PetscScalar    _DOne=1.0,_DZero=0.0;
1712 
1713   PetscFunctionBegin;
1714   m = PetscBLASIntCast(A->rmap->n);
1715   n = PetscBLASIntCast(B->cmap->n);
1716   k = PetscBLASIntCast(A->cmap->n);
1717   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1718   PetscFunctionReturn(0);
1719 }
1720 
1721 #undef __FUNCT__
1722 #define __FUNCT__ "MatTransposeMatMult_SeqDense_SeqDense"
1723 PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1724 {
1725   PetscErrorCode ierr;
1726 
1727   PetscFunctionBegin;
1728   if (scall == MAT_INITIAL_MATRIX){
1729     ierr = MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr);
1730   }
1731   ierr = MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr);
1732   PetscFunctionReturn(0);
1733 }
1734 
1735 #undef __FUNCT__
1736 #define __FUNCT__ "MatTransposeMatMultSymbolic_SeqDense_SeqDense"
1737 PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1738 {
1739   PetscErrorCode ierr;
1740   PetscInt       m=A->cmap->n,n=B->cmap->n;
1741   Mat            Cmat;
1742 
1743   PetscFunctionBegin;
1744   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);
1745   ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr);
1746   ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr);
1747   ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr);
1748   ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr);
1749   Cmat->assembled = PETSC_TRUE;
1750   *C = Cmat;
1751   PetscFunctionReturn(0);
1752 }
1753 
1754 #undef __FUNCT__
1755 #define __FUNCT__ "MatTransposeMatMultNumeric_SeqDense_SeqDense"
1756 PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1757 {
1758   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1759   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1760   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1761   PetscBLASInt   m,n,k;
1762   PetscScalar    _DOne=1.0,_DZero=0.0;
1763 
1764   PetscFunctionBegin;
1765   m = PetscBLASIntCast(A->cmap->n);
1766   n = PetscBLASIntCast(B->cmap->n);
1767   k = PetscBLASIntCast(A->rmap->n);
1768   /*
1769      Note the m and n arguments below are the number rows and columns of A', not A!
1770   */
1771   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1772   PetscFunctionReturn(0);
1773 }
1774 
1775 #undef __FUNCT__
1776 #define __FUNCT__ "MatGetRowMax_SeqDense"
1777 PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1778 {
1779   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1780   PetscErrorCode ierr;
1781   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1782   PetscScalar    *x;
1783   MatScalar      *aa = a->v;
1784 
1785   PetscFunctionBegin;
1786   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1787 
1788   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1789   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1790   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1791   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1792   for (i=0; i<m; i++) {
1793     x[i] = aa[i]; if (idx) idx[i] = 0;
1794     for (j=1; j<n; j++){
1795       if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1796     }
1797   }
1798   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1799   PetscFunctionReturn(0);
1800 }
1801 
1802 #undef __FUNCT__
1803 #define __FUNCT__ "MatGetRowMaxAbs_SeqDense"
1804 PetscErrorCode MatGetRowMaxAbs_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   PetscReal      atmp;
1811   MatScalar      *aa = a->v;
1812 
1813   PetscFunctionBegin;
1814   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1815 
1816   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1817   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1818   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1819   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1820   for (i=0; i<m; i++) {
1821     x[i] = PetscAbsScalar(aa[i]);
1822     for (j=1; j<n; j++){
1823       atmp = PetscAbsScalar(aa[i+m*j]);
1824       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1825     }
1826   }
1827   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1828   PetscFunctionReturn(0);
1829 }
1830 
1831 #undef __FUNCT__
1832 #define __FUNCT__ "MatGetRowMin_SeqDense"
1833 PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1834 {
1835   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1836   PetscErrorCode ierr;
1837   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1838   PetscScalar    *x;
1839   MatScalar      *aa = a->v;
1840 
1841   PetscFunctionBegin;
1842   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1843 
1844   ierr = VecSet(v,0.0);CHKERRQ(ierr);
1845   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1846   ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr);
1847   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1848   for (i=0; i<m; i++) {
1849     x[i] = aa[i]; if (idx) idx[i] = 0;
1850     for (j=1; j<n; j++){
1851       if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; 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__ "MatGetColumnVector_SeqDense"
1860 PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1861 {
1862   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1863   PetscErrorCode ierr;
1864   PetscScalar    *x;
1865 
1866   PetscFunctionBegin;
1867   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1868 
1869   ierr = VecGetArray(v,&x);CHKERRQ(ierr);
1870   ierr = PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
1871   ierr = VecRestoreArray(v,&x);CHKERRQ(ierr);
1872   PetscFunctionReturn(0);
1873 }
1874 
1875 
1876 #undef __FUNCT__
1877 #define __FUNCT__ "MatGetColumnNorms_SeqDense"
1878 PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1879 {
1880   PetscErrorCode ierr;
1881   PetscInt       i,j,m,n;
1882   PetscScalar    *a;
1883 
1884   PetscFunctionBegin;
1885   ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
1886   ierr = PetscMemzero(norms,n*sizeof(PetscReal));CHKERRQ(ierr);
1887   ierr = MatGetArray(A,&a);CHKERRQ(ierr);
1888   if (type == NORM_2) {
1889     for (i=0; i<n; i++ ){
1890       for (j=0; j<m; j++) {
1891 	norms[i] += PetscAbsScalar(a[j]*a[j]);
1892       }
1893       a += m;
1894     }
1895   } else if (type == NORM_1) {
1896     for (i=0; i<n; i++ ){
1897       for (j=0; j<m; j++) {
1898 	norms[i] += PetscAbsScalar(a[j]);
1899       }
1900       a += m;
1901     }
1902   } else if (type == NORM_INFINITY) {
1903     for (i=0; i<n; i++ ){
1904       for (j=0; j<m; j++) {
1905 	norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1906       }
1907       a += m;
1908     }
1909   } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1910   if (type == NORM_2) {
1911     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1912   }
1913   PetscFunctionReturn(0);
1914 }
1915 
1916 /* -------------------------------------------------------------------*/
1917 static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1918        MatGetRow_SeqDense,
1919        MatRestoreRow_SeqDense,
1920        MatMult_SeqDense,
1921 /* 4*/ MatMultAdd_SeqDense,
1922        MatMultTranspose_SeqDense,
1923        MatMultTransposeAdd_SeqDense,
1924        0,
1925        0,
1926        0,
1927 /*10*/ 0,
1928        MatLUFactor_SeqDense,
1929        MatCholeskyFactor_SeqDense,
1930        MatSOR_SeqDense,
1931        MatTranspose_SeqDense,
1932 /*15*/ MatGetInfo_SeqDense,
1933        MatEqual_SeqDense,
1934        MatGetDiagonal_SeqDense,
1935        MatDiagonalScale_SeqDense,
1936        MatNorm_SeqDense,
1937 /*20*/ MatAssemblyBegin_SeqDense,
1938        MatAssemblyEnd_SeqDense,
1939        MatSetOption_SeqDense,
1940        MatZeroEntries_SeqDense,
1941 /*24*/ MatZeroRows_SeqDense,
1942        0,
1943        0,
1944        0,
1945        0,
1946 /*29*/ MatSetUp_SeqDense,
1947        0,
1948        0,
1949        MatGetArray_SeqDense,
1950        MatRestoreArray_SeqDense,
1951 /*34*/ MatDuplicate_SeqDense,
1952        0,
1953        0,
1954        0,
1955        0,
1956 /*39*/ MatAXPY_SeqDense,
1957        MatGetSubMatrices_SeqDense,
1958        0,
1959        MatGetValues_SeqDense,
1960        MatCopy_SeqDense,
1961 /*44*/ MatGetRowMax_SeqDense,
1962        MatScale_SeqDense,
1963        0,
1964        0,
1965        0,
1966 /*49*/ MatSetBlockSize_SeqDense,
1967        0,
1968        0,
1969        0,
1970        0,
1971 /*54*/ 0,
1972        0,
1973        0,
1974        0,
1975        0,
1976 /*59*/ 0,
1977        MatDestroy_SeqDense,
1978        MatView_SeqDense,
1979        0,
1980        0,
1981 /*64*/ 0,
1982        0,
1983        0,
1984        0,
1985        0,
1986 /*69*/ MatGetRowMaxAbs_SeqDense,
1987        0,
1988        0,
1989        0,
1990        0,
1991 /*74*/ 0,
1992        0,
1993        0,
1994        0,
1995        0,
1996 /*79*/ 0,
1997        0,
1998        0,
1999        0,
2000 /*83*/ MatLoad_SeqDense,
2001        0,
2002        MatIsHermitian_SeqDense,
2003        0,
2004        0,
2005        0,
2006 /*89*/ MatMatMult_SeqDense_SeqDense,
2007        MatMatMultSymbolic_SeqDense_SeqDense,
2008        MatMatMultNumeric_SeqDense_SeqDense,
2009        0,
2010        0,
2011 /*94*/ 0,
2012        0,
2013        0,
2014        0,
2015        0,
2016 /*99*/ 0,
2017        0,
2018        0,
2019        MatConjugate_SeqDense,
2020        MatSetSizes_SeqDense,
2021 /*104*/0,
2022        MatRealPart_SeqDense,
2023        MatImaginaryPart_SeqDense,
2024        0,
2025        0,
2026 /*109*/MatMatSolve_SeqDense,
2027        0,
2028        MatGetRowMin_SeqDense,
2029        MatGetColumnVector_SeqDense,
2030        0,
2031 /*114*/0,
2032        0,
2033        0,
2034        0,
2035        0,
2036 /*119*/0,
2037        0,
2038        0,
2039        0,
2040        0,
2041 /*124*/0,
2042        MatGetColumnNorms_SeqDense,
2043        0,
2044        0,
2045        0,
2046 /*129*/0,
2047        MatTransposeMatMult_SeqDense_SeqDense,
2048        MatTransposeMatMultSymbolic_SeqDense_SeqDense,
2049        MatTransposeMatMultNumeric_SeqDense_SeqDense,
2050 };
2051 
2052 #undef __FUNCT__
2053 #define __FUNCT__ "MatCreateSeqDense"
2054 /*@C
2055    MatCreateSeqDense - Creates a sequential dense matrix that
2056    is stored in column major order (the usual Fortran 77 manner). Many
2057    of the matrix operations use the BLAS and LAPACK routines.
2058 
2059    Collective on MPI_Comm
2060 
2061    Input Parameters:
2062 +  comm - MPI communicator, set to PETSC_COMM_SELF
2063 .  m - number of rows
2064 .  n - number of columns
2065 -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
2066    to control all matrix memory allocation.
2067 
2068    Output Parameter:
2069 .  A - the matrix
2070 
2071    Notes:
2072    The data input variable is intended primarily for Fortran programmers
2073    who wish to allocate their own matrix memory space.  Most users should
2074    set data=PETSC_NULL.
2075 
2076    Level: intermediate
2077 
2078 .keywords: dense, matrix, LAPACK, BLAS
2079 
2080 .seealso: MatCreate(), MatCreateDense(), MatSetValues()
2081 @*/
2082 PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2083 {
2084   PetscErrorCode ierr;
2085 
2086   PetscFunctionBegin;
2087   ierr = MatCreate(comm,A);CHKERRQ(ierr);
2088   ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr);
2089   ierr = MatSetType(*A,MATSEQDENSE);CHKERRQ(ierr);
2090   ierr = MatSeqDenseSetPreallocation(*A,data);CHKERRQ(ierr);
2091   PetscFunctionReturn(0);
2092 }
2093 
2094 #undef __FUNCT__
2095 #define __FUNCT__ "MatSeqDenseSetPreallocation"
2096 /*@C
2097    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
2098 
2099    Collective on MPI_Comm
2100 
2101    Input Parameters:
2102 +  A - the matrix
2103 -  data - the array (or PETSC_NULL)
2104 
2105    Notes:
2106    The data input variable is intended primarily for Fortran programmers
2107    who wish to allocate their own matrix memory space.  Most users should
2108    need not call this routine.
2109 
2110    Level: intermediate
2111 
2112 .keywords: dense, matrix, LAPACK, BLAS
2113 
2114 .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA()
2115 
2116 @*/
2117 PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2118 {
2119   PetscErrorCode ierr;
2120 
2121   PetscFunctionBegin;
2122   ierr = PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));CHKERRQ(ierr);
2123   PetscFunctionReturn(0);
2124 }
2125 
2126 EXTERN_C_BEGIN
2127 #undef __FUNCT__
2128 #define __FUNCT__ "MatSeqDenseSetPreallocation_SeqDense"
2129 PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2130 {
2131   Mat_SeqDense   *b;
2132   PetscErrorCode ierr;
2133 
2134   PetscFunctionBegin;
2135   B->preallocated = PETSC_TRUE;
2136 
2137   ierr = PetscLayoutSetBlockSize(B->rmap,1);CHKERRQ(ierr);
2138   ierr = PetscLayoutSetBlockSize(B->cmap,1);CHKERRQ(ierr);
2139   ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
2140   ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
2141 
2142   b       = (Mat_SeqDense*)B->data;
2143   b->Mmax = B->rmap->n;
2144   b->Nmax = B->cmap->n;
2145   if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;
2146 
2147   if (!data) { /* petsc-allocated storage */
2148     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2149     ierr = PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);CHKERRQ(ierr);
2150     ierr = PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2151     ierr = PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2152     b->user_alloc = PETSC_FALSE;
2153   } else { /* user-allocated storage */
2154     if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); }
2155     b->v          = data;
2156     b->user_alloc = PETSC_TRUE;
2157   }
2158   B->assembled = PETSC_TRUE;
2159   PetscFunctionReturn(0);
2160 }
2161 EXTERN_C_END
2162 
2163 #undef __FUNCT__
2164 #define __FUNCT__ "MatSeqDenseSetLDA"
2165 /*@C
2166   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2167 
2168   Input parameter:
2169 + A - the matrix
2170 - lda - the leading dimension
2171 
2172   Notes:
2173   This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2174   it asserts that the preallocation has a leading dimension (the LDA parameter
2175   of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2176 
2177   Level: intermediate
2178 
2179 .keywords: dense, matrix, LAPACK, BLAS
2180 
2181 .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2182 
2183 @*/
2184 PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2185 {
2186   Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2187 
2188   PetscFunctionBegin;
2189   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);
2190   b->lda       = lda;
2191   b->changelda = PETSC_FALSE;
2192   b->Mmax      = PetscMax(b->Mmax,lda);
2193   PetscFunctionReturn(0);
2194 }
2195 
2196 /*MC
2197    MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2198 
2199    Options Database Keys:
2200 . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2201 
2202   Level: beginner
2203 
2204 .seealso: MatCreateSeqDense()
2205 
2206 M*/
2207 
2208 EXTERN_C_BEGIN
2209 #undef __FUNCT__
2210 #define __FUNCT__ "MatCreate_SeqDense"
2211 PetscErrorCode  MatCreate_SeqDense(Mat B)
2212 {
2213   Mat_SeqDense   *b;
2214   PetscErrorCode ierr;
2215   PetscMPIInt    size;
2216 
2217   PetscFunctionBegin;
2218   ierr = MPI_Comm_size(((PetscObject)B)->comm,&size);CHKERRQ(ierr);
2219   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2220 
2221   ierr            = PetscNewLog(B,Mat_SeqDense,&b);CHKERRQ(ierr);
2222   ierr            = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
2223   B->data         = (void*)b;
2224 
2225   b->pivots       = 0;
2226   b->roworiented  = PETSC_TRUE;
2227   b->v            = 0;
2228   b->changelda    = PETSC_FALSE;
2229 
2230 
2231   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);CHKERRQ(ierr);
2232   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2233                                      "MatGetFactor_seqdense_petsc",
2234                                       MatGetFactor_seqdense_petsc);CHKERRQ(ierr);
2235   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2236                                     "MatSeqDenseSetPreallocation_SeqDense",
2237                                      MatSeqDenseSetPreallocation_SeqDense);CHKERRQ(ierr);
2238 
2239   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2240                                      "MatMatMult_SeqAIJ_SeqDense",
2241                                       MatMatMult_SeqAIJ_SeqDense);CHKERRQ(ierr);
2242 
2243 
2244   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2245                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2246                                       MatMatMultSymbolic_SeqAIJ_SeqDense);CHKERRQ(ierr);
2247   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2248                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2249                                       MatMatMultNumeric_SeqAIJ_SeqDense);CHKERRQ(ierr);
2250   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);CHKERRQ(ierr);
2251   PetscFunctionReturn(0);
2252 }
2253 EXTERN_C_END
2254