Actual source code: dense.c
2: /*
3: Defines the basic matrix operations for sequential dense.
4: */
6: #include <../src/mat/impls/dense/seq/dense.h>
7: #include <petscblaslapack.h>
11: PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str)
12: {
13: Mat_SeqDense *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
14: PetscScalar oalpha = alpha;
15: PetscInt j;
16: PetscBLASInt N,m,ldax,lday,one = 1;
20: N = PetscBLASIntCast(X->rmap->n*X->cmap->n);
21: m = PetscBLASIntCast(X->rmap->n);
22: ldax = PetscBLASIntCast(x->lda);
23: lday = PetscBLASIntCast(y->lda);
24: if (ldax>m || lday>m) {
25: for (j=0; j<X->cmap->n; j++) {
26: BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
27: }
28: } else {
29: BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
30: }
31: PetscLogFlops(PetscMax(2*N-1,0));
32: return(0);
33: }
37: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
38: {
39: PetscInt N = A->rmap->n*A->cmap->n;
42: info->block_size = 1.0;
43: info->nz_allocated = (double)N;
44: info->nz_used = (double)N;
45: info->nz_unneeded = (double)0;
46: info->assemblies = (double)A->num_ass;
47: info->mallocs = 0;
48: info->memory = ((PetscObject)A)->mem;
49: info->fill_ratio_given = 0;
50: info->fill_ratio_needed = 0;
51: info->factor_mallocs = 0;
52: return(0);
53: }
57: PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha)
58: {
59: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
60: PetscScalar oalpha = alpha;
62: PetscBLASInt one = 1,j,nz,lda = PetscBLASIntCast(a->lda);
65: if (lda>A->rmap->n) {
66: nz = PetscBLASIntCast(A->rmap->n);
67: for (j=0; j<A->cmap->n; j++) {
68: BLASscal_(&nz,&oalpha,a->v+j*lda,&one);
69: }
70: } else {
71: nz = PetscBLASIntCast(A->rmap->n*A->cmap->n);
72: BLASscal_(&nz,&oalpha,a->v,&one);
73: }
74: PetscLogFlops(nz);
75: return(0);
76: }
80: PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscBool *fl)
81: {
82: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
83: PetscInt i,j,m = A->rmap->n,N;
84: PetscScalar *v = a->v;
87: *fl = PETSC_FALSE;
88: if (A->rmap->n != A->cmap->n) return(0);
89: N = a->lda;
91: for (i=0; i<m; i++) {
92: for (j=i+1; j<m; j++) {
93: if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) return(0);
94: }
95: }
96: *fl = PETSC_TRUE;
97: return(0);
98: }
99:
102: PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
103: {
104: Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l;
106: PetscInt lda = (PetscInt)mat->lda,j,m;
109: PetscLayoutReference(A->rmap,&newi->rmap);
110: PetscLayoutReference(A->cmap,&newi->cmap);
111: MatSeqDenseSetPreallocation(newi,PETSC_NULL);
112: if (cpvalues == MAT_COPY_VALUES) {
113: l = (Mat_SeqDense*)newi->data;
114: if (lda>A->rmap->n) {
115: m = A->rmap->n;
116: for (j=0; j<A->cmap->n; j++) {
117: PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
118: }
119: } else {
120: PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
121: }
122: }
123: newi->assembled = PETSC_TRUE;
124: return(0);
125: }
129: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
130: {
134: MatCreate(((PetscObject)A)->comm,newmat);
135: MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
136: MatSetType(*newmat,((PetscObject)A)->type_name);
137: MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);
138: return(0);
139: }
146: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
147: {
148: MatFactorInfo info;
152: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
153: MatLUFactor_SeqDense(fact,0,0,&info);
154: return(0);
155: }
159: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
160: {
161: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
163: PetscScalar *x,*y;
164: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
165:
167: VecGetArray(xx,&x);
168: VecGetArray(yy,&y);
169: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
170: if (A->factortype == MAT_FACTOR_LU) {
171: #if defined(PETSC_MISSING_LAPACK_GETRS)
172: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
173: #else
174: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
175: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
176: #endif
177: } else if (A->factortype == MAT_FACTOR_CHOLESKY){
178: #if defined(PETSC_MISSING_LAPACK_POTRS)
179: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
180: #else
181: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
182: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
183: #endif
184: }
185: else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
186: VecRestoreArray(xx,&x);
187: VecRestoreArray(yy,&y);
188: PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
189: return(0);
190: }
194: PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X)
195: {
196: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
198: PetscScalar *b,*x;
199: PetscInt n;
200: PetscBLASInt nrhs,info,m=PetscBLASIntCast(A->rmap->n);
201: PetscBool flg;
204: PetscTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
205: if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
206: PetscTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
207: if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
209: MatGetSize(B,PETSC_NULL,&n);
210: nrhs = PetscBLASIntCast(n);
211: MatGetArray(B,&b);
212: MatGetArray(X,&x);
214: PetscMemcpy(x,b,m*sizeof(PetscScalar));
216: if (A->factortype == MAT_FACTOR_LU) {
217: #if defined(PETSC_MISSING_LAPACK_GETRS)
218: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
219: #else
220: LAPACKgetrs_("N",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info);
221: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
222: #endif
223: } else if (A->factortype == MAT_FACTOR_CHOLESKY){
224: #if defined(PETSC_MISSING_LAPACK_POTRS)
225: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
226: #else
227: LAPACKpotrs_("L",&m,&nrhs,mat->v,&mat->lda,x,&m,&info);
228: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
229: #endif
230: }
231: else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
233: MatRestoreArray(B,&b);
234: MatRestoreArray(X,&x);
235: PetscLogFlops(nrhs*(2.0*m*m - m));
236: return(0);
237: }
241: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
242: {
243: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
245: PetscScalar *x,*y;
246: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
247:
249: VecGetArray(xx,&x);
250: VecGetArray(yy,&y);
251: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
252: /* assume if pivots exist then use LU; else Cholesky */
253: if (mat->pivots) {
254: #if defined(PETSC_MISSING_LAPACK_GETRS)
255: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
256: #else
257: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
258: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
259: #endif
260: } else {
261: #if defined(PETSC_MISSING_LAPACK_POTRS)
262: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
263: #else
264: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
265: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
266: #endif
267: }
268: VecRestoreArray(xx,&x);
269: VecRestoreArray(yy,&y);
270: PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
271: return(0);
272: }
276: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
277: {
278: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
280: PetscScalar *x,*y,sone = 1.0;
281: Vec tmp = 0;
282: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
283:
285: VecGetArray(xx,&x);
286: VecGetArray(yy,&y);
287: if (!A->rmap->n || !A->cmap->n) return(0);
288: if (yy == zz) {
289: VecDuplicate(yy,&tmp);
290: PetscLogObjectParent(A,tmp);
291: VecCopy(yy,tmp);
292: }
293: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
294: /* assume if pivots exist then use LU; else Cholesky */
295: if (mat->pivots) {
296: #if defined(PETSC_MISSING_LAPACK_GETRS)
297: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
298: #else
299: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
300: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
301: #endif
302: } else {
303: #if defined(PETSC_MISSING_LAPACK_POTRS)
304: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
305: #else
306: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
307: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
308: #endif
309: }
310: if (tmp) {
311: VecAXPY(yy,sone,tmp);
312: VecDestroy(&tmp);
313: } else {
314: VecAXPY(yy,sone,zz);
315: }
316: VecRestoreArray(xx,&x);
317: VecRestoreArray(yy,&y);
318: PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
319: return(0);
320: }
324: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
325: {
326: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
328: PetscScalar *x,*y,sone = 1.0;
329: Vec tmp;
330: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
331:
333: if (!A->rmap->n || !A->cmap->n) return(0);
334: VecGetArray(xx,&x);
335: VecGetArray(yy,&y);
336: if (yy == zz) {
337: VecDuplicate(yy,&tmp);
338: PetscLogObjectParent(A,tmp);
339: VecCopy(yy,tmp);
340: }
341: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
342: /* assume if pivots exist then use LU; else Cholesky */
343: if (mat->pivots) {
344: #if defined(PETSC_MISSING_LAPACK_GETRS)
345: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
346: #else
347: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
348: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
349: #endif
350: } else {
351: #if defined(PETSC_MISSING_LAPACK_POTRS)
352: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
353: #else
354: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
355: if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
356: #endif
357: }
358: if (tmp) {
359: VecAXPY(yy,sone,tmp);
360: VecDestroy(&tmp);
361: } else {
362: VecAXPY(yy,sone,zz);
363: }
364: VecRestoreArray(xx,&x);
365: VecRestoreArray(yy,&y);
366: PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
367: return(0);
368: }
370: /* ---------------------------------------------------------------*/
371: /* COMMENT: I have chosen to hide row permutation in the pivots,
372: rather than put it in the Mat->row slot.*/
375: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
376: {
377: #if defined(PETSC_MISSING_LAPACK_GETRF)
379: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
380: #else
381: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
383: PetscBLASInt n,m,info;
386: n = PetscBLASIntCast(A->cmap->n);
387: m = PetscBLASIntCast(A->rmap->n);
388: if (!mat->pivots) {
389: PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
390: PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
391: }
392: if (!A->rmap->n || !A->cmap->n) return(0);
393: LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
394: if (info<0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to LU factorization");
395: if (info>0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
396: A->ops->solve = MatSolve_SeqDense;
397: A->ops->solvetranspose = MatSolveTranspose_SeqDense;
398: A->ops->solveadd = MatSolveAdd_SeqDense;
399: A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
400: A->factortype = MAT_FACTOR_LU;
402: PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);
403: #endif
404: return(0);
405: }
409: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
410: {
411: #if defined(PETSC_MISSING_LAPACK_POTRF)
413: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
414: #else
415: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
417: PetscBLASInt info,n = PetscBLASIntCast(A->cmap->n);
418:
420: PetscFree(mat->pivots);
422: if (!A->rmap->n || !A->cmap->n) return(0);
423: LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
424: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
425: A->ops->solve = MatSolve_SeqDense;
426: A->ops->solvetranspose = MatSolveTranspose_SeqDense;
427: A->ops->solveadd = MatSolveAdd_SeqDense;
428: A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
429: A->factortype = MAT_FACTOR_CHOLESKY;
430: PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);
431: #endif
432: return(0);
433: }
438: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
439: {
441: MatFactorInfo info;
444: info.fill = 1.0;
445: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
446: MatCholeskyFactor_SeqDense(fact,0,&info);
447: return(0);
448: }
452: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
453: {
455: fact->assembled = PETSC_TRUE;
456: fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
457: return(0);
458: }
462: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
463: {
465: fact->assembled = PETSC_TRUE;
466: fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
467: return(0);
468: }
473: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
474: {
478: MatCreate(((PetscObject)A)->comm,fact);
479: MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
480: MatSetType(*fact,((PetscObject)A)->type_name);
481: if (ftype == MAT_FACTOR_LU){
482: (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
483: } else {
484: (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
485: }
486: (*fact)->factortype = ftype;
487: return(0);
488: }
491: /* ------------------------------------------------------------------*/
494: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
495: {
496: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
497: PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt;
499: PetscInt m = A->rmap->n,i;
500: #if !defined(PETSC_USE_COMPLEX)
501: PetscBLASInt o = 1,bm = PetscBLASIntCast(m);
502: #endif
505: if (flag & SOR_ZERO_INITIAL_GUESS) {
506: /* this is a hack fix, should have another version without the second BLASdot */
507: VecSet(xx,zero);
508: }
509: VecGetArray(xx,&x);
510: VecGetArray(bb,&b);
511: its = its*lits;
512: if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
513: while (its--) {
514: if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
515: for (i=0; i<m; i++) {
516: #if defined(PETSC_USE_COMPLEX)
517: /* cannot use BLAS dot for complex because compiler/linker is
518: not happy about returning a double complex */
519: PetscInt _i;
520: PetscScalar sum = b[i];
521: for (_i=0; _i<m; _i++) {
522: sum -= PetscConj(v[i+_i*m])*x[_i];
523: }
524: xt = sum;
525: #else
526: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
527: #endif
528: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
529: }
530: }
531: if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
532: for (i=m-1; i>=0; i--) {
533: #if defined(PETSC_USE_COMPLEX)
534: /* cannot use BLAS dot for complex because compiler/linker is
535: not happy about returning a double complex */
536: PetscInt _i;
537: PetscScalar sum = b[i];
538: for (_i=0; _i<m; _i++) {
539: sum -= PetscConj(v[i+_i*m])*x[_i];
540: }
541: xt = sum;
542: #else
543: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
544: #endif
545: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
546: }
547: }
548: }
549: VecRestoreArray(bb,&b);
550: VecRestoreArray(xx,&x);
551: return(0);
552: }
554: /* -----------------------------------------------------------------*/
557: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
558: {
559: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
560: PetscScalar *v = mat->v,*x,*y;
562: PetscBLASInt m, n,_One=1;
563: PetscScalar _DOne=1.0,_DZero=0.0;
566: m = PetscBLASIntCast(A->rmap->n);
567: n = PetscBLASIntCast(A->cmap->n);
568: if (!A->rmap->n || !A->cmap->n) return(0);
569: VecGetArray(xx,&x);
570: VecGetArray(yy,&y);
571: BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
572: VecRestoreArray(xx,&x);
573: VecRestoreArray(yy,&y);
574: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);
575: return(0);
576: }
580: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
581: {
582: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
583: PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
585: PetscBLASInt m, n, _One=1;
588: m = PetscBLASIntCast(A->rmap->n);
589: n = PetscBLASIntCast(A->cmap->n);
590: if (!A->rmap->n || !A->cmap->n) return(0);
591: VecGetArray(xx,&x);
592: VecGetArray(yy,&y);
593: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
594: VecRestoreArray(xx,&x);
595: VecRestoreArray(yy,&y);
596: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);
597: return(0);
598: }
602: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
603: {
604: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
605: PetscScalar *v = mat->v,*x,*y,_DOne=1.0;
607: PetscBLASInt m, n, _One=1;
610: m = PetscBLASIntCast(A->rmap->n);
611: n = PetscBLASIntCast(A->cmap->n);
612: if (!A->rmap->n || !A->cmap->n) return(0);
613: if (zz != yy) {VecCopy(zz,yy);}
614: VecGetArray(xx,&x);
615: VecGetArray(yy,&y);
616: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
617: VecRestoreArray(xx,&x);
618: VecRestoreArray(yy,&y);
619: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
620: return(0);
621: }
625: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
626: {
627: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
628: PetscScalar *v = mat->v,*x,*y;
630: PetscBLASInt m, n, _One=1;
631: PetscScalar _DOne=1.0;
634: m = PetscBLASIntCast(A->rmap->n);
635: n = PetscBLASIntCast(A->cmap->n);
636: if (!A->rmap->n || !A->cmap->n) return(0);
637: if (zz != yy) {VecCopy(zz,yy);}
638: VecGetArray(xx,&x);
639: VecGetArray(yy,&y);
640: BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
641: VecRestoreArray(xx,&x);
642: VecRestoreArray(yy,&y);
643: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
644: return(0);
645: }
647: /* -----------------------------------------------------------------*/
650: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
651: {
652: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
653: PetscScalar *v;
655: PetscInt i;
656:
658: *ncols = A->cmap->n;
659: if (cols) {
660: PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
661: for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
662: }
663: if (vals) {
664: PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
665: v = mat->v + row;
666: for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
667: }
668: return(0);
669: }
673: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
674: {
677: if (cols) {PetscFree(*cols);}
678: if (vals) {PetscFree(*vals); }
679: return(0);
680: }
681: /* ----------------------------------------------------------------*/
684: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
685: {
686: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
687: PetscInt i,j,idx=0;
688:
691: if (!mat->roworiented) {
692: if (addv == INSERT_VALUES) {
693: for (j=0; j<n; j++) {
694: if (indexn[j] < 0) {idx += m; continue;}
695: #if defined(PETSC_USE_DEBUG)
696: 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);
697: #endif
698: for (i=0; i<m; i++) {
699: if (indexm[i] < 0) {idx++; continue;}
700: #if defined(PETSC_USE_DEBUG)
701: 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);
702: #endif
703: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
704: }
705: }
706: } else {
707: for (j=0; j<n; j++) {
708: if (indexn[j] < 0) {idx += m; continue;}
709: #if defined(PETSC_USE_DEBUG)
710: 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);
711: #endif
712: for (i=0; i<m; i++) {
713: if (indexm[i] < 0) {idx++; continue;}
714: #if defined(PETSC_USE_DEBUG)
715: 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);
716: #endif
717: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
718: }
719: }
720: }
721: } else {
722: if (addv == INSERT_VALUES) {
723: for (i=0; i<m; i++) {
724: if (indexm[i] < 0) { idx += n; continue;}
725: #if defined(PETSC_USE_DEBUG)
726: 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);
727: #endif
728: for (j=0; j<n; j++) {
729: if (indexn[j] < 0) { idx++; continue;}
730: #if defined(PETSC_USE_DEBUG)
731: 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);
732: #endif
733: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
734: }
735: }
736: } else {
737: for (i=0; i<m; i++) {
738: if (indexm[i] < 0) { idx += n; continue;}
739: #if defined(PETSC_USE_DEBUG)
740: 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);
741: #endif
742: for (j=0; j<n; j++) {
743: if (indexn[j] < 0) { idx++; continue;}
744: #if defined(PETSC_USE_DEBUG)
745: 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);
746: #endif
747: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
748: }
749: }
750: }
751: }
752: return(0);
753: }
757: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
758: {
759: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
760: PetscInt i,j;
763: /* row-oriented output */
764: for (i=0; i<m; i++) {
765: if (indexm[i] < 0) {v += n;continue;}
766: 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);
767: for (j=0; j<n; j++) {
768: if (indexn[j] < 0) {v++; continue;}
769: 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);
770: *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
771: }
772: }
773: return(0);
774: }
776: /* -----------------------------------------------------------------*/
780: PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
781: {
782: Mat_SeqDense *a;
784: PetscInt *scols,i,j,nz,header[4];
785: int fd;
786: PetscMPIInt size;
787: PetscInt *rowlengths = 0,M,N,*cols,grows,gcols;
788: PetscScalar *vals,*svals,*v,*w;
789: MPI_Comm comm = ((PetscObject)viewer)->comm;
792: MPI_Comm_size(comm,&size);
793: if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
794: PetscViewerBinaryGetDescriptor(viewer,&fd);
795: PetscBinaryRead(fd,header,4,PETSC_INT);
796: if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
797: M = header[1]; N = header[2]; nz = header[3];
799: /* set global size if not set already*/
800: if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
801: MatSetSizes(newmat,M,N,M,N);
802: } else {
803: /* if sizes and type are already set, check if the vector global sizes are correct */
804: MatGetSize(newmat,&grows,&gcols);
805: 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);
806: }
807: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
808:
809: if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
810: a = (Mat_SeqDense*)newmat->data;
811: v = a->v;
812: /* Allocate some temp space to read in the values and then flip them
813: from row major to column major */
814: PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
815: /* read in nonzero values */
816: PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
817: /* now flip the values and store them in the matrix*/
818: for (j=0; j<N; j++) {
819: for (i=0; i<M; i++) {
820: *v++ =w[i*N+j];
821: }
822: }
823: PetscFree(w);
824: } else {
825: /* read row lengths */
826: PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
827: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
829: a = (Mat_SeqDense*)newmat->data;
830: v = a->v;
832: /* read column indices and nonzeros */
833: PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
834: cols = scols;
835: PetscBinaryRead(fd,cols,nz,PETSC_INT);
836: PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
837: vals = svals;
838: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
840: /* insert into matrix */
841: for (i=0; i<M; i++) {
842: for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
843: svals += rowlengths[i]; scols += rowlengths[i];
844: }
845: PetscFree(vals);
846: PetscFree(cols);
847: PetscFree(rowlengths);
848: }
849: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
850: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
852: return(0);
853: }
857: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
858: {
859: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
860: PetscErrorCode ierr;
861: PetscInt i,j;
862: const char *name;
863: PetscScalar *v;
864: PetscViewerFormat format;
865: #if defined(PETSC_USE_COMPLEX)
866: PetscBool allreal = PETSC_TRUE;
867: #endif
870: PetscViewerGetFormat(viewer,&format);
871: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
872: return(0); /* do nothing for now */
873: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
874: PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
875: PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
876: for (i=0; i<A->rmap->n; i++) {
877: v = a->v + i;
878: PetscViewerASCIIPrintf(viewer,"row %D:",i);
879: for (j=0; j<A->cmap->n; j++) {
880: #if defined(PETSC_USE_COMPLEX)
881: if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
882: PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
883: } else if (PetscRealPart(*v)) {
884: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
885: }
886: #else
887: if (*v) {
888: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
889: }
890: #endif
891: v += a->lda;
892: }
893: PetscViewerASCIIPrintf(viewer,"\n");
894: }
895: PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
896: } else {
897: PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
898: #if defined(PETSC_USE_COMPLEX)
899: /* determine if matrix has all real values */
900: v = a->v;
901: for (i=0; i<A->rmap->n*A->cmap->n; i++) {
902: if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
903: }
904: #endif
905: if (format == PETSC_VIEWER_ASCII_MATLAB) {
906: PetscObjectGetName((PetscObject)A,&name);
907: PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
908: PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
909: PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
910: } else {
911: PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
912: }
914: for (i=0; i<A->rmap->n; i++) {
915: v = a->v + i;
916: for (j=0; j<A->cmap->n; j++) {
917: #if defined(PETSC_USE_COMPLEX)
918: if (allreal) {
919: PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
920: } else {
921: PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
922: }
923: #else
924: PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
925: #endif
926: v += a->lda;
927: }
928: PetscViewerASCIIPrintf(viewer,"\n");
929: }
930: if (format == PETSC_VIEWER_ASCII_MATLAB) {
931: PetscViewerASCIIPrintf(viewer,"];\n");
932: }
933: PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
934: }
935: PetscViewerFlush(viewer);
936: return(0);
937: }
941: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
942: {
943: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
944: PetscErrorCode ierr;
945: int fd;
946: PetscInt ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
947: PetscScalar *v,*anonz,*vals;
948: PetscViewerFormat format;
949:
951: PetscViewerBinaryGetDescriptor(viewer,&fd);
953: PetscViewerGetFormat(viewer,&format);
954: if (format == PETSC_VIEWER_NATIVE) {
955: /* store the matrix as a dense matrix */
956: PetscMalloc(4*sizeof(PetscInt),&col_lens);
957: col_lens[0] = MAT_FILE_CLASSID;
958: col_lens[1] = m;
959: col_lens[2] = n;
960: col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
961: PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
962: PetscFree(col_lens);
964: /* write out matrix, by rows */
965: PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
966: v = a->v;
967: for (j=0; j<n; j++) {
968: for (i=0; i<m; i++) {
969: vals[j + i*n] = *v++;
970: }
971: }
972: PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
973: PetscFree(vals);
974: } else {
975: PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
976: col_lens[0] = MAT_FILE_CLASSID;
977: col_lens[1] = m;
978: col_lens[2] = n;
979: col_lens[3] = nz;
981: /* store lengths of each row and write (including header) to file */
982: for (i=0; i<m; i++) col_lens[4+i] = n;
983: PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);
985: /* Possibly should write in smaller increments, not whole matrix at once? */
986: /* store column indices (zero start index) */
987: ict = 0;
988: for (i=0; i<m; i++) {
989: for (j=0; j<n; j++) col_lens[ict++] = j;
990: }
991: PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
992: PetscFree(col_lens);
994: /* store nonzero values */
995: PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
996: ict = 0;
997: for (i=0; i<m; i++) {
998: v = a->v + i;
999: for (j=0; j<n; j++) {
1000: anonz[ict++] = *v; v += a->lda;
1001: }
1002: }
1003: PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
1004: PetscFree(anonz);
1005: }
1006: return(0);
1007: }
1011: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1012: {
1013: Mat A = (Mat) Aa;
1014: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1015: PetscErrorCode ierr;
1016: PetscInt m = A->rmap->n,n = A->cmap->n,color,i,j;
1017: PetscScalar *v = a->v;
1018: PetscViewer viewer;
1019: PetscDraw popup;
1020: PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1021: PetscViewerFormat format;
1025: PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
1026: PetscViewerGetFormat(viewer,&format);
1027: PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);
1029: /* Loop over matrix elements drawing boxes */
1030: if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1031: /* Blue for negative and Red for positive */
1032: color = PETSC_DRAW_BLUE;
1033: for(j = 0; j < n; j++) {
1034: x_l = j;
1035: x_r = x_l + 1.0;
1036: for(i = 0; i < m; i++) {
1037: y_l = m - i - 1.0;
1038: y_r = y_l + 1.0;
1039: #if defined(PETSC_USE_COMPLEX)
1040: if (PetscRealPart(v[j*m+i]) > 0.) {
1041: color = PETSC_DRAW_RED;
1042: } else if (PetscRealPart(v[j*m+i]) < 0.) {
1043: color = PETSC_DRAW_BLUE;
1044: } else {
1045: continue;
1046: }
1047: #else
1048: if (v[j*m+i] > 0.) {
1049: color = PETSC_DRAW_RED;
1050: } else if (v[j*m+i] < 0.) {
1051: color = PETSC_DRAW_BLUE;
1052: } else {
1053: continue;
1054: }
1055: #endif
1056: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1057: }
1058: }
1059: } else {
1060: /* use contour shading to indicate magnitude of values */
1061: /* first determine max of all nonzero values */
1062: for(i = 0; i < m*n; i++) {
1063: if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1064: }
1065: scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1066: PetscDrawGetPopup(draw,&popup);
1067: if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1068: for(j = 0; j < n; j++) {
1069: x_l = j;
1070: x_r = x_l + 1.0;
1071: for(i = 0; i < m; i++) {
1072: y_l = m - i - 1.0;
1073: y_r = y_l + 1.0;
1074: color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1075: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1076: }
1077: }
1078: }
1079: return(0);
1080: }
1084: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1085: {
1086: PetscDraw draw;
1087: PetscBool isnull;
1088: PetscReal xr,yr,xl,yl,h,w;
1092: PetscViewerDrawGetDraw(viewer,0,&draw);
1093: PetscDrawIsNull(draw,&isnull);
1094: if (isnull) return(0);
1096: PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1097: xr = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1098: xr += w; yr += h; xl = -w; yl = -h;
1099: PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1100: PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1101: PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1102: return(0);
1103: }
1107: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1108: {
1110: PetscBool iascii,isbinary,isdraw;
1113: PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
1114: PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
1115: PetscTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);
1117: if (iascii) {
1118: MatView_SeqDense_ASCII(A,viewer);
1119: } else if (isbinary) {
1120: MatView_SeqDense_Binary(A,viewer);
1121: } else if (isdraw) {
1122: MatView_SeqDense_Draw(A,viewer);
1123: } else {
1124: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1125: }
1126: return(0);
1127: }
1131: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1132: {
1133: Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1137: #if defined(PETSC_USE_LOG)
1138: PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1139: #endif
1140: PetscFree(l->pivots);
1141: if (!l->user_alloc) {PetscFree(l->v);}
1142: PetscFree(mat->data);
1144: PetscObjectChangeTypeName((PetscObject)mat,0);
1145: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1146: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1147: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1148: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1149: return(0);
1150: }
1154: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1155: {
1156: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1158: PetscInt k,j,m,n,M;
1159: PetscScalar *v,tmp;
1162: v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1163: if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1164: if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1165: else {
1166: for (j=0; j<m; j++) {
1167: for (k=0; k<j; k++) {
1168: tmp = v[j + k*M];
1169: v[j + k*M] = v[k + j*M];
1170: v[k + j*M] = tmp;
1171: }
1172: }
1173: }
1174: } else { /* out-of-place transpose */
1175: Mat tmat;
1176: Mat_SeqDense *tmatd;
1177: PetscScalar *v2;
1179: if (reuse == MAT_INITIAL_MATRIX) {
1180: MatCreate(((PetscObject)A)->comm,&tmat);
1181: MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1182: MatSetType(tmat,((PetscObject)A)->type_name);
1183: MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1184: } else {
1185: tmat = *matout;
1186: }
1187: tmatd = (Mat_SeqDense*)tmat->data;
1188: v = mat->v; v2 = tmatd->v;
1189: for (j=0; j<n; j++) {
1190: for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1191: }
1192: MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1193: MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1194: *matout = tmat;
1195: }
1196: return(0);
1197: }
1201: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool *flg)
1202: {
1203: Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1204: Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1205: PetscInt i,j;
1206: PetscScalar *v1 = mat1->v,*v2 = mat2->v;
1209: if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1210: if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1211: for (i=0; i<A1->rmap->n; i++) {
1212: v1 = mat1->v+i; v2 = mat2->v+i;
1213: for (j=0; j<A1->cmap->n; j++) {
1214: if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1215: v1 += mat1->lda; v2 += mat2->lda;
1216: }
1217: }
1218: *flg = PETSC_TRUE;
1219: return(0);
1220: }
1224: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1225: {
1226: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1228: PetscInt i,n,len;
1229: PetscScalar *x,zero = 0.0;
1232: VecSet(v,zero);
1233: VecGetSize(v,&n);
1234: VecGetArray(v,&x);
1235: len = PetscMin(A->rmap->n,A->cmap->n);
1236: if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1237: for (i=0; i<len; i++) {
1238: x[i] = mat->v[i*mat->lda + i];
1239: }
1240: VecRestoreArray(v,&x);
1241: return(0);
1242: }
1246: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1247: {
1248: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1249: PetscScalar *l,*r,x,*v;
1251: PetscInt i,j,m = A->rmap->n,n = A->cmap->n;
1254: if (ll) {
1255: VecGetSize(ll,&m);
1256: VecGetArray(ll,&l);
1257: if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1258: for (i=0; i<m; i++) {
1259: x = l[i];
1260: v = mat->v + i;
1261: for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1262: }
1263: VecRestoreArray(ll,&l);
1264: PetscLogFlops(n*m);
1265: }
1266: if (rr) {
1267: VecGetSize(rr,&n);
1268: VecGetArray(rr,&r);
1269: if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1270: for (i=0; i<n; i++) {
1271: x = r[i];
1272: v = mat->v + i*m;
1273: for (j=0; j<m; j++) { (*v++) *= x;}
1274: }
1275: VecRestoreArray(rr,&r);
1276: PetscLogFlops(n*m);
1277: }
1278: return(0);
1279: }
1283: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1284: {
1285: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1286: PetscScalar *v = mat->v;
1287: PetscReal sum = 0.0;
1288: PetscInt lda=mat->lda,m=A->rmap->n,i,j;
1292: if (type == NORM_FROBENIUS) {
1293: if (lda>m) {
1294: for (j=0; j<A->cmap->n; j++) {
1295: v = mat->v+j*lda;
1296: for (i=0; i<m; i++) {
1297: #if defined(PETSC_USE_COMPLEX)
1298: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1299: #else
1300: sum += (*v)*(*v); v++;
1301: #endif
1302: }
1303: }
1304: } else {
1305: for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1306: #if defined(PETSC_USE_COMPLEX)
1307: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1308: #else
1309: sum += (*v)*(*v); v++;
1310: #endif
1311: }
1312: }
1313: *nrm = PetscSqrtReal(sum);
1314: PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1315: } else if (type == NORM_1) {
1316: *nrm = 0.0;
1317: for (j=0; j<A->cmap->n; j++) {
1318: v = mat->v + j*mat->lda;
1319: sum = 0.0;
1320: for (i=0; i<A->rmap->n; i++) {
1321: sum += PetscAbsScalar(*v); v++;
1322: }
1323: if (sum > *nrm) *nrm = sum;
1324: }
1325: PetscLogFlops(A->cmap->n*A->rmap->n);
1326: } else if (type == NORM_INFINITY) {
1327: *nrm = 0.0;
1328: for (j=0; j<A->rmap->n; j++) {
1329: v = mat->v + j;
1330: sum = 0.0;
1331: for (i=0; i<A->cmap->n; i++) {
1332: sum += PetscAbsScalar(*v); v += mat->lda;
1333: }
1334: if (sum > *nrm) *nrm = sum;
1335: }
1336: PetscLogFlops(A->cmap->n*A->rmap->n);
1337: } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1338: return(0);
1339: }
1343: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool flg)
1344: {
1345: Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1347:
1349: switch (op) {
1350: case MAT_ROW_ORIENTED:
1351: aij->roworiented = flg;
1352: break;
1353: case MAT_NEW_NONZERO_LOCATIONS:
1354: case MAT_NEW_NONZERO_LOCATION_ERR:
1355: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1356: case MAT_NEW_DIAGONALS:
1357: case MAT_KEEP_NONZERO_PATTERN:
1358: case MAT_IGNORE_OFF_PROC_ENTRIES:
1359: case MAT_USE_HASH_TABLE:
1360: case MAT_SYMMETRIC:
1361: case MAT_STRUCTURALLY_SYMMETRIC:
1362: case MAT_HERMITIAN:
1363: case MAT_SYMMETRY_ETERNAL:
1364: case MAT_IGNORE_LOWER_TRIANGULAR:
1365: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1366: break;
1367: default:
1368: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1369: }
1370: return(0);
1371: }
1375: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1376: {
1377: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1379: PetscInt lda=l->lda,m=A->rmap->n,j;
1382: if (lda>m) {
1383: for (j=0; j<A->cmap->n; j++) {
1384: PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1385: }
1386: } else {
1387: PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1388: }
1389: return(0);
1390: }
1394: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1395: {
1396: PetscErrorCode ierr;
1397: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1398: PetscInt m = l->lda, n = A->cmap->n, i,j;
1399: PetscScalar *slot,*bb;
1400: const PetscScalar *xx;
1403: #if defined(PETSC_USE_DEBUG)
1404: for (i=0; i<N; i++) {
1405: if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1406: 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);
1407: }
1408: #endif
1410: /* fix right hand side if needed */
1411: if (x && b) {
1412: VecGetArrayRead(x,&xx);
1413: VecGetArray(b,&bb);
1414: for (i=0; i<N; i++) {
1415: bb[rows[i]] = diag*xx[rows[i]];
1416: }
1417: VecRestoreArrayRead(x,&xx);
1418: VecRestoreArray(b,&bb);
1419: }
1421: for (i=0; i<N; i++) {
1422: slot = l->v + rows[i];
1423: for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1424: }
1425: if (diag != 0.0) {
1426: if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1427: for (i=0; i<N; i++) {
1428: slot = l->v + (m+1)*rows[i];
1429: *slot = diag;
1430: }
1431: }
1432: return(0);
1433: }
1437: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1438: {
1439: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1442: 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");
1443: *array = mat->v;
1444: return(0);
1445: }
1449: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1450: {
1452: *array = 0; /* user cannot accidently use the array later */
1453: return(0);
1454: }
1458: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1459: {
1460: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1462: PetscInt i,j,nrows,ncols;
1463: const PetscInt *irow,*icol;
1464: PetscScalar *av,*bv,*v = mat->v;
1465: Mat newmat;
1468: ISGetIndices(isrow,&irow);
1469: ISGetIndices(iscol,&icol);
1470: ISGetLocalSize(isrow,&nrows);
1471: ISGetLocalSize(iscol,&ncols);
1472:
1473: /* Check submatrixcall */
1474: if (scall == MAT_REUSE_MATRIX) {
1475: PetscInt n_cols,n_rows;
1476: MatGetSize(*B,&n_rows,&n_cols);
1477: if (n_rows != nrows || n_cols != ncols) {
1478: /* resize the result matrix to match number of requested rows/columns */
1479: MatSetSizes(*B,nrows,ncols,nrows,ncols);
1480: }
1481: newmat = *B;
1482: } else {
1483: /* Create and fill new matrix */
1484: MatCreate(((PetscObject)A)->comm,&newmat);
1485: MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1486: MatSetType(newmat,((PetscObject)A)->type_name);
1487: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1488: }
1490: /* Now extract the data pointers and do the copy,column at a time */
1491: bv = ((Mat_SeqDense*)newmat->data)->v;
1492:
1493: for (i=0; i<ncols; i++) {
1494: av = v + mat->lda*icol[i];
1495: for (j=0; j<nrows; j++) {
1496: *bv++ = av[irow[j]];
1497: }
1498: }
1500: /* Assemble the matrices so that the correct flags are set */
1501: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1502: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
1504: /* Free work space */
1505: ISRestoreIndices(isrow,&irow);
1506: ISRestoreIndices(iscol,&icol);
1507: *B = newmat;
1508: return(0);
1509: }
1513: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1514: {
1516: PetscInt i;
1519: if (scall == MAT_INITIAL_MATRIX) {
1520: PetscMalloc((n+1)*sizeof(Mat),B);
1521: }
1523: for (i=0; i<n; i++) {
1524: MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1525: }
1526: return(0);
1527: }
1531: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1532: {
1534: return(0);
1535: }
1539: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1540: {
1542: return(0);
1543: }
1547: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1548: {
1549: Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1551: PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1554: /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1555: if (A->ops->copy != B->ops->copy) {
1556: MatCopy_Basic(A,B,str);
1557: return(0);
1558: }
1559: if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1560: if (lda1>m || lda2>m) {
1561: for (j=0; j<n; j++) {
1562: PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1563: }
1564: } else {
1565: PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1566: }
1567: return(0);
1568: }
1572: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1573: {
1577: MatSeqDenseSetPreallocation(A,0);
1578: return(0);
1579: }
1583: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1584: {
1586: /* this will not be called before lda, Mmax, and Nmax have been set */
1587: m = PetscMax(m,M);
1588: n = PetscMax(n,N);
1590: /* 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);
1591: 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);
1592: */
1593: A->rmap->n = A->rmap->N = m;
1594: A->cmap->n = A->cmap->N = n;
1595: return(0);
1596: }
1600: static PetscErrorCode MatConjugate_SeqDense(Mat A)
1601: {
1602: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1603: PetscInt i,nz = A->rmap->n*A->cmap->n;
1604: PetscScalar *aa = a->v;
1607: for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1608: return(0);
1609: }
1613: static PetscErrorCode MatRealPart_SeqDense(Mat A)
1614: {
1615: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1616: PetscInt i,nz = A->rmap->n*A->cmap->n;
1617: PetscScalar *aa = a->v;
1620: for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1621: return(0);
1622: }
1626: static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1627: {
1628: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1629: PetscInt i,nz = A->rmap->n*A->cmap->n;
1630: PetscScalar *aa = a->v;
1633: for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1634: return(0);
1635: }
1637: /* ----------------------------------------------------------------*/
1640: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1641: {
1645: if (scall == MAT_INITIAL_MATRIX){
1646: MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1647: }
1648: MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1649: return(0);
1650: }
1654: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1655: {
1657: PetscInt m=A->rmap->n,n=B->cmap->n;
1658: Mat Cmat;
1661: 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);
1662: MatCreate(PETSC_COMM_SELF,&Cmat);
1663: MatSetSizes(Cmat,m,n,m,n);
1664: MatSetType(Cmat,MATSEQDENSE);
1665: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1666: Cmat->assembled = PETSC_TRUE;
1667: *C = Cmat;
1668: return(0);
1669: }
1673: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1674: {
1675: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1676: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1677: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1678: PetscBLASInt m,n,k;
1679: PetscScalar _DOne=1.0,_DZero=0.0;
1682: m = PetscBLASIntCast(A->rmap->n);
1683: n = PetscBLASIntCast(B->cmap->n);
1684: k = PetscBLASIntCast(A->cmap->n);
1685: BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1686: return(0);
1687: }
1691: PetscErrorCode MatMatMultTranspose_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1692: {
1696: if (scall == MAT_INITIAL_MATRIX){
1697: MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1698: }
1699: MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1700: return(0);
1701: }
1705: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1706: {
1708: PetscInt m=A->cmap->n,n=B->cmap->n;
1709: Mat Cmat;
1712: 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);
1713: MatCreate(PETSC_COMM_SELF,&Cmat);
1714: MatSetSizes(Cmat,m,n,m,n);
1715: MatSetType(Cmat,MATSEQDENSE);
1716: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1717: Cmat->assembled = PETSC_TRUE;
1718: *C = Cmat;
1719: return(0);
1720: }
1724: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1725: {
1726: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1727: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1728: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1729: PetscBLASInt m,n,k;
1730: PetscScalar _DOne=1.0,_DZero=0.0;
1733: m = PetscBLASIntCast(A->cmap->n);
1734: n = PetscBLASIntCast(B->cmap->n);
1735: k = PetscBLASIntCast(A->rmap->n);
1736: /*
1737: Note the m and n arguments below are the number rows and columns of A', not A!
1738: */
1739: BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1740: return(0);
1741: }
1745: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1746: {
1747: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1749: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1750: PetscScalar *x;
1751: MatScalar *aa = a->v;
1754: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1756: VecSet(v,0.0);
1757: VecGetArray(v,&x);
1758: VecGetLocalSize(v,&p);
1759: if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1760: for (i=0; i<m; i++) {
1761: x[i] = aa[i]; if (idx) idx[i] = 0;
1762: for (j=1; j<n; j++){
1763: if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1764: }
1765: }
1766: VecRestoreArray(v,&x);
1767: return(0);
1768: }
1772: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1773: {
1774: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1776: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1777: PetscScalar *x;
1778: PetscReal atmp;
1779: MatScalar *aa = a->v;
1782: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1784: VecSet(v,0.0);
1785: VecGetArray(v,&x);
1786: VecGetLocalSize(v,&p);
1787: if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1788: for (i=0; i<m; i++) {
1789: x[i] = PetscAbsScalar(aa[i]);
1790: for (j=1; j<n; j++){
1791: atmp = PetscAbsScalar(aa[i+m*j]);
1792: if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1793: }
1794: }
1795: VecRestoreArray(v,&x);
1796: return(0);
1797: }
1801: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1802: {
1803: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1805: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1806: PetscScalar *x;
1807: MatScalar *aa = a->v;
1810: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1812: VecSet(v,0.0);
1813: VecGetArray(v,&x);
1814: VecGetLocalSize(v,&p);
1815: if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1816: for (i=0; i<m; i++) {
1817: x[i] = aa[i]; if (idx) idx[i] = 0;
1818: for (j=1; j<n; j++){
1819: if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1820: }
1821: }
1822: VecRestoreArray(v,&x);
1823: return(0);
1824: }
1828: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1829: {
1830: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1832: PetscScalar *x;
1835: if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1837: VecGetArray(v,&x);
1838: PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1839: VecRestoreArray(v,&x);
1840: return(0);
1841: }
1846: PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1847: {
1849: PetscInt i,j,m,n;
1850: PetscScalar *a;
1853: MatGetSize(A,&m,&n);
1854: PetscMemzero(norms,n*sizeof(PetscReal));
1855: MatGetArray(A,&a);
1856: if (type == NORM_2) {
1857: for (i=0; i<n; i++ ){
1858: for (j=0; j<m; j++) {
1859: norms[i] += PetscAbsScalar(a[j]*a[j]);
1860: }
1861: a += m;
1862: }
1863: } else if (type == NORM_1) {
1864: for (i=0; i<n; i++ ){
1865: for (j=0; j<m; j++) {
1866: norms[i] += PetscAbsScalar(a[j]);
1867: }
1868: a += m;
1869: }
1870: } else if (type == NORM_INFINITY) {
1871: for (i=0; i<n; i++ ){
1872: for (j=0; j<m; j++) {
1873: norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1874: }
1875: a += m;
1876: }
1877: } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1878: if (type == NORM_2) {
1879: for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1880: }
1881: return(0);
1882: }
1884: /* -------------------------------------------------------------------*/
1885: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1886: MatGetRow_SeqDense,
1887: MatRestoreRow_SeqDense,
1888: MatMult_SeqDense,
1889: /* 4*/ MatMultAdd_SeqDense,
1890: MatMultTranspose_SeqDense,
1891: MatMultTransposeAdd_SeqDense,
1892: 0,
1893: 0,
1894: 0,
1895: /*10*/ 0,
1896: MatLUFactor_SeqDense,
1897: MatCholeskyFactor_SeqDense,
1898: MatSOR_SeqDense,
1899: MatTranspose_SeqDense,
1900: /*15*/ MatGetInfo_SeqDense,
1901: MatEqual_SeqDense,
1902: MatGetDiagonal_SeqDense,
1903: MatDiagonalScale_SeqDense,
1904: MatNorm_SeqDense,
1905: /*20*/ MatAssemblyBegin_SeqDense,
1906: MatAssemblyEnd_SeqDense,
1907: MatSetOption_SeqDense,
1908: MatZeroEntries_SeqDense,
1909: /*24*/ MatZeroRows_SeqDense,
1910: 0,
1911: 0,
1912: 0,
1913: 0,
1914: /*29*/ MatSetUpPreallocation_SeqDense,
1915: 0,
1916: 0,
1917: MatGetArray_SeqDense,
1918: MatRestoreArray_SeqDense,
1919: /*34*/ MatDuplicate_SeqDense,
1920: 0,
1921: 0,
1922: 0,
1923: 0,
1924: /*39*/ MatAXPY_SeqDense,
1925: MatGetSubMatrices_SeqDense,
1926: 0,
1927: MatGetValues_SeqDense,
1928: MatCopy_SeqDense,
1929: /*44*/ MatGetRowMax_SeqDense,
1930: MatScale_SeqDense,
1931: 0,
1932: 0,
1933: 0,
1934: /*49*/ 0,
1935: 0,
1936: 0,
1937: 0,
1938: 0,
1939: /*54*/ 0,
1940: 0,
1941: 0,
1942: 0,
1943: 0,
1944: /*59*/ 0,
1945: MatDestroy_SeqDense,
1946: MatView_SeqDense,
1947: 0,
1948: 0,
1949: /*64*/ 0,
1950: 0,
1951: 0,
1952: 0,
1953: 0,
1954: /*69*/ MatGetRowMaxAbs_SeqDense,
1955: 0,
1956: 0,
1957: 0,
1958: 0,
1959: /*74*/ 0,
1960: 0,
1961: 0,
1962: 0,
1963: 0,
1964: /*79*/ 0,
1965: 0,
1966: 0,
1967: 0,
1968: /*83*/ MatLoad_SeqDense,
1969: 0,
1970: MatIsHermitian_SeqDense,
1971: 0,
1972: 0,
1973: 0,
1974: /*89*/ MatMatMult_SeqDense_SeqDense,
1975: MatMatMultSymbolic_SeqDense_SeqDense,
1976: MatMatMultNumeric_SeqDense_SeqDense,
1977: 0,
1978: 0,
1979: /*94*/ 0,
1980: MatMatMultTranspose_SeqDense_SeqDense,
1981: MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1982: MatMatMultTransposeNumeric_SeqDense_SeqDense,
1983: 0,
1984: /*99*/ 0,
1985: 0,
1986: 0,
1987: MatConjugate_SeqDense,
1988: MatSetSizes_SeqDense,
1989: /*104*/0,
1990: MatRealPart_SeqDense,
1991: MatImaginaryPart_SeqDense,
1992: 0,
1993: 0,
1994: /*109*/MatMatSolve_SeqDense,
1995: 0,
1996: MatGetRowMin_SeqDense,
1997: MatGetColumnVector_SeqDense,
1998: 0,
1999: /*114*/0,
2000: 0,
2001: 0,
2002: 0,
2003: 0,
2004: /*119*/0,
2005: 0,
2006: 0,
2007: 0,
2008: 0,
2009: /*124*/0,
2010: MatGetColumnNorms_SeqDense
2011: };
2015: /*@C
2016: MatCreateSeqDense - Creates a sequential dense matrix that
2017: is stored in column major order (the usual Fortran 77 manner). Many
2018: of the matrix operations use the BLAS and LAPACK routines.
2020: Collective on MPI_Comm
2022: Input Parameters:
2023: + comm - MPI communicator, set to PETSC_COMM_SELF
2024: . m - number of rows
2025: . n - number of columns
2026: - data - optional location of matrix data in column major order. Set data=PETSC_NULL for PETSc
2027: to control all matrix memory allocation.
2029: Output Parameter:
2030: . A - the matrix
2032: Notes:
2033: The data input variable is intended primarily for Fortran programmers
2034: who wish to allocate their own matrix memory space. Most users should
2035: set data=PETSC_NULL.
2037: Level: intermediate
2039: .keywords: dense, matrix, LAPACK, BLAS
2041: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
2042: @*/
2043: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2044: {
2048: MatCreate(comm,A);
2049: MatSetSizes(*A,m,n,m,n);
2050: MatSetType(*A,MATSEQDENSE);
2051: MatSeqDenseSetPreallocation(*A,data);
2052: return(0);
2053: }
2057: /*@C
2058: MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
2060: Collective on MPI_Comm
2062: Input Parameters:
2063: + A - the matrix
2064: - data - the array (or PETSC_NULL)
2066: Notes:
2067: The data input variable is intended primarily for Fortran programmers
2068: who wish to allocate their own matrix memory space. Most users should
2069: need not call this routine.
2071: Level: intermediate
2073: .keywords: dense, matrix, LAPACK, BLAS
2075: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues(), MatSeqDenseSetLDA()
2077: @*/
2078: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2079: {
2083: PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));
2084: return(0);
2085: }
2090: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2091: {
2092: Mat_SeqDense *b;
2096: B->preallocated = PETSC_TRUE;
2098: PetscLayoutSetBlockSize(B->rmap,1);
2099: PetscLayoutSetBlockSize(B->cmap,1);
2100: PetscLayoutSetUp(B->rmap);
2101: PetscLayoutSetUp(B->cmap);
2103: b = (Mat_SeqDense*)B->data;
2104: b->Mmax = B->rmap->n;
2105: b->Nmax = B->cmap->n;
2106: if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;
2108: if (!data) { /* petsc-allocated storage */
2109: if (!b->user_alloc) { PetscFree(b->v); }
2110: PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
2111: PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
2112: PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
2113: b->user_alloc = PETSC_FALSE;
2114: } else { /* user-allocated storage */
2115: if (!b->user_alloc) { PetscFree(b->v); }
2116: b->v = data;
2117: b->user_alloc = PETSC_TRUE;
2118: }
2119: B->assembled = PETSC_TRUE;
2120: return(0);
2121: }
2126: /*@C
2127: MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2129: Input parameter:
2130: + A - the matrix
2131: - lda - the leading dimension
2133: Notes:
2134: This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2135: it asserts that the preallocation has a leading dimension (the LDA parameter
2136: of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2138: Level: intermediate
2140: .keywords: dense, matrix, LAPACK, BLAS
2142: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2144: @*/
2145: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
2146: {
2147: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2150: 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);
2151: b->lda = lda;
2152: b->changelda = PETSC_FALSE;
2153: b->Mmax = PetscMax(b->Mmax,lda);
2154: return(0);
2155: }
2157: /*MC
2158: MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2160: Options Database Keys:
2161: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2163: Level: beginner
2165: .seealso: MatCreateSeqDense()
2167: M*/
2172: PetscErrorCode MatCreate_SeqDense(Mat B)
2173: {
2174: Mat_SeqDense *b;
2176: PetscMPIInt size;
2179: MPI_Comm_size(((PetscObject)B)->comm,&size);
2180: if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2182: PetscNewLog(B,Mat_SeqDense,&b);
2183: PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2184: B->data = (void*)b;
2186: b->pivots = 0;
2187: b->roworiented = PETSC_TRUE;
2188: b->v = 0;
2189: b->changelda = PETSC_FALSE;
2192: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2193: "MatGetFactor_seqdense_petsc",
2194: MatGetFactor_seqdense_petsc);
2195: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2196: "MatSeqDenseSetPreallocation_SeqDense",
2197: MatSeqDenseSetPreallocation_SeqDense);
2198: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2199: "MatMatMult_SeqAIJ_SeqDense",
2200: MatMatMult_SeqAIJ_SeqDense);
2201: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2202: "MatMatMultSymbolic_SeqAIJ_SeqDense",
2203: MatMatMultSymbolic_SeqAIJ_SeqDense);
2204: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2205: "MatMatMultNumeric_SeqAIJ_SeqDense",
2206: MatMatMultNumeric_SeqAIJ_SeqDense);
2207: PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2208: return(0);
2209: }