Actual source code: dense.c
1: #define PETSCMAT_DLL
3: /*
4: Defines the basic matrix operations for sequential dense.
5: */
7: #include ../src/mat/impls/dense/seq/dense.h
8: #include petscblaslapack.h
12: PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str)
13: {
14: Mat_SeqDense *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
15: PetscScalar oalpha = alpha;
16: PetscInt j;
17: PetscBLASInt N,m,ldax,lday,one = 1;
21: N = PetscBLASIntCast(X->rmap->n*X->cmap->n);
22: m = PetscBLASIntCast(X->rmap->n);
23: ldax = PetscBLASIntCast(x->lda);
24: lday = PetscBLASIntCast(y->lda);
25: if (ldax>m || lday>m) {
26: for (j=0; j<X->cmap->n; j++) {
27: BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
28: }
29: } else {
30: BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
31: }
32: PetscLogFlops(PetscMax(2*N-1,0));
33: return(0);
34: }
38: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
39: {
40: PetscInt N = A->rmap->n*A->cmap->n;
43: info->block_size = 1.0;
44: info->nz_allocated = (double)N;
45: info->nz_used = (double)N;
46: info->nz_unneeded = (double)0;
47: info->assemblies = (double)A->num_ass;
48: info->mallocs = 0;
49: info->memory = ((PetscObject)A)->mem;
50: info->fill_ratio_given = 0;
51: info->fill_ratio_needed = 0;
52: info->factor_mallocs = 0;
53: return(0);
54: }
58: PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha)
59: {
60: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
61: PetscScalar oalpha = alpha;
63: PetscBLASInt one = 1,j,nz,lda = PetscBLASIntCast(a->lda);
66: if (lda>A->rmap->n) {
67: nz = PetscBLASIntCast(A->rmap->n);
68: for (j=0; j<A->cmap->n; j++) {
69: BLASscal_(&nz,&oalpha,a->v+j*lda,&one);
70: }
71: } else {
72: nz = PetscBLASIntCast(A->rmap->n*A->cmap->n);
73: BLASscal_(&nz,&oalpha,a->v,&one);
74: }
75: PetscLogFlops(nz);
76: return(0);
77: }
81: PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscTruth *fl)
82: {
83: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
84: PetscInt i,j,m = A->rmap->n,N;
85: PetscScalar *v = a->v;
88: *fl = PETSC_FALSE;
89: if (A->rmap->n != A->cmap->n) return(0);
90: N = a->lda;
92: for (i=0; i<m; i++) {
93: for (j=i+1; j<m; j++) {
94: if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) return(0);
95: }
96: }
97: *fl = PETSC_TRUE;
98: return(0);
99: }
100:
103: PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
104: {
105: Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l;
107: PetscInt lda = (PetscInt)mat->lda,j,m;
110: MatSeqDenseSetPreallocation(newi,PETSC_NULL);
111: if (cpvalues == MAT_COPY_VALUES) {
112: l = (Mat_SeqDense*)newi->data;
113: if (lda>A->rmap->n) {
114: m = A->rmap->n;
115: for (j=0; j<A->cmap->n; j++) {
116: PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
117: }
118: } else {
119: PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
120: }
121: }
122: newi->assembled = PETSC_TRUE;
123: return(0);
124: }
128: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
129: {
133: MatCreate(((PetscObject)A)->comm,newmat);
134: MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
135: MatSetType(*newmat,((PetscObject)A)->type_name);
136: MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);
137: return(0);
138: }
145: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
146: {
147: MatFactorInfo info;
151: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
152: MatLUFactor_SeqDense(fact,0,0,&info);
153: return(0);
154: }
158: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
159: {
160: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
162: PetscScalar *x,*y;
163: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
164:
166: VecGetArray(xx,&x);
167: VecGetArray(yy,&y);
168: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
169: if (A->factor == MAT_FACTOR_LU) {
170: #if defined(PETSC_MISSING_LAPACK_GETRS)
171: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
172: #else
173: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
174: if (info) SETERRQ(PETSC_ERR_LIB,"GETRS - Bad solve");
175: #endif
176: } else if (A->factor == MAT_FACTOR_CHOLESKY){
177: #if defined(PETSC_MISSING_LAPACK_POTRS)
178: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
179: #else
180: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
181: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS Bad solve");
182: #endif
183: }
184: else SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
185: VecRestoreArray(xx,&x);
186: VecRestoreArray(yy,&y);
187: PetscLogFlops(2*A->cmap->n*A->cmap->n - A->cmap->n);
188: return(0);
189: }
193: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
194: {
195: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
197: PetscScalar *x,*y;
198: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
199:
201: VecGetArray(xx,&x);
202: VecGetArray(yy,&y);
203: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
204: /* assume if pivots exist then use LU; else Cholesky */
205: if (mat->pivots) {
206: #if defined(PETSC_MISSING_LAPACK_GETRS)
207: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
208: #else
209: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
210: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
211: #endif
212: } else {
213: #if defined(PETSC_MISSING_LAPACK_POTRS)
214: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
215: #else
216: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
217: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
218: #endif
219: }
220: VecRestoreArray(xx,&x);
221: VecRestoreArray(yy,&y);
222: PetscLogFlops(2*A->cmap->n*A->cmap->n - A->cmap->n);
223: return(0);
224: }
228: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
229: {
230: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
232: PetscScalar *x,*y,sone = 1.0;
233: Vec tmp = 0;
234: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
235:
237: VecGetArray(xx,&x);
238: VecGetArray(yy,&y);
239: if (!A->rmap->n || !A->cmap->n) return(0);
240: if (yy == zz) {
241: VecDuplicate(yy,&tmp);
242: PetscLogObjectParent(A,tmp);
243: VecCopy(yy,tmp);
244: }
245: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
246: /* assume if pivots exist then use LU; else Cholesky */
247: if (mat->pivots) {
248: #if defined(PETSC_MISSING_LAPACK_GETRS)
249: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
250: #else
251: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
252: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
253: #endif
254: } else {
255: #if defined(PETSC_MISSING_LAPACK_POTRS)
256: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
257: #else
258: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
259: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
260: #endif
261: }
262: if (tmp) {VecAXPY(yy,sone,tmp); VecDestroy(tmp);}
263: else {VecAXPY(yy,sone,zz);}
264: VecRestoreArray(xx,&x);
265: VecRestoreArray(yy,&y);
266: PetscLogFlops(2*A->cmap->n*A->cmap->n);
267: return(0);
268: }
272: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
273: {
274: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
276: PetscScalar *x,*y,sone = 1.0;
277: Vec tmp;
278: PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n);
279:
281: if (!A->rmap->n || !A->cmap->n) return(0);
282: VecGetArray(xx,&x);
283: VecGetArray(yy,&y);
284: if (yy == zz) {
285: VecDuplicate(yy,&tmp);
286: PetscLogObjectParent(A,tmp);
287: VecCopy(yy,tmp);
288: }
289: PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
290: /* assume if pivots exist then use LU; else Cholesky */
291: if (mat->pivots) {
292: #if defined(PETSC_MISSING_LAPACK_GETRS)
293: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
294: #else
295: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
296: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
297: #endif
298: } else {
299: #if defined(PETSC_MISSING_LAPACK_POTRS)
300: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
301: #else
302: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
303: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
304: #endif
305: }
306: if (tmp) {
307: VecAXPY(yy,sone,tmp);
308: VecDestroy(tmp);
309: } else {
310: VecAXPY(yy,sone,zz);
311: }
312: VecRestoreArray(xx,&x);
313: VecRestoreArray(yy,&y);
314: PetscLogFlops(2*A->cmap->n*A->cmap->n);
315: return(0);
316: }
318: /* ---------------------------------------------------------------*/
319: /* COMMENT: I have chosen to hide row permutation in the pivots,
320: rather than put it in the Mat->row slot.*/
323: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
324: {
325: #if defined(PETSC_MISSING_LAPACK_GETRF)
327: SETERRQ(PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
328: #else
329: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
331: PetscBLASInt n,m,info;
334: n = PetscBLASIntCast(A->cmap->n);
335: m = PetscBLASIntCast(A->rmap->n);
336: if (!mat->pivots) {
337: PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
338: PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
339: }
340: if (!A->rmap->n || !A->cmap->n) return(0);
341: LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
342: if (info<0) SETERRQ(PETSC_ERR_LIB,"Bad argument to LU factorization");
343: if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
344: A->ops->solve = MatSolve_SeqDense;
345: A->ops->solvetranspose = MatSolveTranspose_SeqDense;
346: A->ops->solveadd = MatSolveAdd_SeqDense;
347: A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
348: A->factor = MAT_FACTOR_LU;
350: PetscLogFlops((2*A->cmap->n*A->cmap->n*A->cmap->n)/3);
351: #endif
352: return(0);
353: }
357: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
358: {
359: #if defined(PETSC_MISSING_LAPACK_POTRF)
361: SETERRQ(PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
362: #else
363: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
365: PetscBLASInt info,n = PetscBLASIntCast(A->cmap->n);
366:
368: PetscFree(mat->pivots);
369: mat->pivots = 0;
371: if (!A->rmap->n || !A->cmap->n) return(0);
372: LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
373: if (info) SETERRQ1(PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
374: A->ops->solve = MatSolve_SeqDense;
375: A->ops->solvetranspose = MatSolveTranspose_SeqDense;
376: A->ops->solveadd = MatSolveAdd_SeqDense;
377: A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
378: A->factor = MAT_FACTOR_CHOLESKY;
379: PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3);
380: #endif
381: return(0);
382: }
387: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
388: {
390: MatFactorInfo info;
393: info.fill = 1.0;
394: MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
395: MatCholeskyFactor_SeqDense(fact,0,&info);
396: return(0);
397: }
401: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
402: {
404: fact->assembled = PETSC_TRUE;
405: fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
406: return(0);
407: }
411: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
412: {
414: fact->assembled = PETSC_TRUE;
415: fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
416: return(0);
417: }
421: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
422: {
426: MatCreate(((PetscObject)A)->comm,fact);
427: MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
428: MatSetType(*fact,((PetscObject)A)->type_name);
429: if (ftype == MAT_FACTOR_LU){
430: (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
431: } else {
432: (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
433: }
434: (*fact)->factor = ftype;
435: return(0);
436: }
438: /* ------------------------------------------------------------------*/
441: PetscErrorCode MatRelax_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
442: {
443: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
444: PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt;
446: PetscInt m = A->rmap->n,i;
447: #if !defined(PETSC_USE_COMPLEX)
448: PetscBLASInt o = 1,bm = PetscBLASIntCast(m);
449: #endif
452: if (flag & SOR_ZERO_INITIAL_GUESS) {
453: /* this is a hack fix, should have another version without the second BLASdot */
454: VecSet(xx,zero);
455: }
456: VecGetArray(xx,&x);
457: VecGetArray(bb,&b);
458: its = its*lits;
459: if (its <= 0) SETERRQ2(PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
460: while (its--) {
461: if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
462: for (i=0; i<m; i++) {
463: #if defined(PETSC_USE_COMPLEX)
464: /* cannot use BLAS dot for complex because compiler/linker is
465: not happy about returning a double complex */
466: PetscInt _i;
467: PetscScalar sum = b[i];
468: for (_i=0; _i<m; _i++) {
469: sum -= PetscConj(v[i+_i*m])*x[_i];
470: }
471: xt = sum;
472: #else
473: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
474: #endif
475: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
476: }
477: }
478: if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
479: for (i=m-1; i>=0; i--) {
480: #if defined(PETSC_USE_COMPLEX)
481: /* cannot use BLAS dot for complex because compiler/linker is
482: not happy about returning a double complex */
483: PetscInt _i;
484: PetscScalar sum = b[i];
485: for (_i=0; _i<m; _i++) {
486: sum -= PetscConj(v[i+_i*m])*x[_i];
487: }
488: xt = sum;
489: #else
490: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
491: #endif
492: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
493: }
494: }
495: }
496: VecRestoreArray(bb,&b);
497: VecRestoreArray(xx,&x);
498: return(0);
499: }
501: /* -----------------------------------------------------------------*/
504: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
505: {
506: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
507: PetscScalar *v = mat->v,*x,*y;
509: PetscBLASInt m, n,_One=1;
510: PetscScalar _DOne=1.0,_DZero=0.0;
513: m = PetscBLASIntCast(A->rmap->n);
514: n = PetscBLASIntCast(A->cmap->n);
515: if (!A->rmap->n || !A->cmap->n) return(0);
516: VecGetArray(xx,&x);
517: VecGetArray(yy,&y);
518: BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
519: VecRestoreArray(xx,&x);
520: VecRestoreArray(yy,&y);
521: PetscLogFlops(2*A->rmap->n*A->cmap->n - A->cmap->n);
522: return(0);
523: }
527: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
528: {
529: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
530: PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
532: PetscBLASInt m, n, _One=1;
535: m = PetscBLASIntCast(A->rmap->n);
536: n = PetscBLASIntCast(A->cmap->n);
537: if (!A->rmap->n || !A->cmap->n) return(0);
538: VecGetArray(xx,&x);
539: VecGetArray(yy,&y);
540: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
541: VecRestoreArray(xx,&x);
542: VecRestoreArray(yy,&y);
543: PetscLogFlops(2*A->rmap->n*A->cmap->n - A->rmap->n);
544: return(0);
545: }
549: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
550: {
551: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
552: PetscScalar *v = mat->v,*x,*y,_DOne=1.0;
554: PetscBLASInt m, n, _One=1;
557: m = PetscBLASIntCast(A->rmap->n);
558: n = PetscBLASIntCast(A->cmap->n);
559: if (!A->rmap->n || !A->cmap->n) return(0);
560: if (zz != yy) {VecCopy(zz,yy);}
561: VecGetArray(xx,&x);
562: VecGetArray(yy,&y);
563: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
564: VecRestoreArray(xx,&x);
565: VecRestoreArray(yy,&y);
566: PetscLogFlops(2*A->rmap->n*A->cmap->n);
567: return(0);
568: }
572: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
573: {
574: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
575: PetscScalar *v = mat->v,*x,*y;
577: PetscBLASInt m, n, _One=1;
578: PetscScalar _DOne=1.0;
581: m = PetscBLASIntCast(A->rmap->n);
582: n = PetscBLASIntCast(A->cmap->n);
583: if (!A->rmap->n || !A->cmap->n) return(0);
584: if (zz != yy) {VecCopy(zz,yy);}
585: VecGetArray(xx,&x);
586: VecGetArray(yy,&y);
587: BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
588: VecRestoreArray(xx,&x);
589: VecRestoreArray(yy,&y);
590: PetscLogFlops(2*A->rmap->n*A->cmap->n);
591: return(0);
592: }
594: /* -----------------------------------------------------------------*/
597: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
598: {
599: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
600: PetscScalar *v;
602: PetscInt i;
603:
605: *ncols = A->cmap->n;
606: if (cols) {
607: PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
608: for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
609: }
610: if (vals) {
611: PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
612: v = mat->v + row;
613: for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
614: }
615: return(0);
616: }
620: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
621: {
624: if (cols) {PetscFree(*cols);}
625: if (vals) {PetscFree(*vals); }
626: return(0);
627: }
628: /* ----------------------------------------------------------------*/
631: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
632: {
633: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
634: PetscInt i,j,idx=0;
635:
637: if (!mat->roworiented) {
638: if (addv == INSERT_VALUES) {
639: for (j=0; j<n; j++) {
640: if (indexn[j] < 0) {idx += m; continue;}
641: #if defined(PETSC_USE_DEBUG)
642: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
643: #endif
644: for (i=0; i<m; i++) {
645: if (indexm[i] < 0) {idx++; continue;}
646: #if defined(PETSC_USE_DEBUG)
647: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
648: #endif
649: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
650: }
651: }
652: } else {
653: for (j=0; j<n; j++) {
654: if (indexn[j] < 0) {idx += m; continue;}
655: #if defined(PETSC_USE_DEBUG)
656: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
657: #endif
658: for (i=0; i<m; i++) {
659: if (indexm[i] < 0) {idx++; continue;}
660: #if defined(PETSC_USE_DEBUG)
661: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
662: #endif
663: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
664: }
665: }
666: }
667: } else {
668: if (addv == INSERT_VALUES) {
669: for (i=0; i<m; i++) {
670: if (indexm[i] < 0) { idx += n; continue;}
671: #if defined(PETSC_USE_DEBUG)
672: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
673: #endif
674: for (j=0; j<n; j++) {
675: if (indexn[j] < 0) { idx++; continue;}
676: #if defined(PETSC_USE_DEBUG)
677: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
678: #endif
679: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
680: }
681: }
682: } else {
683: for (i=0; i<m; i++) {
684: if (indexm[i] < 0) { idx += n; continue;}
685: #if defined(PETSC_USE_DEBUG)
686: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
687: #endif
688: for (j=0; j<n; j++) {
689: if (indexn[j] < 0) { idx++; continue;}
690: #if defined(PETSC_USE_DEBUG)
691: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
692: #endif
693: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
694: }
695: }
696: }
697: }
698: return(0);
699: }
703: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
704: {
705: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
706: PetscInt i,j;
709: /* row-oriented output */
710: for (i=0; i<m; i++) {
711: if (indexm[i] < 0) {v += n;continue;}
712: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
713: for (j=0; j<n; j++) {
714: if (indexn[j] < 0) {v++; continue;}
715: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
716: *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
717: }
718: }
719: return(0);
720: }
722: /* -----------------------------------------------------------------*/
724: #include petscsys.h
728: PetscErrorCode MatLoad_SeqDense(PetscViewer viewer, const MatType type,Mat *A)
729: {
730: Mat_SeqDense *a;
731: Mat B;
733: PetscInt *scols,i,j,nz,header[4];
734: int fd;
735: PetscMPIInt size;
736: PetscInt *rowlengths = 0,M,N,*cols;
737: PetscScalar *vals,*svals,*v,*w;
738: MPI_Comm comm = ((PetscObject)viewer)->comm;
741: MPI_Comm_size(comm,&size);
742: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
743: PetscViewerBinaryGetDescriptor(viewer,&fd);
744: PetscBinaryRead(fd,header,4,PETSC_INT);
745: if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
746: M = header[1]; N = header[2]; nz = header[3];
748: if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
749: MatCreate(comm,A);
750: MatSetSizes(*A,M,N,M,N);
751: MatSetType(*A,type);
752: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
753: B = *A;
754: a = (Mat_SeqDense*)B->data;
755: v = a->v;
756: /* Allocate some temp space to read in the values and then flip them
757: from row major to column major */
758: PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
759: /* read in nonzero values */
760: PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
761: /* now flip the values and store them in the matrix*/
762: for (j=0; j<N; j++) {
763: for (i=0; i<M; i++) {
764: *v++ =w[i*N+j];
765: }
766: }
767: PetscFree(w);
768: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
769: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
770: } else {
771: /* read row lengths */
772: PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
773: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
775: /* create our matrix */
776: MatCreate(comm,A);
777: MatSetSizes(*A,M,N,M,N);
778: MatSetType(*A,type);
779: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
780: B = *A;
781: a = (Mat_SeqDense*)B->data;
782: v = a->v;
784: /* read column indices and nonzeros */
785: PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
786: cols = scols;
787: PetscBinaryRead(fd,cols,nz,PETSC_INT);
788: PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
789: vals = svals;
790: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
792: /* insert into matrix */
793: for (i=0; i<M; i++) {
794: for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
795: svals += rowlengths[i]; scols += rowlengths[i];
796: }
797: PetscFree(vals);
798: PetscFree(cols);
799: PetscFree(rowlengths);
801: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
802: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
803: }
804: return(0);
805: }
807: #include petscsys.h
811: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
812: {
813: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
814: PetscErrorCode ierr;
815: PetscInt i,j;
816: const char *name;
817: PetscScalar *v;
818: PetscViewerFormat format;
819: #if defined(PETSC_USE_COMPLEX)
820: PetscTruth allreal = PETSC_TRUE;
821: #endif
824: PetscObjectGetName((PetscObject)A,&name);
825: PetscViewerGetFormat(viewer,&format);
826: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
827: return(0); /* do nothing for now */
828: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
829: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
830: for (i=0; i<A->rmap->n; i++) {
831: v = a->v + i;
832: PetscViewerASCIIPrintf(viewer,"row %D:",i);
833: for (j=0; j<A->cmap->n; j++) {
834: #if defined(PETSC_USE_COMPLEX)
835: if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
836: PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
837: } else if (PetscRealPart(*v)) {
838: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
839: }
840: #else
841: if (*v) {
842: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
843: }
844: #endif
845: v += a->lda;
846: }
847: PetscViewerASCIIPrintf(viewer,"\n");
848: }
849: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
850: } else {
851: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
852: #if defined(PETSC_USE_COMPLEX)
853: /* determine if matrix has all real values */
854: v = a->v;
855: for (i=0; i<A->rmap->n*A->cmap->n; i++) {
856: if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
857: }
858: #endif
859: if (format == PETSC_VIEWER_ASCII_MATLAB) {
860: PetscObjectGetName((PetscObject)A,&name);
861: PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
862: PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
863: PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
864: }
866: for (i=0; i<A->rmap->n; i++) {
867: v = a->v + i;
868: for (j=0; j<A->cmap->n; j++) {
869: #if defined(PETSC_USE_COMPLEX)
870: if (allreal) {
871: PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
872: } else {
873: PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
874: }
875: #else
876: PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
877: #endif
878: v += a->lda;
879: }
880: PetscViewerASCIIPrintf(viewer,"\n");
881: }
882: if (format == PETSC_VIEWER_ASCII_MATLAB) {
883: PetscViewerASCIIPrintf(viewer,"];\n");
884: }
885: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
886: }
887: PetscViewerFlush(viewer);
888: return(0);
889: }
893: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
894: {
895: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
896: PetscErrorCode ierr;
897: int fd;
898: PetscInt ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
899: PetscScalar *v,*anonz,*vals;
900: PetscViewerFormat format;
901:
903: PetscViewerBinaryGetDescriptor(viewer,&fd);
905: PetscViewerGetFormat(viewer,&format);
906: if (format == PETSC_VIEWER_NATIVE) {
907: /* store the matrix as a dense matrix */
908: PetscMalloc(4*sizeof(PetscInt),&col_lens);
909: col_lens[0] = MAT_FILE_COOKIE;
910: col_lens[1] = m;
911: col_lens[2] = n;
912: col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
913: PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
914: PetscFree(col_lens);
916: /* write out matrix, by rows */
917: PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
918: v = a->v;
919: for (j=0; j<n; j++) {
920: for (i=0; i<m; i++) {
921: vals[j + i*n] = *v++;
922: }
923: }
924: PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
925: PetscFree(vals);
926: } else {
927: PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
928: col_lens[0] = MAT_FILE_COOKIE;
929: col_lens[1] = m;
930: col_lens[2] = n;
931: col_lens[3] = nz;
933: /* store lengths of each row and write (including header) to file */
934: for (i=0; i<m; i++) col_lens[4+i] = n;
935: PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);
937: /* Possibly should write in smaller increments, not whole matrix at once? */
938: /* store column indices (zero start index) */
939: ict = 0;
940: for (i=0; i<m; i++) {
941: for (j=0; j<n; j++) col_lens[ict++] = j;
942: }
943: PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
944: PetscFree(col_lens);
946: /* store nonzero values */
947: PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
948: ict = 0;
949: for (i=0; i<m; i++) {
950: v = a->v + i;
951: for (j=0; j<n; j++) {
952: anonz[ict++] = *v; v += a->lda;
953: }
954: }
955: PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
956: PetscFree(anonz);
957: }
958: return(0);
959: }
963: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
964: {
965: Mat A = (Mat) Aa;
966: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
967: PetscErrorCode ierr;
968: PetscInt m = A->rmap->n,n = A->cmap->n,color,i,j;
969: PetscScalar *v = a->v;
970: PetscViewer viewer;
971: PetscDraw popup;
972: PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
973: PetscViewerFormat format;
977: PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
978: PetscViewerGetFormat(viewer,&format);
979: PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);
981: /* Loop over matrix elements drawing boxes */
982: if (format != PETSC_VIEWER_DRAW_CONTOUR) {
983: /* Blue for negative and Red for positive */
984: color = PETSC_DRAW_BLUE;
985: for(j = 0; j < n; j++) {
986: x_l = j;
987: x_r = x_l + 1.0;
988: for(i = 0; i < m; i++) {
989: y_l = m - i - 1.0;
990: y_r = y_l + 1.0;
991: #if defined(PETSC_USE_COMPLEX)
992: if (PetscRealPart(v[j*m+i]) > 0.) {
993: color = PETSC_DRAW_RED;
994: } else if (PetscRealPart(v[j*m+i]) < 0.) {
995: color = PETSC_DRAW_BLUE;
996: } else {
997: continue;
998: }
999: #else
1000: if (v[j*m+i] > 0.) {
1001: color = PETSC_DRAW_RED;
1002: } else if (v[j*m+i] < 0.) {
1003: color = PETSC_DRAW_BLUE;
1004: } else {
1005: continue;
1006: }
1007: #endif
1008: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1009: }
1010: }
1011: } else {
1012: /* use contour shading to indicate magnitude of values */
1013: /* first determine max of all nonzero values */
1014: for(i = 0; i < m*n; i++) {
1015: if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1016: }
1017: scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1018: PetscDrawGetPopup(draw,&popup);
1019: if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1020: for(j = 0; j < n; j++) {
1021: x_l = j;
1022: x_r = x_l + 1.0;
1023: for(i = 0; i < m; i++) {
1024: y_l = m - i - 1.0;
1025: y_r = y_l + 1.0;
1026: color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1027: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1028: }
1029: }
1030: }
1031: return(0);
1032: }
1036: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1037: {
1038: PetscDraw draw;
1039: PetscTruth isnull;
1040: PetscReal xr,yr,xl,yl,h,w;
1044: PetscViewerDrawGetDraw(viewer,0,&draw);
1045: PetscDrawIsNull(draw,&isnull);
1046: if (isnull) return(0);
1048: PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1049: xr = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1050: xr += w; yr += h; xl = -w; yl = -h;
1051: PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1052: PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1053: PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1054: return(0);
1055: }
1059: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1060: {
1062: PetscTruth iascii,isbinary,isdraw;
1065: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
1066: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
1067: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
1069: if (iascii) {
1070: MatView_SeqDense_ASCII(A,viewer);
1071: } else if (isbinary) {
1072: MatView_SeqDense_Binary(A,viewer);
1073: } else if (isdraw) {
1074: MatView_SeqDense_Draw(A,viewer);
1075: } else {
1076: SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1077: }
1078: return(0);
1079: }
1083: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1084: {
1085: Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1089: #if defined(PETSC_USE_LOG)
1090: PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1091: #endif
1092: PetscFree(l->pivots);
1093: if (!l->user_alloc) {PetscFree(l->v);}
1094: PetscFree(l);
1096: PetscObjectChangeTypeName((PetscObject)mat,0);
1097: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1098: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1099: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1100: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1101: return(0);
1102: }
1106: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1107: {
1108: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1110: PetscInt k,j,m,n,M;
1111: PetscScalar *v,tmp;
1114: v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1115: if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1116: if (m != n) {
1117: SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1118: } else {
1119: for (j=0; j<m; j++) {
1120: for (k=0; k<j; k++) {
1121: tmp = v[j + k*M];
1122: v[j + k*M] = v[k + j*M];
1123: v[k + j*M] = tmp;
1124: }
1125: }
1126: }
1127: } else { /* out-of-place transpose */
1128: Mat tmat;
1129: Mat_SeqDense *tmatd;
1130: PetscScalar *v2;
1132: if (reuse == MAT_INITIAL_MATRIX) {
1133: MatCreate(((PetscObject)A)->comm,&tmat);
1134: MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1135: MatSetType(tmat,((PetscObject)A)->type_name);
1136: MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1137: } else {
1138: tmat = *matout;
1139: }
1140: tmatd = (Mat_SeqDense*)tmat->data;
1141: v = mat->v; v2 = tmatd->v;
1142: for (j=0; j<n; j++) {
1143: for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1144: }
1145: MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1146: MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1147: *matout = tmat;
1148: }
1149: return(0);
1150: }
1154: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1155: {
1156: Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1157: Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1158: PetscInt i,j;
1159: PetscScalar *v1 = mat1->v,*v2 = mat2->v;
1162: if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1163: if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1164: for (i=0; i<A1->rmap->n; i++) {
1165: v1 = mat1->v+i; v2 = mat2->v+i;
1166: for (j=0; j<A1->cmap->n; j++) {
1167: if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1168: v1 += mat1->lda; v2 += mat2->lda;
1169: }
1170: }
1171: *flg = PETSC_TRUE;
1172: return(0);
1173: }
1177: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1178: {
1179: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1181: PetscInt i,n,len;
1182: PetscScalar *x,zero = 0.0;
1185: VecSet(v,zero);
1186: VecGetSize(v,&n);
1187: VecGetArray(v,&x);
1188: len = PetscMin(A->rmap->n,A->cmap->n);
1189: if (n != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1190: for (i=0; i<len; i++) {
1191: x[i] = mat->v[i*mat->lda + i];
1192: }
1193: VecRestoreArray(v,&x);
1194: return(0);
1195: }
1199: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1200: {
1201: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1202: PetscScalar *l,*r,x,*v;
1204: PetscInt i,j,m = A->rmap->n,n = A->cmap->n;
1207: if (ll) {
1208: VecGetSize(ll,&m);
1209: VecGetArray(ll,&l);
1210: if (m != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1211: for (i=0; i<m; i++) {
1212: x = l[i];
1213: v = mat->v + i;
1214: for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1215: }
1216: VecRestoreArray(ll,&l);
1217: PetscLogFlops(n*m);
1218: }
1219: if (rr) {
1220: VecGetSize(rr,&n);
1221: VecGetArray(rr,&r);
1222: if (n != A->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1223: for (i=0; i<n; i++) {
1224: x = r[i];
1225: v = mat->v + i*m;
1226: for (j=0; j<m; j++) { (*v++) *= x;}
1227: }
1228: VecRestoreArray(rr,&r);
1229: PetscLogFlops(n*m);
1230: }
1231: return(0);
1232: }
1236: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1237: {
1238: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1239: PetscScalar *v = mat->v;
1240: PetscReal sum = 0.0;
1241: PetscInt lda=mat->lda,m=A->rmap->n,i,j;
1245: if (type == NORM_FROBENIUS) {
1246: if (lda>m) {
1247: for (j=0; j<A->cmap->n; j++) {
1248: v = mat->v+j*lda;
1249: for (i=0; i<m; i++) {
1250: #if defined(PETSC_USE_COMPLEX)
1251: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1252: #else
1253: sum += (*v)*(*v); v++;
1254: #endif
1255: }
1256: }
1257: } else {
1258: for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1259: #if defined(PETSC_USE_COMPLEX)
1260: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1261: #else
1262: sum += (*v)*(*v); v++;
1263: #endif
1264: }
1265: }
1266: *nrm = sqrt(sum);
1267: PetscLogFlops(2*A->cmap->n*A->rmap->n);
1268: } else if (type == NORM_1) {
1269: *nrm = 0.0;
1270: for (j=0; j<A->cmap->n; j++) {
1271: v = mat->v + j*mat->lda;
1272: sum = 0.0;
1273: for (i=0; i<A->rmap->n; i++) {
1274: sum += PetscAbsScalar(*v); v++;
1275: }
1276: if (sum > *nrm) *nrm = sum;
1277: }
1278: PetscLogFlops(A->cmap->n*A->rmap->n);
1279: } else if (type == NORM_INFINITY) {
1280: *nrm = 0.0;
1281: for (j=0; j<A->rmap->n; j++) {
1282: v = mat->v + j;
1283: sum = 0.0;
1284: for (i=0; i<A->cmap->n; i++) {
1285: sum += PetscAbsScalar(*v); v += mat->lda;
1286: }
1287: if (sum > *nrm) *nrm = sum;
1288: }
1289: PetscLogFlops(A->cmap->n*A->rmap->n);
1290: } else {
1291: SETERRQ(PETSC_ERR_SUP,"No two norm");
1292: }
1293: return(0);
1294: }
1298: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscTruth flg)
1299: {
1300: Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1302:
1304: switch (op) {
1305: case MAT_ROW_ORIENTED:
1306: aij->roworiented = flg;
1307: break;
1308: case MAT_NEW_NONZERO_LOCATIONS:
1309: case MAT_NEW_NONZERO_LOCATION_ERR:
1310: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1311: case MAT_NEW_DIAGONALS:
1312: case MAT_IGNORE_OFF_PROC_ENTRIES:
1313: case MAT_USE_HASH_TABLE:
1314: case MAT_SYMMETRIC:
1315: case MAT_STRUCTURALLY_SYMMETRIC:
1316: case MAT_HERMITIAN:
1317: case MAT_SYMMETRY_ETERNAL:
1318: case MAT_IGNORE_LOWER_TRIANGULAR:
1319: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1320: break;
1321: default:
1322: SETERRQ1(PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1323: }
1324: return(0);
1325: }
1329: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1330: {
1331: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1333: PetscInt lda=l->lda,m=A->rmap->n,j;
1336: if (lda>m) {
1337: for (j=0; j<A->cmap->n; j++) {
1338: PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1339: }
1340: } else {
1341: PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1342: }
1343: return(0);
1344: }
1348: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
1349: {
1350: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1351: PetscInt n = A->cmap->n,i,j;
1352: PetscScalar *slot;
1355: for (i=0; i<N; i++) {
1356: slot = l->v + rows[i];
1357: for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1358: }
1359: if (diag != 0.0) {
1360: for (i=0; i<N; i++) {
1361: slot = l->v + (n+1)*rows[i];
1362: *slot = diag;
1363: }
1364: }
1365: return(0);
1366: }
1370: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1371: {
1372: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1375: if (mat->lda != A->rmap->n) SETERRQ(PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows");
1376: *array = mat->v;
1377: return(0);
1378: }
1382: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1383: {
1385: *array = 0; /* user cannot accidently use the array later */
1386: return(0);
1387: }
1391: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1392: {
1393: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1395: PetscInt i,j,nrows,ncols;
1396: const PetscInt *irow,*icol;
1397: PetscScalar *av,*bv,*v = mat->v;
1398: Mat newmat;
1401: ISGetIndices(isrow,&irow);
1402: ISGetIndices(iscol,&icol);
1403: ISGetLocalSize(isrow,&nrows);
1404: ISGetLocalSize(iscol,&ncols);
1405:
1406: /* Check submatrixcall */
1407: if (scall == MAT_REUSE_MATRIX) {
1408: PetscInt n_cols,n_rows;
1409: MatGetSize(*B,&n_rows,&n_cols);
1410: if (n_rows != nrows || n_cols != ncols) {
1411: /* resize the result result matrix to match number of requested rows/columns */
1412: MatSetSizes(*B,nrows,nrows,nrows,nrows);
1413: }
1414: newmat = *B;
1415: } else {
1416: /* Create and fill new matrix */
1417: MatCreate(((PetscObject)A)->comm,&newmat);
1418: MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1419: MatSetType(newmat,((PetscObject)A)->type_name);
1420: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1421: }
1423: /* Now extract the data pointers and do the copy,column at a time */
1424: bv = ((Mat_SeqDense*)newmat->data)->v;
1425:
1426: for (i=0; i<ncols; i++) {
1427: av = v + mat->lda*icol[i];
1428: for (j=0; j<nrows; j++) {
1429: *bv++ = av[irow[j]];
1430: }
1431: }
1433: /* Assemble the matrices so that the correct flags are set */
1434: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1435: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
1437: /* Free work space */
1438: ISRestoreIndices(isrow,&irow);
1439: ISRestoreIndices(iscol,&icol);
1440: *B = newmat;
1441: return(0);
1442: }
1446: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1447: {
1449: PetscInt i;
1452: if (scall == MAT_INITIAL_MATRIX) {
1453: PetscMalloc((n+1)*sizeof(Mat),B);
1454: }
1456: for (i=0; i<n; i++) {
1457: MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1458: }
1459: return(0);
1460: }
1464: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1465: {
1467: return(0);
1468: }
1472: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1473: {
1475: return(0);
1476: }
1480: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1481: {
1482: Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1484: PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1487: /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1488: if (A->ops->copy != B->ops->copy) {
1489: MatCopy_Basic(A,B,str);
1490: return(0);
1491: }
1492: if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1493: if (lda1>m || lda2>m) {
1494: for (j=0; j<n; j++) {
1495: PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1496: }
1497: } else {
1498: PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1499: }
1500: return(0);
1501: }
1505: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1506: {
1510: MatSeqDenseSetPreallocation(A,0);
1511: return(0);
1512: }
1516: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1517: {
1518: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1520: /* this will not be called before lda, Mmax, and Nmax have been set */
1521: m = PetscMax(m,M);
1522: n = PetscMax(n,N);
1523: if (m > a->Mmax) SETERRQ2(PETSC_ERR_SUP,"Cannot yet resize number rows of dense matrix larger then its initial size %d, requested %d",a->lda,(int)m);
1524: if (n > a->Nmax) SETERRQ2(PETSC_ERR_SUP,"Cannot yet resize number columns of dense matrix larger then its initial size %d, requested %d",a->Nmax,(int)n);
1525: A->rmap->n = A->rmap->n = m;
1526: A->cmap->n = A->cmap->N = n;
1527: if (a->changelda) a->lda = m;
1528: return(0);
1529: }
1532: /* ----------------------------------------------------------------*/
1535: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1536: {
1540: if (scall == MAT_INITIAL_MATRIX){
1541: MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1542: }
1543: MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1544: return(0);
1545: }
1549: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1550: {
1552: PetscInt m=A->rmap->n,n=B->cmap->n;
1553: Mat Cmat;
1556: if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n);
1557: MatCreate(PETSC_COMM_SELF,&Cmat);
1558: MatSetSizes(Cmat,m,n,m,n);
1559: MatSetType(Cmat,MATSEQDENSE);
1560: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1561: Cmat->assembled = PETSC_TRUE;
1562: *C = Cmat;
1563: return(0);
1564: }
1568: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1569: {
1570: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1571: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1572: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1573: PetscBLASInt m,n,k;
1574: PetscScalar _DOne=1.0,_DZero=0.0;
1577: m = PetscBLASIntCast(A->rmap->n);
1578: n = PetscBLASIntCast(B->cmap->n);
1579: k = PetscBLASIntCast(A->cmap->n);
1580: BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1581: return(0);
1582: }
1586: PetscErrorCode MatMatMultTranspose_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1587: {
1591: if (scall == MAT_INITIAL_MATRIX){
1592: MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1593: }
1594: MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1595: return(0);
1596: }
1600: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1601: {
1603: PetscInt m=A->cmap->n,n=B->cmap->n;
1604: Mat Cmat;
1607: if (A->rmap->n != B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"A->rmap->n %d != B->rmap->n %d\n",A->rmap->n,B->rmap->n);
1608: MatCreate(PETSC_COMM_SELF,&Cmat);
1609: MatSetSizes(Cmat,m,n,m,n);
1610: MatSetType(Cmat,MATSEQDENSE);
1611: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1612: Cmat->assembled = PETSC_TRUE;
1613: *C = Cmat;
1614: return(0);
1615: }
1619: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1620: {
1621: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1622: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1623: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1624: PetscBLASInt m,n,k;
1625: PetscScalar _DOne=1.0,_DZero=0.0;
1628: m = PetscBLASIntCast(A->cmap->n);
1629: n = PetscBLASIntCast(B->cmap->n);
1630: k = PetscBLASIntCast(A->rmap->n);
1631: /*
1632: Note the m and n arguments below are the number rows and columns of A', not A!
1633: */
1634: BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1635: return(0);
1636: }
1640: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1641: {
1642: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1644: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1645: PetscScalar *x;
1646: MatScalar *aa = a->v;
1649: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1651: VecSet(v,0.0);
1652: VecGetArray(v,&x);
1653: VecGetLocalSize(v,&p);
1654: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1655: for (i=0; i<m; i++) {
1656: x[i] = aa[i]; if (idx) idx[i] = 0;
1657: for (j=1; j<n; j++){
1658: if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1659: }
1660: }
1661: VecRestoreArray(v,&x);
1662: return(0);
1663: }
1667: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1668: {
1669: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1671: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1672: PetscScalar *x;
1673: PetscReal atmp;
1674: MatScalar *aa = a->v;
1677: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1679: VecSet(v,0.0);
1680: VecGetArray(v,&x);
1681: VecGetLocalSize(v,&p);
1682: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1683: for (i=0; i<m; i++) {
1684: x[i] = PetscAbsScalar(aa[i]);
1685: for (j=1; j<n; j++){
1686: atmp = PetscAbsScalar(aa[i+m*j]);
1687: if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1688: }
1689: }
1690: VecRestoreArray(v,&x);
1691: return(0);
1692: }
1696: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1697: {
1698: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1700: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1701: PetscScalar *x;
1702: MatScalar *aa = a->v;
1705: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1707: VecSet(v,0.0);
1708: VecGetArray(v,&x);
1709: VecGetLocalSize(v,&p);
1710: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1711: for (i=0; i<m; i++) {
1712: x[i] = aa[i]; if (idx) idx[i] = 0;
1713: for (j=1; j<n; j++){
1714: if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1715: }
1716: }
1717: VecRestoreArray(v,&x);
1718: return(0);
1719: }
1723: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1724: {
1725: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1727: PetscScalar *x;
1730: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1732: VecGetArray(v,&x);
1733: PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1734: VecRestoreArray(v,&x);
1735: return(0);
1736: }
1738: /* -------------------------------------------------------------------*/
1739: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1740: MatGetRow_SeqDense,
1741: MatRestoreRow_SeqDense,
1742: MatMult_SeqDense,
1743: /* 4*/ MatMultAdd_SeqDense,
1744: MatMultTranspose_SeqDense,
1745: MatMultTransposeAdd_SeqDense,
1746: 0,
1747: 0,
1748: 0,
1749: /*10*/ 0,
1750: MatLUFactor_SeqDense,
1751: MatCholeskyFactor_SeqDense,
1752: MatRelax_SeqDense,
1753: MatTranspose_SeqDense,
1754: /*15*/ MatGetInfo_SeqDense,
1755: MatEqual_SeqDense,
1756: MatGetDiagonal_SeqDense,
1757: MatDiagonalScale_SeqDense,
1758: MatNorm_SeqDense,
1759: /*20*/ MatAssemblyBegin_SeqDense,
1760: MatAssemblyEnd_SeqDense,
1761: 0,
1762: MatSetOption_SeqDense,
1763: MatZeroEntries_SeqDense,
1764: /*25*/ MatZeroRows_SeqDense,
1765: 0,
1766: 0,
1767: 0,
1768: 0,
1769: /*30*/ MatSetUpPreallocation_SeqDense,
1770: 0,
1771: 0,
1772: MatGetArray_SeqDense,
1773: MatRestoreArray_SeqDense,
1774: /*35*/ MatDuplicate_SeqDense,
1775: 0,
1776: 0,
1777: 0,
1778: 0,
1779: /*40*/ MatAXPY_SeqDense,
1780: MatGetSubMatrices_SeqDense,
1781: 0,
1782: MatGetValues_SeqDense,
1783: MatCopy_SeqDense,
1784: /*45*/ MatGetRowMax_SeqDense,
1785: MatScale_SeqDense,
1786: 0,
1787: 0,
1788: 0,
1789: /*50*/ 0,
1790: 0,
1791: 0,
1792: 0,
1793: 0,
1794: /*55*/ 0,
1795: 0,
1796: 0,
1797: 0,
1798: 0,
1799: /*60*/ 0,
1800: MatDestroy_SeqDense,
1801: MatView_SeqDense,
1802: 0,
1803: 0,
1804: /*65*/ 0,
1805: 0,
1806: 0,
1807: 0,
1808: 0,
1809: /*70*/ MatGetRowMaxAbs_SeqDense,
1810: 0,
1811: 0,
1812: 0,
1813: 0,
1814: /*75*/ 0,
1815: 0,
1816: 0,
1817: 0,
1818: 0,
1819: /*80*/ 0,
1820: 0,
1821: 0,
1822: 0,
1823: /*84*/ MatLoad_SeqDense,
1824: 0,
1825: MatIsHermitian_SeqDense,
1826: 0,
1827: 0,
1828: 0,
1829: /*90*/ MatMatMult_SeqDense_SeqDense,
1830: MatMatMultSymbolic_SeqDense_SeqDense,
1831: MatMatMultNumeric_SeqDense_SeqDense,
1832: 0,
1833: 0,
1834: /*95*/ 0,
1835: MatMatMultTranspose_SeqDense_SeqDense,
1836: MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1837: MatMatMultTransposeNumeric_SeqDense_SeqDense,
1838: 0,
1839: /*100*/0,
1840: 0,
1841: 0,
1842: 0,
1843: MatSetSizes_SeqDense,
1844: 0,
1845: 0,
1846: 0,
1847: 0,
1848: 0,
1849: /*110*/0,
1850: 0,
1851: MatGetRowMin_SeqDense,
1852: MatGetColumnVector_SeqDense
1853: };
1857: /*@C
1858: MatCreateSeqDense - Creates a sequential dense matrix that
1859: is stored in column major order (the usual Fortran 77 manner). Many
1860: of the matrix operations use the BLAS and LAPACK routines.
1862: Collective on MPI_Comm
1864: Input Parameters:
1865: + comm - MPI communicator, set to PETSC_COMM_SELF
1866: . m - number of rows
1867: . n - number of columns
1868: - data - optional location of matrix data. Set data=PETSC_NULL for PETSc
1869: to control all matrix memory allocation.
1871: Output Parameter:
1872: . A - the matrix
1874: Notes:
1875: The data input variable is intended primarily for Fortran programmers
1876: who wish to allocate their own matrix memory space. Most users should
1877: set data=PETSC_NULL.
1879: Level: intermediate
1881: .keywords: dense, matrix, LAPACK, BLAS
1883: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1884: @*/
1885: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1886: {
1890: MatCreate(comm,A);
1891: MatSetSizes(*A,m,n,m,n);
1892: MatSetType(*A,MATSEQDENSE);
1893: MatSeqDenseSetPreallocation(*A,data);
1894: return(0);
1895: }
1899: /*@C
1900: MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
1902: Collective on MPI_Comm
1904: Input Parameters:
1905: + A - the matrix
1906: - data - the array (or PETSC_NULL)
1908: Notes:
1909: The data input variable is intended primarily for Fortran programmers
1910: who wish to allocate their own matrix memory space. Most users should
1911: need not call this routine.
1913: Level: intermediate
1915: .keywords: dense, matrix, LAPACK, BLAS
1917: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1918: @*/
1919: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1920: {
1921: PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);
1924: PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1925: if (f) {
1926: (*f)(B,data);
1927: }
1928: return(0);
1929: }
1934: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1935: {
1936: Mat_SeqDense *b;
1940: B->preallocated = PETSC_TRUE;
1941: b = (Mat_SeqDense*)B->data;
1942: if (b->lda <= 0) b->lda = B->rmap->n;
1943: if (!data) { /* petsc-allocated storage */
1944: if (!b->user_alloc) { PetscFree(b->v); }
1945: PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
1946: PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
1947: PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
1948: b->user_alloc = PETSC_FALSE;
1949: } else { /* user-allocated storage */
1950: if (!b->user_alloc) { PetscFree(b->v); }
1951: b->v = data;
1952: b->user_alloc = PETSC_TRUE;
1953: }
1954: B->assembled = PETSC_TRUE;
1955: return(0);
1956: }
1961: /*@C
1962: MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
1964: Input parameter:
1965: + A - the matrix
1966: - lda - the leading dimension
1968: Notes:
1969: This routine is to be used in conjunction with MatSeqDenseSetPreallocation;
1970: it asserts that the preallocation has a leading dimension (the LDA parameter
1971: of Blas and Lapack fame) larger than M, the first dimension of the matrix.
1973: Level: intermediate
1975: .keywords: dense, matrix, LAPACK, BLAS
1977: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
1978: @*/
1979: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
1980: {
1981: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1984: if (lda < B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n);
1985: b->lda = lda;
1986: b->changelda = PETSC_FALSE;
1987: b->Mmax = PetscMax(b->Mmax,lda);
1988: return(0);
1989: }
1991: /*MC
1992: MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
1994: Options Database Keys:
1995: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
1997: Level: beginner
1999: .seealso: MatCreateSeqDense()
2001: M*/
2006: PetscErrorCode MatCreate_SeqDense(Mat B)
2007: {
2008: Mat_SeqDense *b;
2010: PetscMPIInt size;
2013: MPI_Comm_size(((PetscObject)B)->comm,&size);
2014: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2016: PetscMapSetBlockSize(B->rmap,1);
2017: PetscMapSetBlockSize(B->cmap,1);
2018: PetscMapSetUp(B->rmap);
2019: PetscMapSetUp(B->cmap);
2021: PetscNewLog(B,Mat_SeqDense,&b);
2022: PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2023: B->mapping = 0;
2024: B->data = (void*)b;
2027: b->pivots = 0;
2028: b->roworiented = PETSC_TRUE;
2029: b->v = 0;
2030: b->lda = B->rmap->n;
2031: b->changelda = PETSC_FALSE;
2032: b->Mmax = B->rmap->n;
2033: b->Nmax = B->cmap->n;
2036: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_seqdense_petsc_C",
2037: "MatGetFactor_seqdense_petsc",
2038: MatGetFactor_seqdense_petsc);
2039: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2040: "MatSeqDenseSetPreallocation_SeqDense",
2041: MatSeqDenseSetPreallocation_SeqDense);
2042: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2043: "MatMatMult_SeqAIJ_SeqDense",
2044: MatMatMult_SeqAIJ_SeqDense);
2045: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2046: "MatMatMultSymbolic_SeqAIJ_SeqDense",
2047: MatMatMultSymbolic_SeqAIJ_SeqDense);
2048: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2049: "MatMatMultNumeric_SeqAIJ_SeqDense",
2050: MatMatMultNumeric_SeqAIJ_SeqDense);
2051: PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2052: return(0);
2053: }