Actual source code: dense.c
petsc-3.3-p5 2012-12-01
2: /*
3: Defines the basic matrix operations for sequential dense.
4: */
6: #include <../src/mat/impls/dense/seq/dense.h>
7: #include <petscblaslapack.h>
9: #include <../src/mat/impls/aij/seq/aij.h>
10: EXTERN_C_BEGIN
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;
18: PetscInt i;
19: PetscInt *rows;
20: MatScalar *aa = a->v;
23: MatCreate(((PetscObject)A)->comm,&B);
24: MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);
25: MatSetType(B,MATSEQAIJ);
26: MatSeqAIJSetPreallocation(B,A->cmap->n,PETSC_NULL);
28: PetscMalloc(A->rmap->n*sizeof(PetscInt),&rows);
29: for (i=0; i<A->rmap->n; i++) rows[i] = i;
31: for (i=0; i<A->cmap->n; i++) {
32: MatSetValues(B,A->rmap->n,rows,1,&i,aa,INSERT_VALUES);
33: aa += a->lda;
34: }
35: PetscFree(rows);
36: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
37: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
38:
39: if (reuse == MAT_REUSE_MATRIX) {
40: MatHeaderReplace(A,B);
41: } else {
42: *newmat = B;
43: }
44: return(0);
45: }
46: EXTERN_C_END
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;
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: PetscLogFlops(PetscMax(2*N-1,0));
71: return(0);
72: }
76: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
77: {
78: PetscInt N = A->rmap->n*A->cmap->n;
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: return(0);
92: }
96: PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha)
97: {
98: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
99: PetscScalar oalpha = alpha;
101: PetscBLASInt one = 1,j,nz,lda = PetscBLASIntCast(a->lda);
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: PetscLogFlops(nz);
114: return(0);
115: }
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;
126: *fl = PETSC_FALSE;
127: if (A->rmap->n != A->cmap->n) return(0);
128: N = a->lda;
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) return(0);
133: }
134: }
135: *fl = PETSC_TRUE;
136: return(0);
137: }
138:
141: PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
142: {
143: Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l;
145: PetscInt lda = (PetscInt)mat->lda,j,m;
148: PetscLayoutReference(A->rmap,&newi->rmap);
149: PetscLayoutReference(A->cmap,&newi->cmap);
150: MatSeqDenseSetPreallocation(newi,PETSC_NULL);
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: PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
157: }
158: } else {
159: PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
160: }
161: }
162: newi->assembled = PETSC_TRUE;
163: return(0);
164: }
168: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
169: {
173: MatCreate(((PetscObject)A)->comm,newmat);
174: MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
175: MatSetType(*newmat,((PetscObject)A)->type_name);
176: MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);
177: return(0);
178: }
181: extern PetscErrorCode MatLUFactor_SeqDense(Mat,IS,IS,const MatFactorInfo*);
185: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
186: {
187: MatFactorInfo info;
191: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
192: MatLUFactor_SeqDense(fact,0,0,&info);
193: return(0);
194: }
198: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
199: {
200: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
202: PetscScalar *x,*y;
203: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
204:
206: VecGetArray(xx,&x);
207: VecGetArray(yy,&y);
208: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
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: VecRestoreArray(xx,&x);
226: VecRestoreArray(yy,&y);
227: PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
228: return(0);
229: }
233: PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X)
234: {
235: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
237: PetscScalar *b,*x;
238: PetscInt n;
239: PetscBLASInt nrhs,info,m=PetscBLASIntCast(A->rmap->n);
240: PetscBool flg;
243: PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
244: if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
245: PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
246: if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
248: MatGetSize(B,PETSC_NULL,&n);
249: nrhs = PetscBLASIntCast(n);
250: MatGetArray(B,&b);
251: MatGetArray(X,&x);
253: PetscMemcpy(x,b,m*nrhs*sizeof(PetscScalar));
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");
272: MatRestoreArray(B,&b);
273: MatRestoreArray(X,&x);
274: PetscLogFlops(nrhs*(2.0*m*m - m));
275: return(0);
276: }
280: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
281: {
282: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
284: PetscScalar *x,*y;
285: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
286:
288: VecGetArray(xx,&x);
289: VecGetArray(yy,&y);
290: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
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: VecRestoreArray(xx,&x);
308: VecRestoreArray(yy,&y);
309: PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
310: return(0);
311: }
315: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
316: {
317: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
319: PetscScalar *x,*y,sone = 1.0;
320: Vec tmp = 0;
321: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
322:
324: VecGetArray(xx,&x);
325: VecGetArray(yy,&y);
326: if (!A->rmap->n || !A->cmap->n) return(0);
327: if (yy == zz) {
328: VecDuplicate(yy,&tmp);
329: PetscLogObjectParent(A,tmp);
330: VecCopy(yy,tmp);
331: }
332: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
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: VecAXPY(yy,sone,tmp);
351: VecDestroy(&tmp);
352: } else {
353: VecAXPY(yy,sone,zz);
354: }
355: VecRestoreArray(xx,&x);
356: VecRestoreArray(yy,&y);
357: PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
358: return(0);
359: }
363: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
364: {
365: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
367: PetscScalar *x,*y,sone = 1.0;
368: Vec tmp;
369: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
370:
372: if (!A->rmap->n || !A->cmap->n) return(0);
373: VecGetArray(xx,&x);
374: VecGetArray(yy,&y);
375: if (yy == zz) {
376: VecDuplicate(yy,&tmp);
377: PetscLogObjectParent(A,tmp);
378: VecCopy(yy,tmp);
379: }
380: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
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: VecAXPY(yy,sone,tmp);
399: VecDestroy(&tmp);
400: } else {
401: VecAXPY(yy,sone,zz);
402: }
403: VecRestoreArray(xx,&x);
404: VecRestoreArray(yy,&y);
405: PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
406: return(0);
407: }
409: /* ---------------------------------------------------------------*/
410: /* COMMENT: I have chosen to hide row permutation in the pivots,
411: rather than put it in the Mat->row slot.*/
414: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
415: {
416: #if defined(PETSC_MISSING_LAPACK_GETRF)
418: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
419: #else
420: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
422: PetscBLASInt n,m,info;
425: n = PetscBLASIntCast(A->cmap->n);
426: m = PetscBLASIntCast(A->rmap->n);
427: if (!mat->pivots) {
428: PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
429: PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
430: }
431: if (!A->rmap->n || !A->cmap->n) return(0);
432: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
433: LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
434: PetscFPTrapPop();
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;
444: PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);
445: #endif
446: return(0);
447: }
451: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
452: {
453: #if defined(PETSC_MISSING_LAPACK_POTRF)
455: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
456: #else
457: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
459: PetscBLASInt info,n = PetscBLASIntCast(A->cmap->n);
460:
462: PetscFree(mat->pivots);
464: if (!A->rmap->n || !A->cmap->n) return(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: PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);
473: #endif
474: return(0);
475: }
480: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
481: {
483: MatFactorInfo info;
486: info.fill = 1.0;
487: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
488: MatCholeskyFactor_SeqDense(fact,0,&info);
489: return(0);
490: }
494: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
495: {
497: fact->assembled = PETSC_TRUE;
498: fact->preallocated = PETSC_TRUE;
499: fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
500: return(0);
501: }
505: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
506: {
508: fact->preallocated = PETSC_TRUE;
509: fact->assembled = PETSC_TRUE;
510: fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
511: return(0);
512: }
514: EXTERN_C_BEGIN
517: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
518: {
522: MatCreate(((PetscObject)A)->comm,fact);
523: MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
524: MatSetType(*fact,((PetscObject)A)->type_name);
525: if (ftype == MAT_FACTOR_LU){
526: (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
527: } else {
528: (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
529: }
530: (*fact)->factortype = ftype;
531: return(0);
532: }
533: EXTERN_C_END
535: /* ------------------------------------------------------------------*/
538: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
539: {
540: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
541: PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt;
543: PetscInt m = A->rmap->n,i;
544: PetscBLASInt o = 1,bm = PetscBLASIntCast(m);
547: if (flag & SOR_ZERO_INITIAL_GUESS) {
548: /* this is a hack fix, should have another version without the second BLASdot */
549: VecSet(xx,zero);
550: }
551: VecGetArray(xx,&x);
552: VecGetArray(bb,&b);
553: its = its*lits;
554: if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
555: while (its--) {
556: if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
557: for (i=0; i<m; i++) {
558: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
559: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
560: }
561: }
562: if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
563: for (i=m-1; i>=0; i--) {
564: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
565: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
566: }
567: }
568: }
569: VecRestoreArray(bb,&b);
570: VecRestoreArray(xx,&x);
571: return(0);
572: }
574: /* -----------------------------------------------------------------*/
577: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
578: {
579: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
580: PetscScalar *v = mat->v,*x,*y;
582: PetscBLASInt m, n,_One=1;
583: PetscScalar _DOne=1.0,_DZero=0.0;
586: m = PetscBLASIntCast(A->rmap->n);
587: n = PetscBLASIntCast(A->cmap->n);
588: if (!A->rmap->n || !A->cmap->n) return(0);
589: VecGetArray(xx,&x);
590: VecGetArray(yy,&y);
591: BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
592: VecRestoreArray(xx,&x);
593: VecRestoreArray(yy,&y);
594: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);
595: return(0);
596: }
600: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
601: {
602: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
603: PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
605: PetscBLASInt m, n, _One=1;
608: m = PetscBLASIntCast(A->rmap->n);
609: n = PetscBLASIntCast(A->cmap->n);
610: if (!A->rmap->n || !A->cmap->n) return(0);
611: VecGetArray(xx,&x);
612: VecGetArray(yy,&y);
613: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
614: VecRestoreArray(xx,&x);
615: VecRestoreArray(yy,&y);
616: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);
617: return(0);
618: }
622: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
623: {
624: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
625: PetscScalar *v = mat->v,*x,*y,_DOne=1.0;
627: PetscBLASInt m, n, _One=1;
630: m = PetscBLASIntCast(A->rmap->n);
631: n = PetscBLASIntCast(A->cmap->n);
632: if (!A->rmap->n || !A->cmap->n) return(0);
633: if (zz != yy) {VecCopy(zz,yy);}
634: VecGetArray(xx,&x);
635: VecGetArray(yy,&y);
636: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
637: VecRestoreArray(xx,&x);
638: VecRestoreArray(yy,&y);
639: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
640: return(0);
641: }
645: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
646: {
647: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
648: PetscScalar *v = mat->v,*x,*y;
650: PetscBLASInt m, n, _One=1;
651: PetscScalar _DOne=1.0;
654: m = PetscBLASIntCast(A->rmap->n);
655: n = PetscBLASIntCast(A->cmap->n);
656: if (!A->rmap->n || !A->cmap->n) return(0);
657: if (zz != yy) {VecCopy(zz,yy);}
658: VecGetArray(xx,&x);
659: VecGetArray(yy,&y);
660: BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
661: VecRestoreArray(xx,&x);
662: VecRestoreArray(yy,&y);
663: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
664: return(0);
665: }
667: /* -----------------------------------------------------------------*/
670: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
671: {
672: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
673: PetscScalar *v;
675: PetscInt i;
676:
678: *ncols = A->cmap->n;
679: if (cols) {
680: PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
681: for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
682: }
683: if (vals) {
684: PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
685: v = mat->v + row;
686: for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
687: }
688: return(0);
689: }
693: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
694: {
697: if (cols) {PetscFree(*cols);}
698: if (vals) {PetscFree(*vals); }
699: return(0);
700: }
701: /* ----------------------------------------------------------------*/
704: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
705: {
706: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
707: PetscInt i,j,idx=0;
708:
711: if (!mat->roworiented) {
712: if (addv == INSERT_VALUES) {
713: for (j=0; j<n; j++) {
714: if (indexn[j] < 0) {idx += m; continue;}
715: #if defined(PETSC_USE_DEBUG)
716: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
717: #endif
718: for (i=0; i<m; i++) {
719: if (indexm[i] < 0) {idx++; continue;}
720: #if defined(PETSC_USE_DEBUG)
721: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
722: #endif
723: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
724: }
725: }
726: } else {
727: for (j=0; j<n; j++) {
728: if (indexn[j] < 0) {idx += m; continue;}
729: #if defined(PETSC_USE_DEBUG)
730: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
731: #endif
732: for (i=0; i<m; i++) {
733: if (indexm[i] < 0) {idx++; continue;}
734: #if defined(PETSC_USE_DEBUG)
735: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
736: #endif
737: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
738: }
739: }
740: }
741: } else {
742: if (addv == INSERT_VALUES) {
743: for (i=0; i<m; i++) {
744: if (indexm[i] < 0) { idx += n; continue;}
745: #if defined(PETSC_USE_DEBUG)
746: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
747: #endif
748: for (j=0; j<n; j++) {
749: if (indexn[j] < 0) { idx++; continue;}
750: #if defined(PETSC_USE_DEBUG)
751: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
752: #endif
753: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
754: }
755: }
756: } else {
757: for (i=0; i<m; i++) {
758: if (indexm[i] < 0) { idx += n; continue;}
759: #if defined(PETSC_USE_DEBUG)
760: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
761: #endif
762: for (j=0; j<n; j++) {
763: if (indexn[j] < 0) { idx++; continue;}
764: #if defined(PETSC_USE_DEBUG)
765: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
766: #endif
767: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
768: }
769: }
770: }
771: }
772: return(0);
773: }
777: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
778: {
779: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
780: PetscInt i,j;
783: /* row-oriented output */
784: for (i=0; i<m; i++) {
785: if (indexm[i] < 0) {v += n;continue;}
786: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
787: for (j=0; j<n; j++) {
788: if (indexn[j] < 0) {v++; continue;}
789: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
790: *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
791: }
792: }
793: return(0);
794: }
796: /* -----------------------------------------------------------------*/
800: PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
801: {
802: Mat_SeqDense *a;
804: PetscInt *scols,i,j,nz,header[4];
805: int fd;
806: PetscMPIInt size;
807: PetscInt *rowlengths = 0,M,N,*cols,grows,gcols;
808: PetscScalar *vals,*svals,*v,*w;
809: MPI_Comm comm = ((PetscObject)viewer)->comm;
812: MPI_Comm_size(comm,&size);
813: if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
814: PetscViewerBinaryGetDescriptor(viewer,&fd);
815: PetscBinaryRead(fd,header,4,PETSC_INT);
816: if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
817: M = header[1]; N = header[2]; nz = header[3];
819: /* set global size if not set already*/
820: if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
821: MatSetSizes(newmat,M,N,M,N);
822: } else {
823: /* if sizes and type are already set, check if the vector global sizes are correct */
824: MatGetSize(newmat,&grows,&gcols);
825: if (M != grows || N != gcols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,grows,gcols);
826: }
827: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
828:
829: if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
830: a = (Mat_SeqDense*)newmat->data;
831: v = a->v;
832: /* Allocate some temp space to read in the values and then flip them
833: from row major to column major */
834: PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
835: /* read in nonzero values */
836: PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
837: /* now flip the values and store them in the matrix*/
838: for (j=0; j<N; j++) {
839: for (i=0; i<M; i++) {
840: *v++ =w[i*N+j];
841: }
842: }
843: PetscFree(w);
844: } else {
845: /* read row lengths */
846: PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
847: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
849: a = (Mat_SeqDense*)newmat->data;
850: v = a->v;
852: /* read column indices and nonzeros */
853: PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
854: cols = scols;
855: PetscBinaryRead(fd,cols,nz,PETSC_INT);
856: PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
857: vals = svals;
858: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
860: /* insert into matrix */
861: for (i=0; i<M; i++) {
862: for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
863: svals += rowlengths[i]; scols += rowlengths[i];
864: }
865: PetscFree(vals);
866: PetscFree(cols);
867: PetscFree(rowlengths);
868: }
869: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
870: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
872: return(0);
873: }
877: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
878: {
879: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
880: PetscErrorCode ierr;
881: PetscInt i,j;
882: const char *name;
883: PetscScalar *v;
884: PetscViewerFormat format;
885: #if defined(PETSC_USE_COMPLEX)
886: PetscBool allreal = PETSC_TRUE;
887: #endif
890: PetscViewerGetFormat(viewer,&format);
891: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
892: return(0); /* do nothing for now */
893: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
894: PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
895: PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
896: for (i=0; i<A->rmap->n; i++) {
897: v = a->v + i;
898: PetscViewerASCIIPrintf(viewer,"row %D:",i);
899: for (j=0; j<A->cmap->n; j++) {
900: #if defined(PETSC_USE_COMPLEX)
901: if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
902: PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
903: } else if (PetscRealPart(*v)) {
904: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
905: }
906: #else
907: if (*v) {
908: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
909: }
910: #endif
911: v += a->lda;
912: }
913: PetscViewerASCIIPrintf(viewer,"\n");
914: }
915: PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
916: } else {
917: PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
918: #if defined(PETSC_USE_COMPLEX)
919: /* determine if matrix has all real values */
920: v = a->v;
921: for (i=0; i<A->rmap->n*A->cmap->n; i++) {
922: if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
923: }
924: #endif
925: if (format == PETSC_VIEWER_ASCII_MATLAB) {
926: PetscObjectGetName((PetscObject)A,&name);
927: PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
928: PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
929: PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
930: } else {
931: PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
932: }
934: for (i=0; i<A->rmap->n; i++) {
935: v = a->v + i;
936: for (j=0; j<A->cmap->n; j++) {
937: #if defined(PETSC_USE_COMPLEX)
938: if (allreal) {
939: PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)PetscRealPart(*v));
940: } else {
941: PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei ",(double)PetscRealPart(*v),(double)PetscImaginaryPart(*v));
942: }
943: #else
944: PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)*v);
945: #endif
946: v += a->lda;
947: }
948: PetscViewerASCIIPrintf(viewer,"\n");
949: }
950: if (format == PETSC_VIEWER_ASCII_MATLAB) {
951: PetscViewerASCIIPrintf(viewer,"];\n");
952: }
953: PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
954: }
955: PetscViewerFlush(viewer);
956: return(0);
957: }
961: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
962: {
963: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
964: PetscErrorCode ierr;
965: int fd;
966: PetscInt ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
967: PetscScalar *v,*anonz,*vals;
968: PetscViewerFormat format;
969:
971: PetscViewerBinaryGetDescriptor(viewer,&fd);
973: PetscViewerGetFormat(viewer,&format);
974: if (format == PETSC_VIEWER_NATIVE) {
975: /* store the matrix as a dense matrix */
976: PetscMalloc(4*sizeof(PetscInt),&col_lens);
977: col_lens[0] = MAT_FILE_CLASSID;
978: col_lens[1] = m;
979: col_lens[2] = n;
980: col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
981: PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
982: PetscFree(col_lens);
984: /* write out matrix, by rows */
985: PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
986: v = a->v;
987: for (j=0; j<n; j++) {
988: for (i=0; i<m; i++) {
989: vals[j + i*n] = *v++;
990: }
991: }
992: PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
993: PetscFree(vals);
994: } else {
995: PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
996: col_lens[0] = MAT_FILE_CLASSID;
997: col_lens[1] = m;
998: col_lens[2] = n;
999: col_lens[3] = nz;
1001: /* store lengths of each row and write (including header) to file */
1002: for (i=0; i<m; i++) col_lens[4+i] = n;
1003: PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);
1005: /* Possibly should write in smaller increments, not whole matrix at once? */
1006: /* store column indices (zero start index) */
1007: ict = 0;
1008: for (i=0; i<m; i++) {
1009: for (j=0; j<n; j++) col_lens[ict++] = j;
1010: }
1011: PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
1012: PetscFree(col_lens);
1014: /* store nonzero values */
1015: PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
1016: ict = 0;
1017: for (i=0; i<m; i++) {
1018: v = a->v + i;
1019: for (j=0; j<n; j++) {
1020: anonz[ict++] = *v; v += a->lda;
1021: }
1022: }
1023: PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
1024: PetscFree(anonz);
1025: }
1026: return(0);
1027: }
1031: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1032: {
1033: Mat A = (Mat) Aa;
1034: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1035: PetscErrorCode ierr;
1036: PetscInt m = A->rmap->n,n = A->cmap->n,color,i,j;
1037: PetscScalar *v = a->v;
1038: PetscViewer viewer;
1039: PetscDraw popup;
1040: PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1041: PetscViewerFormat format;
1045: PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
1046: PetscViewerGetFormat(viewer,&format);
1047: PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);
1049: /* Loop over matrix elements drawing boxes */
1050: if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1051: /* Blue for negative and Red for positive */
1052: color = PETSC_DRAW_BLUE;
1053: for(j = 0; j < n; j++) {
1054: x_l = j;
1055: x_r = x_l + 1.0;
1056: for(i = 0; i < m; i++) {
1057: y_l = m - i - 1.0;
1058: y_r = y_l + 1.0;
1059: #if defined(PETSC_USE_COMPLEX)
1060: if (PetscRealPart(v[j*m+i]) > 0.) {
1061: color = PETSC_DRAW_RED;
1062: } else if (PetscRealPart(v[j*m+i]) < 0.) {
1063: color = PETSC_DRAW_BLUE;
1064: } else {
1065: continue;
1066: }
1067: #else
1068: if (v[j*m+i] > 0.) {
1069: color = PETSC_DRAW_RED;
1070: } else if (v[j*m+i] < 0.) {
1071: color = PETSC_DRAW_BLUE;
1072: } else {
1073: continue;
1074: }
1075: #endif
1076: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1077: }
1078: }
1079: } else {
1080: /* use contour shading to indicate magnitude of values */
1081: /* first determine max of all nonzero values */
1082: for(i = 0; i < m*n; i++) {
1083: if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1084: }
1085: scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1086: PetscDrawGetPopup(draw,&popup);
1087: if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1088: for(j = 0; j < n; j++) {
1089: x_l = j;
1090: x_r = x_l + 1.0;
1091: for(i = 0; i < m; i++) {
1092: y_l = m - i - 1.0;
1093: y_r = y_l + 1.0;
1094: color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1095: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1096: }
1097: }
1098: }
1099: return(0);
1100: }
1104: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1105: {
1106: PetscDraw draw;
1107: PetscBool isnull;
1108: PetscReal xr,yr,xl,yl,h,w;
1112: PetscViewerDrawGetDraw(viewer,0,&draw);
1113: PetscDrawIsNull(draw,&isnull);
1114: if (isnull) return(0);
1116: PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1117: xr = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1118: xr += w; yr += h; xl = -w; yl = -h;
1119: PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1120: PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1121: PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1122: return(0);
1123: }
1127: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1128: {
1130: PetscBool iascii,isbinary,isdraw;
1133: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
1134: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
1135: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);
1137: if (iascii) {
1138: MatView_SeqDense_ASCII(A,viewer);
1139: } else if (isbinary) {
1140: MatView_SeqDense_Binary(A,viewer);
1141: } else if (isdraw) {
1142: MatView_SeqDense_Draw(A,viewer);
1143: } else {
1144: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1145: }
1146: return(0);
1147: }
1151: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1152: {
1153: Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1157: #if defined(PETSC_USE_LOG)
1158: PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1159: #endif
1160: PetscFree(l->pivots);
1161: if (!l->user_alloc) {PetscFree(l->v);}
1162: PetscFree(mat->data);
1164: PetscObjectChangeTypeName((PetscObject)mat,0);
1165: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1166: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1167: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1168: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1169: return(0);
1170: }
1174: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1175: {
1176: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1178: PetscInt k,j,m,n,M;
1179: PetscScalar *v,tmp;
1182: v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1183: if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1184: if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1185: else {
1186: for (j=0; j<m; j++) {
1187: for (k=0; k<j; k++) {
1188: tmp = v[j + k*M];
1189: v[j + k*M] = v[k + j*M];
1190: v[k + j*M] = tmp;
1191: }
1192: }
1193: }
1194: } else { /* out-of-place transpose */
1195: Mat tmat;
1196: Mat_SeqDense *tmatd;
1197: PetscScalar *v2;
1199: if (reuse == MAT_INITIAL_MATRIX) {
1200: MatCreate(((PetscObject)A)->comm,&tmat);
1201: MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1202: MatSetType(tmat,((PetscObject)A)->type_name);
1203: MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1204: } else {
1205: tmat = *matout;
1206: }
1207: tmatd = (Mat_SeqDense*)tmat->data;
1208: v = mat->v; v2 = tmatd->v;
1209: for (j=0; j<n; j++) {
1210: for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1211: }
1212: MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1213: MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1214: *matout = tmat;
1215: }
1216: return(0);
1217: }
1221: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool *flg)
1222: {
1223: Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1224: Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1225: PetscInt i,j;
1226: PetscScalar *v1 = mat1->v,*v2 = mat2->v;
1229: if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1230: if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1231: for (i=0; i<A1->rmap->n; i++) {
1232: v1 = mat1->v+i; v2 = mat2->v+i;
1233: for (j=0; j<A1->cmap->n; j++) {
1234: if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1235: v1 += mat1->lda; v2 += mat2->lda;
1236: }
1237: }
1238: *flg = PETSC_TRUE;
1239: return(0);
1240: }
1244: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1245: {
1246: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1248: PetscInt i,n,len;
1249: PetscScalar *x,zero = 0.0;
1252: VecSet(v,zero);
1253: VecGetSize(v,&n);
1254: VecGetArray(v,&x);
1255: len = PetscMin(A->rmap->n,A->cmap->n);
1256: if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1257: for (i=0; i<len; i++) {
1258: x[i] = mat->v[i*mat->lda + i];
1259: }
1260: VecRestoreArray(v,&x);
1261: return(0);
1262: }
1266: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1267: {
1268: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1269: PetscScalar *l,*r,x,*v;
1271: PetscInt i,j,m = A->rmap->n,n = A->cmap->n;
1274: if (ll) {
1275: VecGetSize(ll,&m);
1276: VecGetArray(ll,&l);
1277: if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1278: for (i=0; i<m; i++) {
1279: x = l[i];
1280: v = mat->v + i;
1281: for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1282: }
1283: VecRestoreArray(ll,&l);
1284: PetscLogFlops(n*m);
1285: }
1286: if (rr) {
1287: VecGetSize(rr,&n);
1288: VecGetArray(rr,&r);
1289: if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1290: for (i=0; i<n; i++) {
1291: x = r[i];
1292: v = mat->v + i*m;
1293: for (j=0; j<m; j++) { (*v++) *= x;}
1294: }
1295: VecRestoreArray(rr,&r);
1296: PetscLogFlops(n*m);
1297: }
1298: return(0);
1299: }
1303: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1304: {
1305: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1306: PetscScalar *v = mat->v;
1307: PetscReal sum = 0.0;
1308: PetscInt lda=mat->lda,m=A->rmap->n,i,j;
1312: if (type == NORM_FROBENIUS) {
1313: if (lda>m) {
1314: for (j=0; j<A->cmap->n; j++) {
1315: v = mat->v+j*lda;
1316: for (i=0; i<m; i++) {
1317: #if defined(PETSC_USE_COMPLEX)
1318: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1319: #else
1320: sum += (*v)*(*v); v++;
1321: #endif
1322: }
1323: }
1324: } else {
1325: for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1326: #if defined(PETSC_USE_COMPLEX)
1327: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1328: #else
1329: sum += (*v)*(*v); v++;
1330: #endif
1331: }
1332: }
1333: *nrm = PetscSqrtReal(sum);
1334: PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1335: } else if (type == NORM_1) {
1336: *nrm = 0.0;
1337: for (j=0; j<A->cmap->n; j++) {
1338: v = mat->v + j*mat->lda;
1339: sum = 0.0;
1340: for (i=0; i<A->rmap->n; i++) {
1341: sum += PetscAbsScalar(*v); v++;
1342: }
1343: if (sum > *nrm) *nrm = sum;
1344: }
1345: PetscLogFlops(A->cmap->n*A->rmap->n);
1346: } else if (type == NORM_INFINITY) {
1347: *nrm = 0.0;
1348: for (j=0; j<A->rmap->n; j++) {
1349: v = mat->v + j;
1350: sum = 0.0;
1351: for (i=0; i<A->cmap->n; i++) {
1352: sum += PetscAbsScalar(*v); v += mat->lda;
1353: }
1354: if (sum > *nrm) *nrm = sum;
1355: }
1356: PetscLogFlops(A->cmap->n*A->rmap->n);
1357: } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1358: return(0);
1359: }
1363: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool flg)
1364: {
1365: Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1367:
1369: switch (op) {
1370: case MAT_ROW_ORIENTED:
1371: aij->roworiented = flg;
1372: break;
1373: case MAT_NEW_NONZERO_LOCATIONS:
1374: case MAT_NEW_NONZERO_LOCATION_ERR:
1375: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1376: case MAT_NEW_DIAGONALS:
1377: case MAT_KEEP_NONZERO_PATTERN:
1378: case MAT_IGNORE_OFF_PROC_ENTRIES:
1379: case MAT_USE_HASH_TABLE:
1380: case MAT_SYMMETRIC:
1381: case MAT_STRUCTURALLY_SYMMETRIC:
1382: case MAT_HERMITIAN:
1383: case MAT_SYMMETRY_ETERNAL:
1384: case MAT_IGNORE_LOWER_TRIANGULAR:
1385: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1386: break;
1387: default:
1388: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1389: }
1390: return(0);
1391: }
1395: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1396: {
1397: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1399: PetscInt lda=l->lda,m=A->rmap->n,j;
1402: if (lda>m) {
1403: for (j=0; j<A->cmap->n; j++) {
1404: PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1405: }
1406: } else {
1407: PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1408: }
1409: return(0);
1410: }
1414: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1415: {
1416: PetscErrorCode ierr;
1417: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1418: PetscInt m = l->lda, n = A->cmap->n, i,j;
1419: PetscScalar *slot,*bb;
1420: const PetscScalar *xx;
1423: #if defined(PETSC_USE_DEBUG)
1424: for (i=0; i<N; i++) {
1425: if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1426: 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);
1427: }
1428: #endif
1430: /* fix right hand side if needed */
1431: if (x && b) {
1432: VecGetArrayRead(x,&xx);
1433: VecGetArray(b,&bb);
1434: for (i=0; i<N; i++) {
1435: bb[rows[i]] = diag*xx[rows[i]];
1436: }
1437: VecRestoreArrayRead(x,&xx);
1438: VecRestoreArray(b,&bb);
1439: }
1441: for (i=0; i<N; i++) {
1442: slot = l->v + rows[i];
1443: for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1444: }
1445: if (diag != 0.0) {
1446: if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1447: for (i=0; i<N; i++) {
1448: slot = l->v + (m+1)*rows[i];
1449: *slot = diag;
1450: }
1451: }
1452: return(0);
1453: }
1457: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1458: {
1459: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1462: 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");
1463: *array = mat->v;
1464: return(0);
1465: }
1469: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1470: {
1472: *array = 0; /* user cannot accidently use the array later */
1473: return(0);
1474: }
1478: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1479: {
1480: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1482: PetscInt i,j,nrows,ncols;
1483: const PetscInt *irow,*icol;
1484: PetscScalar *av,*bv,*v = mat->v;
1485: Mat newmat;
1488: ISGetIndices(isrow,&irow);
1489: ISGetIndices(iscol,&icol);
1490: ISGetLocalSize(isrow,&nrows);
1491: ISGetLocalSize(iscol,&ncols);
1492:
1493: /* Check submatrixcall */
1494: if (scall == MAT_REUSE_MATRIX) {
1495: PetscInt n_cols,n_rows;
1496: MatGetSize(*B,&n_rows,&n_cols);
1497: if (n_rows != nrows || n_cols != ncols) {
1498: /* resize the result matrix to match number of requested rows/columns */
1499: MatSetSizes(*B,nrows,ncols,nrows,ncols);
1500: }
1501: newmat = *B;
1502: } else {
1503: /* Create and fill new matrix */
1504: MatCreate(((PetscObject)A)->comm,&newmat);
1505: MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1506: MatSetType(newmat,((PetscObject)A)->type_name);
1507: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1508: }
1510: /* Now extract the data pointers and do the copy,column at a time */
1511: bv = ((Mat_SeqDense*)newmat->data)->v;
1512:
1513: for (i=0; i<ncols; i++) {
1514: av = v + mat->lda*icol[i];
1515: for (j=0; j<nrows; j++) {
1516: *bv++ = av[irow[j]];
1517: }
1518: }
1520: /* Assemble the matrices so that the correct flags are set */
1521: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1522: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
1524: /* Free work space */
1525: ISRestoreIndices(isrow,&irow);
1526: ISRestoreIndices(iscol,&icol);
1527: *B = newmat;
1528: return(0);
1529: }
1533: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1534: {
1536: PetscInt i;
1539: if (scall == MAT_INITIAL_MATRIX) {
1540: PetscMalloc((n+1)*sizeof(Mat),B);
1541: }
1543: for (i=0; i<n; i++) {
1544: MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1545: }
1546: return(0);
1547: }
1551: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1552: {
1554: return(0);
1555: }
1559: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1560: {
1562: return(0);
1563: }
1567: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1568: {
1569: Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1571: PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1574: /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1575: if (A->ops->copy != B->ops->copy) {
1576: MatCopy_Basic(A,B,str);
1577: return(0);
1578: }
1579: if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1580: if (lda1>m || lda2>m) {
1581: for (j=0; j<n; j++) {
1582: PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1583: }
1584: } else {
1585: PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1586: }
1587: return(0);
1588: }
1592: PetscErrorCode MatSetUp_SeqDense(Mat A)
1593: {
1597: MatSeqDenseSetPreallocation(A,0);
1598: return(0);
1599: }
1603: static PetscErrorCode MatConjugate_SeqDense(Mat A)
1604: {
1605: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1606: PetscInt i,nz = A->rmap->n*A->cmap->n;
1607: PetscScalar *aa = a->v;
1610: for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1611: return(0);
1612: }
1616: static PetscErrorCode MatRealPart_SeqDense(Mat A)
1617: {
1618: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1619: PetscInt i,nz = A->rmap->n*A->cmap->n;
1620: PetscScalar *aa = a->v;
1623: for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1624: return(0);
1625: }
1629: static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1630: {
1631: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1632: PetscInt i,nz = A->rmap->n*A->cmap->n;
1633: PetscScalar *aa = a->v;
1636: for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1637: return(0);
1638: }
1640: /* ----------------------------------------------------------------*/
1643: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1644: {
1648: if (scall == MAT_INITIAL_MATRIX){
1649: MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1650: }
1651: MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1652: return(0);
1653: }
1657: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1658: {
1660: PetscInt m=A->rmap->n,n=B->cmap->n;
1661: Mat Cmat;
1664: 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);
1665: MatCreate(PETSC_COMM_SELF,&Cmat);
1666: MatSetSizes(Cmat,m,n,m,n);
1667: MatSetType(Cmat,MATSEQDENSE);
1668: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1669: Cmat->assembled = PETSC_TRUE;
1670: Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense;
1671: *C = Cmat;
1672: return(0);
1673: }
1677: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1678: {
1679: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1680: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1681: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1682: PetscBLASInt m,n,k;
1683: PetscScalar _DOne=1.0,_DZero=0.0;
1686: m = PetscBLASIntCast(A->rmap->n);
1687: n = PetscBLASIntCast(B->cmap->n);
1688: k = PetscBLASIntCast(A->cmap->n);
1689: BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1690: return(0);
1691: }
1695: PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1696: {
1700: if (scall == MAT_INITIAL_MATRIX){
1701: MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1702: }
1703: MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1704: return(0);
1705: }
1709: PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1710: {
1712: PetscInt m=A->cmap->n,n=B->cmap->n;
1713: Mat Cmat;
1716: 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);
1717: MatCreate(PETSC_COMM_SELF,&Cmat);
1718: MatSetSizes(Cmat,m,n,m,n);
1719: MatSetType(Cmat,MATSEQDENSE);
1720: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1721: Cmat->assembled = PETSC_TRUE;
1722: *C = Cmat;
1723: return(0);
1724: }
1728: PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1729: {
1730: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1731: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1732: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1733: PetscBLASInt m,n,k;
1734: PetscScalar _DOne=1.0,_DZero=0.0;
1737: m = PetscBLASIntCast(A->cmap->n);
1738: n = PetscBLASIntCast(B->cmap->n);
1739: k = PetscBLASIntCast(A->rmap->n);
1740: /*
1741: Note the m and n arguments below are the number rows and columns of A', not A!
1742: */
1743: BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1744: return(0);
1745: }
1749: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1750: {
1751: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1753: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1754: PetscScalar *x;
1755: MatScalar *aa = a->v;
1758: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1760: VecSet(v,0.0);
1761: VecGetArray(v,&x);
1762: VecGetLocalSize(v,&p);
1763: if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1764: for (i=0; i<m; i++) {
1765: x[i] = aa[i]; if (idx) idx[i] = 0;
1766: for (j=1; j<n; j++){
1767: if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1768: }
1769: }
1770: VecRestoreArray(v,&x);
1771: return(0);
1772: }
1776: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1777: {
1778: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1780: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1781: PetscScalar *x;
1782: PetscReal atmp;
1783: MatScalar *aa = a->v;
1786: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1788: VecSet(v,0.0);
1789: VecGetArray(v,&x);
1790: VecGetLocalSize(v,&p);
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] = PetscAbsScalar(aa[i]);
1794: for (j=1; j<n; j++){
1795: atmp = PetscAbsScalar(aa[i+m*j]);
1796: if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1797: }
1798: }
1799: VecRestoreArray(v,&x);
1800: return(0);
1801: }
1805: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1806: {
1807: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1809: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1810: PetscScalar *x;
1811: MatScalar *aa = a->v;
1814: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1816: VecSet(v,0.0);
1817: VecGetArray(v,&x);
1818: VecGetLocalSize(v,&p);
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] = aa[i]; if (idx) idx[i] = 0;
1822: for (j=1; j<n; j++){
1823: if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1824: }
1825: }
1826: VecRestoreArray(v,&x);
1827: return(0);
1828: }
1832: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1833: {
1834: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1836: PetscScalar *x;
1839: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1841: VecGetArray(v,&x);
1842: PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1843: VecRestoreArray(v,&x);
1844: return(0);
1845: }
1850: PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1851: {
1853: PetscInt i,j,m,n;
1854: PetscScalar *a;
1857: MatGetSize(A,&m,&n);
1858: PetscMemzero(norms,n*sizeof(PetscReal));
1859: MatGetArray(A,&a);
1860: if (type == NORM_2) {
1861: for (i=0; i<n; i++ ){
1862: for (j=0; j<m; j++) {
1863: norms[i] += PetscAbsScalar(a[j]*a[j]);
1864: }
1865: a += m;
1866: }
1867: } else if (type == NORM_1) {
1868: for (i=0; i<n; i++ ){
1869: for (j=0; j<m; j++) {
1870: norms[i] += PetscAbsScalar(a[j]);
1871: }
1872: a += m;
1873: }
1874: } else if (type == NORM_INFINITY) {
1875: for (i=0; i<n; i++ ){
1876: for (j=0; j<m; j++) {
1877: norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1878: }
1879: a += m;
1880: }
1881: } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1882: if (type == NORM_2) {
1883: for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1884: }
1885: return(0);
1886: }
1888: /* -------------------------------------------------------------------*/
1889: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1890: MatGetRow_SeqDense,
1891: MatRestoreRow_SeqDense,
1892: MatMult_SeqDense,
1893: /* 4*/ MatMultAdd_SeqDense,
1894: MatMultTranspose_SeqDense,
1895: MatMultTransposeAdd_SeqDense,
1896: 0,
1897: 0,
1898: 0,
1899: /*10*/ 0,
1900: MatLUFactor_SeqDense,
1901: MatCholeskyFactor_SeqDense,
1902: MatSOR_SeqDense,
1903: MatTranspose_SeqDense,
1904: /*15*/ MatGetInfo_SeqDense,
1905: MatEqual_SeqDense,
1906: MatGetDiagonal_SeqDense,
1907: MatDiagonalScale_SeqDense,
1908: MatNorm_SeqDense,
1909: /*20*/ MatAssemblyBegin_SeqDense,
1910: MatAssemblyEnd_SeqDense,
1911: MatSetOption_SeqDense,
1912: MatZeroEntries_SeqDense,
1913: /*24*/ MatZeroRows_SeqDense,
1914: 0,
1915: 0,
1916: 0,
1917: 0,
1918: /*29*/ MatSetUp_SeqDense,
1919: 0,
1920: 0,
1921: MatGetArray_SeqDense,
1922: MatRestoreArray_SeqDense,
1923: /*34*/ MatDuplicate_SeqDense,
1924: 0,
1925: 0,
1926: 0,
1927: 0,
1928: /*39*/ MatAXPY_SeqDense,
1929: MatGetSubMatrices_SeqDense,
1930: 0,
1931: MatGetValues_SeqDense,
1932: MatCopy_SeqDense,
1933: /*44*/ MatGetRowMax_SeqDense,
1934: MatScale_SeqDense,
1935: 0,
1936: 0,
1937: 0,
1938: /*49*/ 0,
1939: 0,
1940: 0,
1941: 0,
1942: 0,
1943: /*54*/ 0,
1944: 0,
1945: 0,
1946: 0,
1947: 0,
1948: /*59*/ 0,
1949: MatDestroy_SeqDense,
1950: MatView_SeqDense,
1951: 0,
1952: 0,
1953: /*64*/ 0,
1954: 0,
1955: 0,
1956: 0,
1957: 0,
1958: /*69*/ MatGetRowMaxAbs_SeqDense,
1959: 0,
1960: 0,
1961: 0,
1962: 0,
1963: /*74*/ 0,
1964: 0,
1965: 0,
1966: 0,
1967: 0,
1968: /*79*/ 0,
1969: 0,
1970: 0,
1971: 0,
1972: /*83*/ MatLoad_SeqDense,
1973: 0,
1974: MatIsHermitian_SeqDense,
1975: 0,
1976: 0,
1977: 0,
1978: /*89*/ MatMatMult_SeqDense_SeqDense,
1979: MatMatMultSymbolic_SeqDense_SeqDense,
1980: MatMatMultNumeric_SeqDense_SeqDense,
1981: 0,
1982: 0,
1983: /*94*/ 0,
1984: 0,
1985: 0,
1986: 0,
1987: 0,
1988: /*99*/ 0,
1989: 0,
1990: 0,
1991: MatConjugate_SeqDense,
1992: 0,
1993: /*104*/0,
1994: MatRealPart_SeqDense,
1995: MatImaginaryPart_SeqDense,
1996: 0,
1997: 0,
1998: /*109*/MatMatSolve_SeqDense,
1999: 0,
2000: MatGetRowMin_SeqDense,
2001: MatGetColumnVector_SeqDense,
2002: 0,
2003: /*114*/0,
2004: 0,
2005: 0,
2006: 0,
2007: 0,
2008: /*119*/0,
2009: 0,
2010: 0,
2011: 0,
2012: 0,
2013: /*124*/0,
2014: MatGetColumnNorms_SeqDense,
2015: 0,
2016: 0,
2017: 0,
2018: /*129*/0,
2019: MatTransposeMatMult_SeqDense_SeqDense,
2020: MatTransposeMatMultSymbolic_SeqDense_SeqDense,
2021: MatTransposeMatMultNumeric_SeqDense_SeqDense,
2022: };
2026: /*@C
2027: MatCreateSeqDense - Creates a sequential dense matrix that
2028: is stored in column major order (the usual Fortran 77 manner). Many
2029: of the matrix operations use the BLAS and LAPACK routines.
2031: Collective on MPI_Comm
2033: Input Parameters:
2034: + comm - MPI communicator, set to PETSC_COMM_SELF
2035: . m - number of rows
2036: . n - number of columns
2037: - data - optional location of matrix data in column major order. Set data=PETSC_NULL for PETSc
2038: to control all matrix memory allocation.
2040: Output Parameter:
2041: . A - the matrix
2043: Notes:
2044: The data input variable is intended primarily for Fortran programmers
2045: who wish to allocate their own matrix memory space. Most users should
2046: set data=PETSC_NULL.
2048: Level: intermediate
2050: .keywords: dense, matrix, LAPACK, BLAS
2052: .seealso: MatCreate(), MatCreateDense(), MatSetValues()
2053: @*/
2054: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2055: {
2059: MatCreate(comm,A);
2060: MatSetSizes(*A,m,n,m,n);
2061: MatSetType(*A,MATSEQDENSE);
2062: MatSeqDenseSetPreallocation(*A,data);
2063: return(0);
2064: }
2068: /*@C
2069: MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
2071: Collective on MPI_Comm
2073: Input Parameters:
2074: + A - the matrix
2075: - data - the array (or PETSC_NULL)
2077: Notes:
2078: The data input variable is intended primarily for Fortran programmers
2079: who wish to allocate their own matrix memory space. Most users should
2080: need not call this routine.
2082: Level: intermediate
2084: .keywords: dense, matrix, LAPACK, BLAS
2086: .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA()
2088: @*/
2089: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2090: {
2094: PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));
2095: return(0);
2096: }
2098: EXTERN_C_BEGIN
2101: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2102: {
2103: Mat_SeqDense *b;
2107: B->preallocated = PETSC_TRUE;
2109: PetscLayoutSetUp(B->rmap);
2110: PetscLayoutSetUp(B->cmap);
2112: b = (Mat_SeqDense*)B->data;
2113: b->Mmax = B->rmap->n;
2114: b->Nmax = B->cmap->n;
2115: if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;
2117: if (!data) { /* petsc-allocated storage */
2118: if (!b->user_alloc) { PetscFree(b->v); }
2119: PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
2120: PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
2121: PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
2122: b->user_alloc = PETSC_FALSE;
2123: } else { /* user-allocated storage */
2124: if (!b->user_alloc) { PetscFree(b->v); }
2125: b->v = data;
2126: b->user_alloc = PETSC_TRUE;
2127: }
2128: B->assembled = PETSC_TRUE;
2129: return(0);
2130: }
2131: EXTERN_C_END
2135: /*@C
2136: MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2138: Input parameter:
2139: + A - the matrix
2140: - lda - the leading dimension
2142: Notes:
2143: This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2144: it asserts that the preallocation has a leading dimension (the LDA parameter
2145: of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2147: Level: intermediate
2149: .keywords: dense, matrix, LAPACK, BLAS
2151: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2153: @*/
2154: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
2155: {
2156: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2159: 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);
2160: b->lda = lda;
2161: b->changelda = PETSC_FALSE;
2162: b->Mmax = PetscMax(b->Mmax,lda);
2163: return(0);
2164: }
2166: /*MC
2167: MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2169: Options Database Keys:
2170: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2172: Level: beginner
2174: .seealso: MatCreateSeqDense()
2176: M*/
2178: EXTERN_C_BEGIN
2181: PetscErrorCode MatCreate_SeqDense(Mat B)
2182: {
2183: Mat_SeqDense *b;
2185: PetscMPIInt size;
2188: MPI_Comm_size(((PetscObject)B)->comm,&size);
2189: if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2191: PetscNewLog(B,Mat_SeqDense,&b);
2192: PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2193: B->data = (void*)b;
2195: b->pivots = 0;
2196: b->roworiented = PETSC_TRUE;
2197: b->v = 0;
2198: b->changelda = PETSC_FALSE;
2201: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);
2202: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2203: "MatGetFactor_seqdense_petsc",
2204: MatGetFactor_seqdense_petsc);
2205: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2206: "MatSeqDenseSetPreallocation_SeqDense",
2207: MatSeqDenseSetPreallocation_SeqDense);
2209: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2210: "MatMatMult_SeqAIJ_SeqDense",
2211: MatMatMult_SeqAIJ_SeqDense);
2214: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2215: "MatMatMultSymbolic_SeqAIJ_SeqDense",
2216: MatMatMultSymbolic_SeqAIJ_SeqDense);
2217: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2218: "MatMatMultNumeric_SeqAIJ_SeqDense",
2219: MatMatMultNumeric_SeqAIJ_SeqDense);
2220: PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2221: return(0);
2222: }
2223: EXTERN_C_END