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.0*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.0*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.0*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.0*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.0*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.0);
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: }
422: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
423: {
427: MatCreate(((PetscObject)A)->comm,fact);
428: MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
429: MatSetType(*fact,((PetscObject)A)->type_name);
430: if (ftype == MAT_FACTOR_LU){
431: (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
432: } else {
433: (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
434: }
435: (*fact)->factor = ftype;
436: return(0);
437: }
440: /* ------------------------------------------------------------------*/
443: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
444: {
445: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
446: PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt;
448: PetscInt m = A->rmap->n,i;
449: #if !defined(PETSC_USE_COMPLEX)
450: PetscBLASInt o = 1,bm = PetscBLASIntCast(m);
451: #endif
454: if (flag & SOR_ZERO_INITIAL_GUESS) {
455: /* this is a hack fix, should have another version without the second BLASdot */
456: VecSet(xx,zero);
457: }
458: VecGetArray(xx,&x);
459: VecGetArray(bb,&b);
460: its = its*lits;
461: if (its <= 0) SETERRQ2(PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
462: while (its--) {
463: if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
464: for (i=0; i<m; i++) {
465: #if defined(PETSC_USE_COMPLEX)
466: /* cannot use BLAS dot for complex because compiler/linker is
467: not happy about returning a double complex */
468: PetscInt _i;
469: PetscScalar sum = b[i];
470: for (_i=0; _i<m; _i++) {
471: sum -= PetscConj(v[i+_i*m])*x[_i];
472: }
473: xt = sum;
474: #else
475: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
476: #endif
477: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
478: }
479: }
480: if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
481: for (i=m-1; i>=0; i--) {
482: #if defined(PETSC_USE_COMPLEX)
483: /* cannot use BLAS dot for complex because compiler/linker is
484: not happy about returning a double complex */
485: PetscInt _i;
486: PetscScalar sum = b[i];
487: for (_i=0; _i<m; _i++) {
488: sum -= PetscConj(v[i+_i*m])*x[_i];
489: }
490: xt = sum;
491: #else
492: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
493: #endif
494: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
495: }
496: }
497: }
498: VecRestoreArray(bb,&b);
499: VecRestoreArray(xx,&x);
500: return(0);
501: }
503: /* -----------------------------------------------------------------*/
506: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
507: {
508: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
509: PetscScalar *v = mat->v,*x,*y;
511: PetscBLASInt m, n,_One=1;
512: PetscScalar _DOne=1.0,_DZero=0.0;
515: m = PetscBLASIntCast(A->rmap->n);
516: n = PetscBLASIntCast(A->cmap->n);
517: if (!A->rmap->n || !A->cmap->n) return(0);
518: VecGetArray(xx,&x);
519: VecGetArray(yy,&y);
520: BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
521: VecRestoreArray(xx,&x);
522: VecRestoreArray(yy,&y);
523: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);
524: return(0);
525: }
529: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
530: {
531: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
532: PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
534: PetscBLASInt m, n, _One=1;
537: m = PetscBLASIntCast(A->rmap->n);
538: n = PetscBLASIntCast(A->cmap->n);
539: if (!A->rmap->n || !A->cmap->n) return(0);
540: VecGetArray(xx,&x);
541: VecGetArray(yy,&y);
542: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
543: VecRestoreArray(xx,&x);
544: VecRestoreArray(yy,&y);
545: PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);
546: return(0);
547: }
551: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
552: {
553: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
554: PetscScalar *v = mat->v,*x,*y,_DOne=1.0;
556: PetscBLASInt m, n, _One=1;
559: m = PetscBLASIntCast(A->rmap->n);
560: n = PetscBLASIntCast(A->cmap->n);
561: if (!A->rmap->n || !A->cmap->n) return(0);
562: if (zz != yy) {VecCopy(zz,yy);}
563: VecGetArray(xx,&x);
564: VecGetArray(yy,&y);
565: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
566: VecRestoreArray(xx,&x);
567: VecRestoreArray(yy,&y);
568: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
569: return(0);
570: }
574: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
575: {
576: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
577: PetscScalar *v = mat->v,*x,*y;
579: PetscBLASInt m, n, _One=1;
580: PetscScalar _DOne=1.0;
583: m = PetscBLASIntCast(A->rmap->n);
584: n = PetscBLASIntCast(A->cmap->n);
585: if (!A->rmap->n || !A->cmap->n) return(0);
586: if (zz != yy) {VecCopy(zz,yy);}
587: VecGetArray(xx,&x);
588: VecGetArray(yy,&y);
589: BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
590: VecRestoreArray(xx,&x);
591: VecRestoreArray(yy,&y);
592: PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
593: return(0);
594: }
596: /* -----------------------------------------------------------------*/
599: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
600: {
601: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
602: PetscScalar *v;
604: PetscInt i;
605:
607: *ncols = A->cmap->n;
608: if (cols) {
609: PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
610: for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
611: }
612: if (vals) {
613: PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
614: v = mat->v + row;
615: for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
616: }
617: return(0);
618: }
622: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
623: {
626: if (cols) {PetscFree(*cols);}
627: if (vals) {PetscFree(*vals); }
628: return(0);
629: }
630: /* ----------------------------------------------------------------*/
633: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
634: {
635: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
636: PetscInt i,j,idx=0;
637:
640: if (!mat->roworiented) {
641: if (addv == INSERT_VALUES) {
642: for (j=0; j<n; j++) {
643: if (indexn[j] < 0) {idx += m; continue;}
644: #if defined(PETSC_USE_DEBUG)
645: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
646: #endif
647: for (i=0; i<m; i++) {
648: if (indexm[i] < 0) {idx++; continue;}
649: #if defined(PETSC_USE_DEBUG)
650: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
651: #endif
652: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
653: }
654: }
655: } else {
656: for (j=0; j<n; j++) {
657: if (indexn[j] < 0) {idx += m; continue;}
658: #if defined(PETSC_USE_DEBUG)
659: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
660: #endif
661: for (i=0; i<m; i++) {
662: if (indexm[i] < 0) {idx++; continue;}
663: #if defined(PETSC_USE_DEBUG)
664: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
665: #endif
666: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
667: }
668: }
669: }
670: } else {
671: if (addv == INSERT_VALUES) {
672: for (i=0; i<m; i++) {
673: if (indexm[i] < 0) { idx += n; continue;}
674: #if defined(PETSC_USE_DEBUG)
675: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
676: #endif
677: for (j=0; j<n; j++) {
678: if (indexn[j] < 0) { idx++; continue;}
679: #if defined(PETSC_USE_DEBUG)
680: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
681: #endif
682: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
683: }
684: }
685: } else {
686: for (i=0; i<m; i++) {
687: if (indexm[i] < 0) { idx += n; continue;}
688: #if defined(PETSC_USE_DEBUG)
689: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
690: #endif
691: for (j=0; j<n; j++) {
692: if (indexn[j] < 0) { idx++; continue;}
693: #if defined(PETSC_USE_DEBUG)
694: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
695: #endif
696: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
697: }
698: }
699: }
700: }
701: return(0);
702: }
706: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
707: {
708: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
709: PetscInt i,j;
712: /* row-oriented output */
713: for (i=0; i<m; i++) {
714: if (indexm[i] < 0) {v += n;continue;}
715: if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
716: for (j=0; j<n; j++) {
717: if (indexn[j] < 0) {v++; continue;}
718: if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
719: *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
720: }
721: }
722: return(0);
723: }
725: /* -----------------------------------------------------------------*/
729: PetscErrorCode MatLoad_SeqDense(PetscViewer viewer, const MatType type,Mat *A)
730: {
731: Mat_SeqDense *a;
732: Mat B;
734: PetscInt *scols,i,j,nz,header[4];
735: int fd;
736: PetscMPIInt size;
737: PetscInt *rowlengths = 0,M,N,*cols;
738: PetscScalar *vals,*svals,*v,*w;
739: MPI_Comm comm = ((PetscObject)viewer)->comm;
742: MPI_Comm_size(comm,&size);
743: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
744: PetscViewerBinaryGetDescriptor(viewer,&fd);
745: PetscBinaryRead(fd,header,4,PETSC_INT);
746: if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
747: M = header[1]; N = header[2]; nz = header[3];
749: if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
750: MatCreate(comm,A);
751: MatSetSizes(*A,M,N,M,N);
752: MatSetType(*A,type);
753: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
754: B = *A;
755: a = (Mat_SeqDense*)B->data;
756: v = a->v;
757: /* Allocate some temp space to read in the values and then flip them
758: from row major to column major */
759: PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
760: /* read in nonzero values */
761: PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
762: /* now flip the values and store them in the matrix*/
763: for (j=0; j<N; j++) {
764: for (i=0; i<M; i++) {
765: *v++ =w[i*N+j];
766: }
767: }
768: PetscFree(w);
769: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
770: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
771: } else {
772: /* read row lengths */
773: PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
774: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
776: /* create our matrix */
777: MatCreate(comm,A);
778: MatSetSizes(*A,M,N,M,N);
779: MatSetType(*A,type);
780: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
781: B = *A;
782: a = (Mat_SeqDense*)B->data;
783: v = a->v;
785: /* read column indices and nonzeros */
786: PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
787: cols = scols;
788: PetscBinaryRead(fd,cols,nz,PETSC_INT);
789: PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
790: vals = svals;
791: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
793: /* insert into matrix */
794: for (i=0; i<M; i++) {
795: for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
796: svals += rowlengths[i]; scols += rowlengths[i];
797: }
798: PetscFree(vals);
799: PetscFree(cols);
800: PetscFree(rowlengths);
802: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
803: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
804: }
805: return(0);
806: }
810: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
811: {
812: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
813: PetscErrorCode ierr;
814: PetscInt i,j;
815: const char *name;
816: PetscScalar *v;
817: PetscViewerFormat format;
818: #if defined(PETSC_USE_COMPLEX)
819: PetscTruth allreal = PETSC_TRUE;
820: #endif
823: PetscObjectGetName((PetscObject)A,&name);
824: PetscViewerGetFormat(viewer,&format);
825: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
826: return(0); /* do nothing for now */
827: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
828: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
829: for (i=0; i<A->rmap->n; i++) {
830: v = a->v + i;
831: PetscViewerASCIIPrintf(viewer,"row %D:",i);
832: for (j=0; j<A->cmap->n; j++) {
833: #if defined(PETSC_USE_COMPLEX)
834: if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
835: PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
836: } else if (PetscRealPart(*v)) {
837: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
838: }
839: #else
840: if (*v) {
841: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
842: }
843: #endif
844: v += a->lda;
845: }
846: PetscViewerASCIIPrintf(viewer,"\n");
847: }
848: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
849: } else {
850: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
851: #if defined(PETSC_USE_COMPLEX)
852: /* determine if matrix has all real values */
853: v = a->v;
854: for (i=0; i<A->rmap->n*A->cmap->n; i++) {
855: if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
856: }
857: #endif
858: if (format == PETSC_VIEWER_ASCII_MATLAB) {
859: PetscObjectGetName((PetscObject)A,&name);
860: PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
861: PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
862: PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
863: }
865: for (i=0; i<A->rmap->n; i++) {
866: v = a->v + i;
867: for (j=0; j<A->cmap->n; j++) {
868: #if defined(PETSC_USE_COMPLEX)
869: if (allreal) {
870: PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
871: } else {
872: PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
873: }
874: #else
875: PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
876: #endif
877: v += a->lda;
878: }
879: PetscViewerASCIIPrintf(viewer,"\n");
880: }
881: if (format == PETSC_VIEWER_ASCII_MATLAB) {
882: PetscViewerASCIIPrintf(viewer,"];\n");
883: }
884: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
885: }
886: PetscViewerFlush(viewer);
887: return(0);
888: }
892: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
893: {
894: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
895: PetscErrorCode ierr;
896: int fd;
897: PetscInt ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
898: PetscScalar *v,*anonz,*vals;
899: PetscViewerFormat format;
900:
902: PetscViewerBinaryGetDescriptor(viewer,&fd);
904: PetscViewerGetFormat(viewer,&format);
905: if (format == PETSC_VIEWER_NATIVE) {
906: /* store the matrix as a dense matrix */
907: PetscMalloc(4*sizeof(PetscInt),&col_lens);
908: col_lens[0] = MAT_FILE_COOKIE;
909: col_lens[1] = m;
910: col_lens[2] = n;
911: col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
912: PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
913: PetscFree(col_lens);
915: /* write out matrix, by rows */
916: PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
917: v = a->v;
918: for (j=0; j<n; j++) {
919: for (i=0; i<m; i++) {
920: vals[j + i*n] = *v++;
921: }
922: }
923: PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
924: PetscFree(vals);
925: } else {
926: PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
927: col_lens[0] = MAT_FILE_COOKIE;
928: col_lens[1] = m;
929: col_lens[2] = n;
930: col_lens[3] = nz;
932: /* store lengths of each row and write (including header) to file */
933: for (i=0; i<m; i++) col_lens[4+i] = n;
934: PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);
936: /* Possibly should write in smaller increments, not whole matrix at once? */
937: /* store column indices (zero start index) */
938: ict = 0;
939: for (i=0; i<m; i++) {
940: for (j=0; j<n; j++) col_lens[ict++] = j;
941: }
942: PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
943: PetscFree(col_lens);
945: /* store nonzero values */
946: PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
947: ict = 0;
948: for (i=0; i<m; i++) {
949: v = a->v + i;
950: for (j=0; j<n; j++) {
951: anonz[ict++] = *v; v += a->lda;
952: }
953: }
954: PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
955: PetscFree(anonz);
956: }
957: return(0);
958: }
962: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
963: {
964: Mat A = (Mat) Aa;
965: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
966: PetscErrorCode ierr;
967: PetscInt m = A->rmap->n,n = A->cmap->n,color,i,j;
968: PetscScalar *v = a->v;
969: PetscViewer viewer;
970: PetscDraw popup;
971: PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
972: PetscViewerFormat format;
976: PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
977: PetscViewerGetFormat(viewer,&format);
978: PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);
980: /* Loop over matrix elements drawing boxes */
981: if (format != PETSC_VIEWER_DRAW_CONTOUR) {
982: /* Blue for negative and Red for positive */
983: color = PETSC_DRAW_BLUE;
984: for(j = 0; j < n; j++) {
985: x_l = j;
986: x_r = x_l + 1.0;
987: for(i = 0; i < m; i++) {
988: y_l = m - i - 1.0;
989: y_r = y_l + 1.0;
990: #if defined(PETSC_USE_COMPLEX)
991: if (PetscRealPart(v[j*m+i]) > 0.) {
992: color = PETSC_DRAW_RED;
993: } else if (PetscRealPart(v[j*m+i]) < 0.) {
994: color = PETSC_DRAW_BLUE;
995: } else {
996: continue;
997: }
998: #else
999: if (v[j*m+i] > 0.) {
1000: color = PETSC_DRAW_RED;
1001: } else if (v[j*m+i] < 0.) {
1002: color = PETSC_DRAW_BLUE;
1003: } else {
1004: continue;
1005: }
1006: #endif
1007: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1008: }
1009: }
1010: } else {
1011: /* use contour shading to indicate magnitude of values */
1012: /* first determine max of all nonzero values */
1013: for(i = 0; i < m*n; i++) {
1014: if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1015: }
1016: scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1017: PetscDrawGetPopup(draw,&popup);
1018: if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1019: for(j = 0; j < n; j++) {
1020: x_l = j;
1021: x_r = x_l + 1.0;
1022: for(i = 0; i < m; i++) {
1023: y_l = m - i - 1.0;
1024: y_r = y_l + 1.0;
1025: color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1026: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1027: }
1028: }
1029: }
1030: return(0);
1031: }
1035: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1036: {
1037: PetscDraw draw;
1038: PetscTruth isnull;
1039: PetscReal xr,yr,xl,yl,h,w;
1043: PetscViewerDrawGetDraw(viewer,0,&draw);
1044: PetscDrawIsNull(draw,&isnull);
1045: if (isnull) return(0);
1047: PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1048: xr = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1049: xr += w; yr += h; xl = -w; yl = -h;
1050: PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1051: PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1052: PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1053: return(0);
1054: }
1058: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1059: {
1061: PetscTruth iascii,isbinary,isdraw;
1064: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
1065: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
1066: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
1068: if (iascii) {
1069: MatView_SeqDense_ASCII(A,viewer);
1070: } else if (isbinary) {
1071: MatView_SeqDense_Binary(A,viewer);
1072: } else if (isdraw) {
1073: MatView_SeqDense_Draw(A,viewer);
1074: } else {
1075: SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1076: }
1077: return(0);
1078: }
1082: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1083: {
1084: Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1088: #if defined(PETSC_USE_LOG)
1089: PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1090: #endif
1091: PetscFree(l->pivots);
1092: if (!l->user_alloc) {PetscFree(l->v);}
1093: PetscFree(l);
1095: PetscObjectChangeTypeName((PetscObject)mat,0);
1096: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1097: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1098: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1099: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1100: return(0);
1101: }
1105: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1106: {
1107: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1109: PetscInt k,j,m,n,M;
1110: PetscScalar *v,tmp;
1113: v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1114: if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1115: if (m != n) {
1116: SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1117: } else {
1118: for (j=0; j<m; j++) {
1119: for (k=0; k<j; k++) {
1120: tmp = v[j + k*M];
1121: v[j + k*M] = v[k + j*M];
1122: v[k + j*M] = tmp;
1123: }
1124: }
1125: }
1126: } else { /* out-of-place transpose */
1127: Mat tmat;
1128: Mat_SeqDense *tmatd;
1129: PetscScalar *v2;
1131: if (reuse == MAT_INITIAL_MATRIX) {
1132: MatCreate(((PetscObject)A)->comm,&tmat);
1133: MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1134: MatSetType(tmat,((PetscObject)A)->type_name);
1135: MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1136: } else {
1137: tmat = *matout;
1138: }
1139: tmatd = (Mat_SeqDense*)tmat->data;
1140: v = mat->v; v2 = tmatd->v;
1141: for (j=0; j<n; j++) {
1142: for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1143: }
1144: MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1145: MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1146: *matout = tmat;
1147: }
1148: return(0);
1149: }
1153: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1154: {
1155: Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1156: Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1157: PetscInt i,j;
1158: PetscScalar *v1 = mat1->v,*v2 = mat2->v;
1161: if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1162: if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1163: for (i=0; i<A1->rmap->n; i++) {
1164: v1 = mat1->v+i; v2 = mat2->v+i;
1165: for (j=0; j<A1->cmap->n; j++) {
1166: if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1167: v1 += mat1->lda; v2 += mat2->lda;
1168: }
1169: }
1170: *flg = PETSC_TRUE;
1171: return(0);
1172: }
1176: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1177: {
1178: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1180: PetscInt i,n,len;
1181: PetscScalar *x,zero = 0.0;
1184: VecSet(v,zero);
1185: VecGetSize(v,&n);
1186: VecGetArray(v,&x);
1187: len = PetscMin(A->rmap->n,A->cmap->n);
1188: if (n != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1189: for (i=0; i<len; i++) {
1190: x[i] = mat->v[i*mat->lda + i];
1191: }
1192: VecRestoreArray(v,&x);
1193: return(0);
1194: }
1198: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1199: {
1200: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1201: PetscScalar *l,*r,x,*v;
1203: PetscInt i,j,m = A->rmap->n,n = A->cmap->n;
1206: if (ll) {
1207: VecGetSize(ll,&m);
1208: VecGetArray(ll,&l);
1209: if (m != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1210: for (i=0; i<m; i++) {
1211: x = l[i];
1212: v = mat->v + i;
1213: for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1214: }
1215: VecRestoreArray(ll,&l);
1216: PetscLogFlops(n*m);
1217: }
1218: if (rr) {
1219: VecGetSize(rr,&n);
1220: VecGetArray(rr,&r);
1221: if (n != A->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1222: for (i=0; i<n; i++) {
1223: x = r[i];
1224: v = mat->v + i*m;
1225: for (j=0; j<m; j++) { (*v++) *= x;}
1226: }
1227: VecRestoreArray(rr,&r);
1228: PetscLogFlops(n*m);
1229: }
1230: return(0);
1231: }
1235: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1236: {
1237: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1238: PetscScalar *v = mat->v;
1239: PetscReal sum = 0.0;
1240: PetscInt lda=mat->lda,m=A->rmap->n,i,j;
1244: if (type == NORM_FROBENIUS) {
1245: if (lda>m) {
1246: for (j=0; j<A->cmap->n; j++) {
1247: v = mat->v+j*lda;
1248: for (i=0; i<m; i++) {
1249: #if defined(PETSC_USE_COMPLEX)
1250: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1251: #else
1252: sum += (*v)*(*v); v++;
1253: #endif
1254: }
1255: }
1256: } else {
1257: for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1258: #if defined(PETSC_USE_COMPLEX)
1259: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1260: #else
1261: sum += (*v)*(*v); v++;
1262: #endif
1263: }
1264: }
1265: *nrm = sqrt(sum);
1266: PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1267: } else if (type == NORM_1) {
1268: *nrm = 0.0;
1269: for (j=0; j<A->cmap->n; j++) {
1270: v = mat->v + j*mat->lda;
1271: sum = 0.0;
1272: for (i=0; i<A->rmap->n; i++) {
1273: sum += PetscAbsScalar(*v); v++;
1274: }
1275: if (sum > *nrm) *nrm = sum;
1276: }
1277: PetscLogFlops(A->cmap->n*A->rmap->n);
1278: } else if (type == NORM_INFINITY) {
1279: *nrm = 0.0;
1280: for (j=0; j<A->rmap->n; j++) {
1281: v = mat->v + j;
1282: sum = 0.0;
1283: for (i=0; i<A->cmap->n; i++) {
1284: sum += PetscAbsScalar(*v); v += mat->lda;
1285: }
1286: if (sum > *nrm) *nrm = sum;
1287: }
1288: PetscLogFlops(A->cmap->n*A->rmap->n);
1289: } else {
1290: SETERRQ(PETSC_ERR_SUP,"No two norm");
1291: }
1292: return(0);
1293: }
1297: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscTruth flg)
1298: {
1299: Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1301:
1303: switch (op) {
1304: case MAT_ROW_ORIENTED:
1305: aij->roworiented = flg;
1306: break;
1307: case MAT_NEW_NONZERO_LOCATIONS:
1308: case MAT_NEW_NONZERO_LOCATION_ERR:
1309: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1310: case MAT_NEW_DIAGONALS:
1311: case MAT_IGNORE_OFF_PROC_ENTRIES:
1312: case MAT_USE_HASH_TABLE:
1313: case MAT_SYMMETRIC:
1314: case MAT_STRUCTURALLY_SYMMETRIC:
1315: case MAT_HERMITIAN:
1316: case MAT_SYMMETRY_ETERNAL:
1317: case MAT_IGNORE_LOWER_TRIANGULAR:
1318: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1319: break;
1320: default:
1321: SETERRQ1(PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1322: }
1323: return(0);
1324: }
1328: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1329: {
1330: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1332: PetscInt lda=l->lda,m=A->rmap->n,j;
1335: if (lda>m) {
1336: for (j=0; j<A->cmap->n; j++) {
1337: PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1338: }
1339: } else {
1340: PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1341: }
1342: return(0);
1343: }
1347: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
1348: {
1349: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1350: PetscInt n = A->cmap->n,i,j;
1351: PetscScalar *slot;
1354: for (i=0; i<N; i++) {
1355: slot = l->v + rows[i];
1356: for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1357: }
1358: if (diag != 0.0) {
1359: for (i=0; i<N; i++) {
1360: slot = l->v + (n+1)*rows[i];
1361: *slot = diag;
1362: }
1363: }
1364: return(0);
1365: }
1369: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1370: {
1371: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1374: if (mat->lda != A->rmap->n) SETERRQ(PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows");
1375: *array = mat->v;
1376: return(0);
1377: }
1381: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1382: {
1384: *array = 0; /* user cannot accidently use the array later */
1385: return(0);
1386: }
1390: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1391: {
1392: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1394: PetscInt i,j,nrows,ncols;
1395: const PetscInt *irow,*icol;
1396: PetscScalar *av,*bv,*v = mat->v;
1397: Mat newmat;
1400: ISGetIndices(isrow,&irow);
1401: ISGetIndices(iscol,&icol);
1402: ISGetLocalSize(isrow,&nrows);
1403: ISGetLocalSize(iscol,&ncols);
1404:
1405: /* Check submatrixcall */
1406: if (scall == MAT_REUSE_MATRIX) {
1407: PetscInt n_cols,n_rows;
1408: MatGetSize(*B,&n_rows,&n_cols);
1409: if (n_rows != nrows || n_cols != ncols) {
1410: /* resize the result result matrix to match number of requested rows/columns */
1411: MatSetSizes(*B,nrows,ncols,nrows,ncols);
1412: }
1413: newmat = *B;
1414: } else {
1415: /* Create and fill new matrix */
1416: MatCreate(((PetscObject)A)->comm,&newmat);
1417: MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1418: MatSetType(newmat,((PetscObject)A)->type_name);
1419: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1420: }
1422: /* Now extract the data pointers and do the copy,column at a time */
1423: bv = ((Mat_SeqDense*)newmat->data)->v;
1424:
1425: for (i=0; i<ncols; i++) {
1426: av = v + mat->lda*icol[i];
1427: for (j=0; j<nrows; j++) {
1428: *bv++ = av[irow[j]];
1429: }
1430: }
1432: /* Assemble the matrices so that the correct flags are set */
1433: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1434: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
1436: /* Free work space */
1437: ISRestoreIndices(isrow,&irow);
1438: ISRestoreIndices(iscol,&icol);
1439: *B = newmat;
1440: return(0);
1441: }
1445: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1446: {
1448: PetscInt i;
1451: if (scall == MAT_INITIAL_MATRIX) {
1452: PetscMalloc((n+1)*sizeof(Mat),B);
1453: }
1455: for (i=0; i<n; i++) {
1456: MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1457: }
1458: return(0);
1459: }
1463: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1464: {
1466: return(0);
1467: }
1471: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1472: {
1474: return(0);
1475: }
1479: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1480: {
1481: Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1483: PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;
1486: /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1487: if (A->ops->copy != B->ops->copy) {
1488: MatCopy_Basic(A,B,str);
1489: return(0);
1490: }
1491: if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1492: if (lda1>m || lda2>m) {
1493: for (j=0; j<n; j++) {
1494: PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1495: }
1496: } else {
1497: PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1498: }
1499: return(0);
1500: }
1504: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1505: {
1509: MatSeqDenseSetPreallocation(A,0);
1510: return(0);
1511: }
1515: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1516: {
1517: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1519: /* this will not be called before lda, Mmax, and Nmax have been set */
1520: m = PetscMax(m,M);
1521: n = PetscMax(n,N);
1522: 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);
1523: 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);
1524: A->rmap->n = A->rmap->N = m;
1525: A->cmap->n = A->cmap->N = n;
1526: if (a->changelda) a->lda = m;
1527: return(0);
1528: }
1532: static PetscErrorCode MatConjugate_SeqDense(Mat A)
1533: {
1534: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1535: PetscInt i,nz = A->rmap->n*A->cmap->n;
1536: PetscScalar *aa = a->v;
1539: for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1540: return(0);
1541: }
1545: static PetscErrorCode MatRealPart_SeqDense(Mat A)
1546: {
1547: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1548: PetscInt i,nz = A->rmap->n*A->cmap->n;
1549: PetscScalar *aa = a->v;
1552: for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1553: return(0);
1554: }
1558: static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1559: {
1560: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1561: PetscInt i,nz = A->rmap->n*A->cmap->n;
1562: PetscScalar *aa = a->v;
1565: for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1566: return(0);
1567: }
1569: /* ----------------------------------------------------------------*/
1572: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1573: {
1577: if (scall == MAT_INITIAL_MATRIX){
1578: MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1579: }
1580: MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1581: return(0);
1582: }
1586: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1587: {
1589: PetscInt m=A->rmap->n,n=B->cmap->n;
1590: Mat Cmat;
1593: 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);
1594: MatCreate(PETSC_COMM_SELF,&Cmat);
1595: MatSetSizes(Cmat,m,n,m,n);
1596: MatSetType(Cmat,MATSEQDENSE);
1597: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1598: Cmat->assembled = PETSC_TRUE;
1599: *C = Cmat;
1600: return(0);
1601: }
1605: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1606: {
1607: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1608: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1609: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1610: PetscBLASInt m,n,k;
1611: PetscScalar _DOne=1.0,_DZero=0.0;
1614: m = PetscBLASIntCast(A->rmap->n);
1615: n = PetscBLASIntCast(B->cmap->n);
1616: k = PetscBLASIntCast(A->cmap->n);
1617: BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1618: return(0);
1619: }
1623: PetscErrorCode MatMatMultTranspose_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1624: {
1628: if (scall == MAT_INITIAL_MATRIX){
1629: MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1630: }
1631: MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1632: return(0);
1633: }
1637: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1638: {
1640: PetscInt m=A->cmap->n,n=B->cmap->n;
1641: Mat Cmat;
1644: 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);
1645: MatCreate(PETSC_COMM_SELF,&Cmat);
1646: MatSetSizes(Cmat,m,n,m,n);
1647: MatSetType(Cmat,MATSEQDENSE);
1648: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1649: Cmat->assembled = PETSC_TRUE;
1650: *C = Cmat;
1651: return(0);
1652: }
1656: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1657: {
1658: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1659: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1660: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1661: PetscBLASInt m,n,k;
1662: PetscScalar _DOne=1.0,_DZero=0.0;
1665: m = PetscBLASIntCast(A->cmap->n);
1666: n = PetscBLASIntCast(B->cmap->n);
1667: k = PetscBLASIntCast(A->rmap->n);
1668: /*
1669: Note the m and n arguments below are the number rows and columns of A', not A!
1670: */
1671: BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1672: return(0);
1673: }
1677: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1678: {
1679: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1681: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1682: PetscScalar *x;
1683: MatScalar *aa = a->v;
1686: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1688: VecSet(v,0.0);
1689: VecGetArray(v,&x);
1690: VecGetLocalSize(v,&p);
1691: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1692: for (i=0; i<m; i++) {
1693: x[i] = aa[i]; if (idx) idx[i] = 0;
1694: for (j=1; j<n; j++){
1695: if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1696: }
1697: }
1698: VecRestoreArray(v,&x);
1699: return(0);
1700: }
1704: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1705: {
1706: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1708: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1709: PetscScalar *x;
1710: PetscReal atmp;
1711: MatScalar *aa = a->v;
1714: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1716: VecSet(v,0.0);
1717: VecGetArray(v,&x);
1718: VecGetLocalSize(v,&p);
1719: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1720: for (i=0; i<m; i++) {
1721: x[i] = PetscAbsScalar(aa[i]);
1722: for (j=1; j<n; j++){
1723: atmp = PetscAbsScalar(aa[i+m*j]);
1724: if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1725: }
1726: }
1727: VecRestoreArray(v,&x);
1728: return(0);
1729: }
1733: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1734: {
1735: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1737: PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p;
1738: PetscScalar *x;
1739: MatScalar *aa = a->v;
1742: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1744: VecSet(v,0.0);
1745: VecGetArray(v,&x);
1746: VecGetLocalSize(v,&p);
1747: if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1748: for (i=0; i<m; i++) {
1749: x[i] = aa[i]; if (idx) idx[i] = 0;
1750: for (j=1; j<n; j++){
1751: if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1752: }
1753: }
1754: VecRestoreArray(v,&x);
1755: return(0);
1756: }
1760: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1761: {
1762: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1764: PetscScalar *x;
1767: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1769: VecGetArray(v,&x);
1770: PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1771: VecRestoreArray(v,&x);
1772: return(0);
1773: }
1775: /* -------------------------------------------------------------------*/
1776: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1777: MatGetRow_SeqDense,
1778: MatRestoreRow_SeqDense,
1779: MatMult_SeqDense,
1780: /* 4*/ MatMultAdd_SeqDense,
1781: MatMultTranspose_SeqDense,
1782: MatMultTransposeAdd_SeqDense,
1783: 0,
1784: 0,
1785: 0,
1786: /*10*/ 0,
1787: MatLUFactor_SeqDense,
1788: MatCholeskyFactor_SeqDense,
1789: MatSOR_SeqDense,
1790: MatTranspose_SeqDense,
1791: /*15*/ MatGetInfo_SeqDense,
1792: MatEqual_SeqDense,
1793: MatGetDiagonal_SeqDense,
1794: MatDiagonalScale_SeqDense,
1795: MatNorm_SeqDense,
1796: /*20*/ MatAssemblyBegin_SeqDense,
1797: MatAssemblyEnd_SeqDense,
1798: MatSetOption_SeqDense,
1799: MatZeroEntries_SeqDense,
1800: /*24*/ MatZeroRows_SeqDense,
1801: 0,
1802: 0,
1803: 0,
1804: 0,
1805: /*29*/ MatSetUpPreallocation_SeqDense,
1806: 0,
1807: 0,
1808: MatGetArray_SeqDense,
1809: MatRestoreArray_SeqDense,
1810: /*34*/ MatDuplicate_SeqDense,
1811: 0,
1812: 0,
1813: 0,
1814: 0,
1815: /*39*/ MatAXPY_SeqDense,
1816: MatGetSubMatrices_SeqDense,
1817: 0,
1818: MatGetValues_SeqDense,
1819: MatCopy_SeqDense,
1820: /*44*/ MatGetRowMax_SeqDense,
1821: MatScale_SeqDense,
1822: 0,
1823: 0,
1824: 0,
1825: /*49*/ 0,
1826: 0,
1827: 0,
1828: 0,
1829: 0,
1830: /*54*/ 0,
1831: 0,
1832: 0,
1833: 0,
1834: 0,
1835: /*59*/ 0,
1836: MatDestroy_SeqDense,
1837: MatView_SeqDense,
1838: 0,
1839: 0,
1840: /*64*/ 0,
1841: 0,
1842: 0,
1843: 0,
1844: 0,
1845: /*69*/ MatGetRowMaxAbs_SeqDense,
1846: 0,
1847: 0,
1848: 0,
1849: 0,
1850: /*74*/ 0,
1851: 0,
1852: 0,
1853: 0,
1854: 0,
1855: /*79*/ 0,
1856: 0,
1857: 0,
1858: 0,
1859: /*83*/ MatLoad_SeqDense,
1860: 0,
1861: MatIsHermitian_SeqDense,
1862: 0,
1863: 0,
1864: 0,
1865: /*89*/ MatMatMult_SeqDense_SeqDense,
1866: MatMatMultSymbolic_SeqDense_SeqDense,
1867: MatMatMultNumeric_SeqDense_SeqDense,
1868: 0,
1869: 0,
1870: /*94*/ 0,
1871: MatMatMultTranspose_SeqDense_SeqDense,
1872: MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1873: MatMatMultTransposeNumeric_SeqDense_SeqDense,
1874: 0,
1875: /*99*/ 0,
1876: 0,
1877: 0,
1878: MatConjugate_SeqDense,
1879: MatSetSizes_SeqDense,
1880: /*104*/0,
1881: MatRealPart_SeqDense,
1882: MatImaginaryPart_SeqDense,
1883: 0,
1884: 0,
1885: /*109*/0,
1886: 0,
1887: MatGetRowMin_SeqDense,
1888: MatGetColumnVector_SeqDense
1889: };
1893: /*@C
1894: MatCreateSeqDense - Creates a sequential dense matrix that
1895: is stored in column major order (the usual Fortran 77 manner). Many
1896: of the matrix operations use the BLAS and LAPACK routines.
1898: Collective on MPI_Comm
1900: Input Parameters:
1901: + comm - MPI communicator, set to PETSC_COMM_SELF
1902: . m - number of rows
1903: . n - number of columns
1904: - data - optional location of matrix data in column major order. Set data=PETSC_NULL for PETSc
1905: to control all matrix memory allocation.
1907: Output Parameter:
1908: . A - the matrix
1910: Notes:
1911: The data input variable is intended primarily for Fortran programmers
1912: who wish to allocate their own matrix memory space. Most users should
1913: set data=PETSC_NULL.
1915: Level: intermediate
1917: .keywords: dense, matrix, LAPACK, BLAS
1919: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1920: @*/
1921: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1922: {
1926: MatCreate(comm,A);
1927: MatSetSizes(*A,m,n,m,n);
1928: MatSetType(*A,MATSEQDENSE);
1929: MatSeqDenseSetPreallocation(*A,data);
1930: return(0);
1931: }
1935: /*@C
1936: MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
1938: Collective on MPI_Comm
1940: Input Parameters:
1941: + A - the matrix
1942: - data - the array (or PETSC_NULL)
1944: Notes:
1945: The data input variable is intended primarily for Fortran programmers
1946: who wish to allocate their own matrix memory space. Most users should
1947: need not call this routine.
1949: Level: intermediate
1951: .keywords: dense, matrix, LAPACK, BLAS
1953: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues(), MatSeqDenseSetLDA()
1955: @*/
1956: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1957: {
1958: PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);
1961: PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1962: if (f) {
1963: (*f)(B,data);
1964: }
1965: return(0);
1966: }
1971: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1972: {
1973: Mat_SeqDense *b;
1977: B->preallocated = PETSC_TRUE;
1978: b = (Mat_SeqDense*)B->data;
1979: if (b->lda <= 0) b->lda = B->rmap->n;
1980: if (!data) { /* petsc-allocated storage */
1981: if (!b->user_alloc) { PetscFree(b->v); }
1982: PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
1983: PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
1984: PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
1985: b->user_alloc = PETSC_FALSE;
1986: } else { /* user-allocated storage */
1987: if (!b->user_alloc) { PetscFree(b->v); }
1988: b->v = data;
1989: b->user_alloc = PETSC_TRUE;
1990: }
1991: B->assembled = PETSC_TRUE;
1992: return(0);
1993: }
1998: /*@C
1999: MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
2001: Input parameter:
2002: + A - the matrix
2003: - lda - the leading dimension
2005: Notes:
2006: This routine is to be used in conjunction with MatSeqDenseSetPreallocation();
2007: it asserts that the preallocation has a leading dimension (the LDA parameter
2008: of Blas and Lapack fame) larger than M, the first dimension of the matrix.
2010: Level: intermediate
2012: .keywords: dense, matrix, LAPACK, BLAS
2014: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
2016: @*/
2017: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
2018: {
2019: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
2022: if (lda < B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n);
2023: b->lda = lda;
2024: b->changelda = PETSC_FALSE;
2025: b->Mmax = PetscMax(b->Mmax,lda);
2026: return(0);
2027: }
2029: /*MC
2030: MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
2032: Options Database Keys:
2033: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
2035: Level: beginner
2037: .seealso: MatCreateSeqDense()
2039: M*/
2044: PetscErrorCode MatCreate_SeqDense(Mat B)
2045: {
2046: Mat_SeqDense *b;
2048: PetscMPIInt size;
2051: MPI_Comm_size(((PetscObject)B)->comm,&size);
2052: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
2054: PetscLayoutSetBlockSize(B->rmap,1);
2055: PetscLayoutSetBlockSize(B->cmap,1);
2056: PetscLayoutSetUp(B->rmap);
2057: PetscLayoutSetUp(B->cmap);
2059: PetscNewLog(B,Mat_SeqDense,&b);
2060: PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2061: B->mapping = 0;
2062: B->data = (void*)b;
2065: b->pivots = 0;
2066: b->roworiented = PETSC_TRUE;
2067: b->v = 0;
2068: b->lda = B->rmap->n;
2069: b->changelda = PETSC_FALSE;
2070: b->Mmax = B->rmap->n;
2071: b->Nmax = B->cmap->n;
2074: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2075: "MatGetFactor_seqdense_petsc",
2076: MatGetFactor_seqdense_petsc);
2077: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2078: "MatSeqDenseSetPreallocation_SeqDense",
2079: MatSeqDenseSetPreallocation_SeqDense);
2080: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2081: "MatMatMult_SeqAIJ_SeqDense",
2082: MatMatMult_SeqAIJ_SeqDense);
2083: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2084: "MatMatMultSymbolic_SeqAIJ_SeqDense",
2085: MatMatMultSymbolic_SeqAIJ_SeqDense);
2086: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2087: "MatMatMultNumeric_SeqAIJ_SeqDense",
2088: MatMatMultNumeric_SeqAIJ_SeqDense);
2089: PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2090: return(0);
2091: }