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 = (PetscBLASInt)X->rmap.n*X->cmap.n,m=(PetscBLASInt)X->rmap.n,ldax = x->lda,lday=y->lda,one = 1;
21: if (ldax>m || lday>m) {
22: for (j=0; j<X->cmap.n; j++) {
23: BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
24: }
25: } else {
26: BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
27: }
28: PetscLogFlops(2*N-1);
29: return(0);
30: }
34: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
35: {
36: PetscInt N = A->rmap.n*A->cmap.n;
39: info->rows_global = (double)A->rmap.n;
40: info->columns_global = (double)A->cmap.n;
41: info->rows_local = (double)A->rmap.n;
42: info->columns_local = (double)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;
62: PetscBLASInt one = 1,lda = a->lda,j,nz;
66: if (lda>A->rmap.n) {
67: nz = (PetscBLASInt)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 = (PetscBLASInt)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:
101: /* ---------------------------------------------------------------*/
102: /* COMMENT: I have chosen to hide row permutation in the pivots,
103: rather than put it in the Mat->row slot.*/
106: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,MatFactorInfo *minfo)
107: {
108: #if defined(PETSC_MISSING_LAPACK_GETRF)
110: SETERRQ(PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
111: #else
112: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
114: PetscBLASInt n = (PetscBLASInt)A->cmap.n,m = (PetscBLASInt)A->rmap.n,info;
117: if (!mat->pivots) {
118: PetscMalloc((A->rmap.n+1)*sizeof(PetscBLASInt),&mat->pivots);
119: PetscLogObjectMemory(A,A->rmap.n*sizeof(PetscBLASInt));
120: }
121: A->factor = FACTOR_LU;
122: if (!A->rmap.n || !A->cmap.n) return(0);
123: LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
124: if (info<0) SETERRQ(PETSC_ERR_LIB,"Bad argument to LU factorization");
125: if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
126: PetscLogFlops((2*A->cmap.n*A->cmap.n*A->cmap.n)/3);
127: #endif
128: return(0);
129: }
133: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
134: {
135: Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l;
137: PetscInt lda = (PetscInt)mat->lda,j,m;
138: Mat newi;
141: MatCreate(((PetscObject)A)->comm,&newi);
142: MatSetSizes(newi,A->rmap.n,A->cmap.n,A->rmap.n,A->cmap.n);
143: MatSetType(newi,((PetscObject)A)->type_name);
144: MatSeqDenseSetPreallocation(newi,PETSC_NULL);
145: if (cpvalues == MAT_COPY_VALUES) {
146: l = (Mat_SeqDense*)newi->data;
147: if (lda>A->rmap.n) {
148: m = A->rmap.n;
149: for (j=0; j<A->cmap.n; j++) {
150: PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
151: }
152: } else {
153: PetscMemcpy(l->v,mat->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
154: }
155: }
156: newi->assembled = PETSC_TRUE;
157: *newmat = newi;
158: return(0);
159: }
163: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat A,IS row,IS col,MatFactorInfo *info,Mat *fact)
164: {
168: MatDuplicate_SeqDense(A,MAT_DO_NOT_COPY_VALUES,fact);
169: return(0);
170: }
174: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat A,MatFactorInfo *info_dummy,Mat *fact)
175: {
176: Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l = (Mat_SeqDense*)(*fact)->data;
178: PetscInt lda1=mat->lda,lda2=l->lda, m=A->rmap.n,n=A->cmap.n, j;
179: MatFactorInfo info;
182: /* copy the numerical values */
183: if (lda1>m || lda2>m ) {
184: for (j=0; j<n; j++) {
185: PetscMemcpy(l->v+j*lda2,mat->v+j*lda1,m*sizeof(PetscScalar));
186: }
187: } else {
188: PetscMemcpy(l->v,mat->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
189: }
190: (*fact)->factor = 0;
191: MatLUFactor(*fact,0,0,&info);
192: return(0);
193: }
197: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat A,IS row,MatFactorInfo *info,Mat *fact)
198: {
202: MatConvert(A,MATSAME,MAT_INITIAL_MATRIX,fact);
203: return(0);
204: }
208: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,MatFactorInfo *factinfo)
209: {
210: #if defined(PETSC_MISSING_LAPACK_POTRF)
212: SETERRQ(PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
213: #else
214: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
216: PetscBLASInt n = (PetscBLASInt)A->cmap.n,info;
217:
219: PetscFree(mat->pivots);
220: mat->pivots = 0;
222: if (!A->rmap.n || !A->cmap.n) return(0);
223: LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
224: if (info) SETERRQ1(PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
225: A->factor = FACTOR_CHOLESKY;
226: PetscLogFlops((A->cmap.n*A->cmap.n*A->cmap.n)/3);
227: #endif
228: return(0);
229: }
233: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat A,MatFactorInfo *info_dummy,Mat *fact)
234: {
236: MatFactorInfo info;
239: info.fill = 1.0;
240: MatCholeskyFactor_SeqDense(*fact,0,&info);
241: return(0);
242: }
246: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
247: {
248: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
250: PetscBLASInt m = (PetscBLASInt)A->rmap.n, one = 1,info;
251: PetscScalar *x,*y;
252:
254: VecGetArray(xx,&x);
255: VecGetArray(yy,&y);
256: PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
257: if (A->factor == FACTOR_LU) {
258: #if defined(PETSC_MISSING_LAPACK_GETRS)
259: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
260: #else
261: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
262: if (info) SETERRQ(PETSC_ERR_LIB,"GETRS - Bad solve");
263: #endif
264: } else if (A->factor == FACTOR_CHOLESKY){
265: #if defined(PETSC_MISSING_LAPACK_POTRS)
266: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
267: #else
268: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
269: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS Bad solve");
270: #endif
271: }
272: else SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
273: VecRestoreArray(xx,&x);
274: VecRestoreArray(yy,&y);
275: PetscLogFlops(2*A->cmap.n*A->cmap.n - A->cmap.n);
276: return(0);
277: }
281: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
282: {
283: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
285: PetscBLASInt m = (PetscBLASInt) A->rmap.n,one = 1,info;
286: PetscScalar *x,*y;
287:
289: VecGetArray(xx,&x);
290: VecGetArray(yy,&y);
291: PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
292: /* assume if pivots exist then use LU; else Cholesky */
293: if (mat->pivots) {
294: #if defined(PETSC_MISSING_LAPACK_GETRS)
295: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
296: #else
297: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
298: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
299: #endif
300: } else {
301: #if defined(PETSC_MISSING_LAPACK_POTRS)
302: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
303: #else
304: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
305: if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
306: #endif
307: }
308: VecRestoreArray(xx,&x);
309: VecRestoreArray(yy,&y);
310: PetscLogFlops(2*A->cmap.n*A->cmap.n - A->cmap.n);
311: return(0);
312: }
316: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
317: {
318: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
320: PetscBLASInt m = (PetscBLASInt)A->rmap.n,one = 1,info;
321: PetscScalar *x,*y,sone = 1.0;
322: Vec tmp = 0;
323:
325: VecGetArray(xx,&x);
326: VecGetArray(yy,&y);
327: if (!A->rmap.n || !A->cmap.n) return(0);
328: if (yy == zz) {
329: VecDuplicate(yy,&tmp);
330: PetscLogObjectParent(A,tmp);
331: VecCopy(yy,tmp);
332: }
333: PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
334: /* assume if pivots exist then use LU; else Cholesky */
335: if (mat->pivots) {
336: #if defined(PETSC_MISSING_LAPACK_GETRS)
337: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
338: #else
339: LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
340: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
341: #endif
342: } else {
343: #if defined(PETSC_MISSING_LAPACK_POTRS)
344: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
345: #else
346: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
347: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
348: #endif
349: }
350: if (tmp) {VecAXPY(yy,sone,tmp); VecDestroy(tmp);}
351: else {VecAXPY(yy,sone,zz);}
352: VecRestoreArray(xx,&x);
353: VecRestoreArray(yy,&y);
354: PetscLogFlops(2*A->cmap.n*A->cmap.n);
355: return(0);
356: }
360: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
361: {
362: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
364: PetscBLASInt m = (PetscBLASInt)A->rmap.n,one = 1,info;
365: PetscScalar *x,*y,sone = 1.0;
366: Vec tmp;
367:
369: if (!A->rmap.n || !A->cmap.n) return(0);
370: VecGetArray(xx,&x);
371: VecGetArray(yy,&y);
372: if (yy == zz) {
373: VecDuplicate(yy,&tmp);
374: PetscLogObjectParent(A,tmp);
375: VecCopy(yy,tmp);
376: }
377: PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
378: /* assume if pivots exist then use LU; else Cholesky */
379: if (mat->pivots) {
380: #if defined(PETSC_MISSING_LAPACK_GETRS)
381: SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
382: #else
383: LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
384: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
385: #endif
386: } else {
387: #if defined(PETSC_MISSING_LAPACK_POTRS)
388: SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
389: #else
390: LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
391: if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
392: #endif
393: }
394: if (tmp) {
395: VecAXPY(yy,sone,tmp);
396: VecDestroy(tmp);
397: } else {
398: VecAXPY(yy,sone,zz);
399: }
400: VecRestoreArray(xx,&x);
401: VecRestoreArray(yy,&y);
402: PetscLogFlops(2*A->cmap.n*A->cmap.n);
403: return(0);
404: }
405: /* ------------------------------------------------------------------*/
408: PetscErrorCode MatRelax_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
409: {
410: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
411: PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt;
413: PetscInt m = A->rmap.n,i;
414: #if !defined(PETSC_USE_COMPLEX)
415: PetscBLASInt bm = (PetscBLASInt)m, o = 1;
416: #endif
419: if (flag & SOR_ZERO_INITIAL_GUESS) {
420: /* this is a hack fix, should have another version without the second BLASdot */
421: VecSet(xx,zero);
422: }
423: VecGetArray(xx,&x);
424: VecGetArray(bb,&b);
425: its = its*lits;
426: if (its <= 0) SETERRQ2(PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
427: while (its--) {
428: if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
429: for (i=0; i<m; i++) {
430: #if defined(PETSC_USE_COMPLEX)
431: /* cannot use BLAS dot for complex because compiler/linker is
432: not happy about returning a double complex */
433: PetscInt _i;
434: PetscScalar sum = b[i];
435: for (_i=0; _i<m; _i++) {
436: sum -= PetscConj(v[i+_i*m])*x[_i];
437: }
438: xt = sum;
439: #else
440: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
441: #endif
442: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
443: }
444: }
445: if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
446: for (i=m-1; i>=0; i--) {
447: #if defined(PETSC_USE_COMPLEX)
448: /* cannot use BLAS dot for complex because compiler/linker is
449: not happy about returning a double complex */
450: PetscInt _i;
451: PetscScalar sum = b[i];
452: for (_i=0; _i<m; _i++) {
453: sum -= PetscConj(v[i+_i*m])*x[_i];
454: }
455: xt = sum;
456: #else
457: xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
458: #endif
459: x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
460: }
461: }
462: }
463: VecRestoreArray(bb,&b);
464: VecRestoreArray(xx,&x);
465: return(0);
466: }
468: /* -----------------------------------------------------------------*/
471: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
472: {
473: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
474: PetscScalar *v = mat->v,*x,*y;
476: PetscBLASInt m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n,_One=1;
477: PetscScalar _DOne=1.0,_DZero=0.0;
480: if (!A->rmap.n || !A->cmap.n) return(0);
481: VecGetArray(xx,&x);
482: VecGetArray(yy,&y);
483: BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
484: VecRestoreArray(xx,&x);
485: VecRestoreArray(yy,&y);
486: PetscLogFlops(2*A->rmap.n*A->cmap.n - A->cmap.n);
487: return(0);
488: }
492: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
493: {
494: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
495: PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
497: PetscBLASInt m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;
500: if (!A->rmap.n || !A->cmap.n) return(0);
501: VecGetArray(xx,&x);
502: VecGetArray(yy,&y);
503: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
504: VecRestoreArray(xx,&x);
505: VecRestoreArray(yy,&y);
506: PetscLogFlops(2*A->rmap.n*A->cmap.n - A->rmap.n);
507: return(0);
508: }
512: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
513: {
514: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
515: PetscScalar *v = mat->v,*x,*y,_DOne=1.0;
517: PetscBLASInt m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;
520: if (!A->rmap.n || !A->cmap.n) return(0);
521: if (zz != yy) {VecCopy(zz,yy);}
522: VecGetArray(xx,&x);
523: VecGetArray(yy,&y);
524: BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
525: VecRestoreArray(xx,&x);
526: VecRestoreArray(yy,&y);
527: PetscLogFlops(2*A->rmap.n*A->cmap.n);
528: return(0);
529: }
533: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
534: {
535: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
536: PetscScalar *v = mat->v,*x,*y;
538: PetscBLASInt m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;
539: PetscScalar _DOne=1.0;
542: if (!A->rmap.n || !A->cmap.n) return(0);
543: if (zz != yy) {VecCopy(zz,yy);}
544: VecGetArray(xx,&x);
545: VecGetArray(yy,&y);
546: BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
547: VecRestoreArray(xx,&x);
548: VecRestoreArray(yy,&y);
549: PetscLogFlops(2*A->rmap.n*A->cmap.n);
550: return(0);
551: }
553: /* -----------------------------------------------------------------*/
556: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
557: {
558: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
559: PetscScalar *v;
561: PetscInt i;
562:
564: *ncols = A->cmap.n;
565: if (cols) {
566: PetscMalloc((A->cmap.n+1)*sizeof(PetscInt),cols);
567: for (i=0; i<A->cmap.n; i++) (*cols)[i] = i;
568: }
569: if (vals) {
570: PetscMalloc((A->cmap.n+1)*sizeof(PetscScalar),vals);
571: v = mat->v + row;
572: for (i=0; i<A->cmap.n; i++) {(*vals)[i] = *v; v += mat->lda;}
573: }
574: return(0);
575: }
579: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
580: {
583: if (cols) {PetscFree(*cols);}
584: if (vals) {PetscFree(*vals); }
585: return(0);
586: }
587: /* ----------------------------------------------------------------*/
590: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
591: {
592: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
593: PetscInt i,j,idx=0;
594:
596: if (!mat->roworiented) {
597: if (addv == INSERT_VALUES) {
598: for (j=0; j<n; j++) {
599: if (indexn[j] < 0) {idx += m; continue;}
600: #if defined(PETSC_USE_DEBUG)
601: if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
602: #endif
603: for (i=0; i<m; i++) {
604: if (indexm[i] < 0) {idx++; continue;}
605: #if defined(PETSC_USE_DEBUG)
606: if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
607: #endif
608: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
609: }
610: }
611: } else {
612: for (j=0; j<n; j++) {
613: if (indexn[j] < 0) {idx += m; continue;}
614: #if defined(PETSC_USE_DEBUG)
615: if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
616: #endif
617: for (i=0; i<m; i++) {
618: if (indexm[i] < 0) {idx++; continue;}
619: #if defined(PETSC_USE_DEBUG)
620: if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
621: #endif
622: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
623: }
624: }
625: }
626: } else {
627: if (addv == INSERT_VALUES) {
628: for (i=0; i<m; i++) {
629: if (indexm[i] < 0) { idx += n; continue;}
630: #if defined(PETSC_USE_DEBUG)
631: if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
632: #endif
633: for (j=0; j<n; j++) {
634: if (indexn[j] < 0) { idx++; continue;}
635: #if defined(PETSC_USE_DEBUG)
636: if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
637: #endif
638: mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
639: }
640: }
641: } else {
642: for (i=0; i<m; i++) {
643: if (indexm[i] < 0) { idx += n; continue;}
644: #if defined(PETSC_USE_DEBUG)
645: if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
646: #endif
647: for (j=0; j<n; j++) {
648: if (indexn[j] < 0) { idx++; continue;}
649: #if defined(PETSC_USE_DEBUG)
650: if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
651: #endif
652: mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
653: }
654: }
655: }
656: }
657: return(0);
658: }
662: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
663: {
664: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
665: PetscInt i,j;
668: /* row-oriented output */
669: for (i=0; i<m; i++) {
670: if (indexm[i] < 0) {v += n;continue;}
671: if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap.n);
672: for (j=0; j<n; j++) {
673: if (indexn[j] < 0) {v++; continue;}
674: if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap.n);
675: *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
676: }
677: }
678: return(0);
679: }
681: /* -----------------------------------------------------------------*/
683: #include petscsys.h
687: PetscErrorCode MatLoad_SeqDense(PetscViewer viewer, MatType type,Mat *A)
688: {
689: Mat_SeqDense *a;
690: Mat B;
692: PetscInt *scols,i,j,nz,header[4];
693: int fd;
694: PetscMPIInt size;
695: PetscInt *rowlengths = 0,M,N,*cols;
696: PetscScalar *vals,*svals,*v,*w;
697: MPI_Comm comm = ((PetscObject)viewer)->comm;
700: MPI_Comm_size(comm,&size);
701: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
702: PetscViewerBinaryGetDescriptor(viewer,&fd);
703: PetscBinaryRead(fd,header,4,PETSC_INT);
704: if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
705: M = header[1]; N = header[2]; nz = header[3];
707: if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
708: MatCreate(comm,A);
709: MatSetSizes(*A,M,N,M,N);
710: MatSetType(*A,type);
711: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
712: B = *A;
713: a = (Mat_SeqDense*)B->data;
714: v = a->v;
715: /* Allocate some temp space to read in the values and then flip them
716: from row major to column major */
717: PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
718: /* read in nonzero values */
719: PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
720: /* now flip the values and store them in the matrix*/
721: for (j=0; j<N; j++) {
722: for (i=0; i<M; i++) {
723: *v++ =w[i*N+j];
724: }
725: }
726: PetscFree(w);
727: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
728: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
729: } else {
730: /* read row lengths */
731: PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
732: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
734: /* create our matrix */
735: MatCreate(comm,A);
736: MatSetSizes(*A,M,N,M,N);
737: MatSetType(*A,type);
738: MatSeqDenseSetPreallocation(*A,PETSC_NULL);
739: B = *A;
740: a = (Mat_SeqDense*)B->data;
741: v = a->v;
743: /* read column indices and nonzeros */
744: PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
745: cols = scols;
746: PetscBinaryRead(fd,cols,nz,PETSC_INT);
747: PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
748: vals = svals;
749: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
751: /* insert into matrix */
752: for (i=0; i<M; i++) {
753: for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
754: svals += rowlengths[i]; scols += rowlengths[i];
755: }
756: PetscFree(vals);
757: PetscFree(cols);
758: PetscFree(rowlengths);
760: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
761: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
762: }
763: return(0);
764: }
766: #include petscsys.h
770: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
771: {
772: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
773: PetscErrorCode ierr;
774: PetscInt i,j;
775: const char *name;
776: PetscScalar *v;
777: PetscViewerFormat format;
778: #if defined(PETSC_USE_COMPLEX)
779: PetscTruth allreal = PETSC_TRUE;
780: #endif
783: PetscObjectGetName((PetscObject)A,&name);
784: PetscViewerGetFormat(viewer,&format);
785: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
786: return(0); /* do nothing for now */
787: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
788: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
789: for (i=0; i<A->rmap.n; i++) {
790: v = a->v + i;
791: PetscViewerASCIIPrintf(viewer,"row %D:",i);
792: for (j=0; j<A->cmap.n; j++) {
793: #if defined(PETSC_USE_COMPLEX)
794: if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
795: PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
796: } else if (PetscRealPart(*v)) {
797: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
798: }
799: #else
800: if (*v) {
801: PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
802: }
803: #endif
804: v += a->lda;
805: }
806: PetscViewerASCIIPrintf(viewer,"\n");
807: }
808: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
809: } else {
810: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
811: #if defined(PETSC_USE_COMPLEX)
812: /* determine if matrix has all real values */
813: v = a->v;
814: for (i=0; i<A->rmap.n*A->cmap.n; i++) {
815: if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
816: }
817: #endif
818: if (format == PETSC_VIEWER_ASCII_MATLAB) {
819: PetscObjectGetName((PetscObject)A,&name);
820: PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap.n,A->cmap.n);
821: PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap.n,A->cmap.n);
822: PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
823: }
825: for (i=0; i<A->rmap.n; i++) {
826: v = a->v + i;
827: for (j=0; j<A->cmap.n; j++) {
828: #if defined(PETSC_USE_COMPLEX)
829: if (allreal) {
830: PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
831: } else {
832: PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
833: }
834: #else
835: PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
836: #endif
837: v += a->lda;
838: }
839: PetscViewerASCIIPrintf(viewer,"\n");
840: }
841: if (format == PETSC_VIEWER_ASCII_MATLAB) {
842: PetscViewerASCIIPrintf(viewer,"];\n");
843: }
844: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
845: }
846: PetscViewerFlush(viewer);
847: return(0);
848: }
852: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
853: {
854: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
855: PetscErrorCode ierr;
856: int fd;
857: PetscInt ict,j,n = A->cmap.n,m = A->rmap.n,i,*col_lens,nz = m*n;
858: PetscScalar *v,*anonz,*vals;
859: PetscViewerFormat format;
860:
862: PetscViewerBinaryGetDescriptor(viewer,&fd);
864: PetscViewerGetFormat(viewer,&format);
865: if (format == PETSC_VIEWER_BINARY_NATIVE) {
866: /* store the matrix as a dense matrix */
867: PetscMalloc(4*sizeof(PetscInt),&col_lens);
868: col_lens[0] = MAT_FILE_COOKIE;
869: col_lens[1] = m;
870: col_lens[2] = n;
871: col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
872: PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
873: PetscFree(col_lens);
875: /* write out matrix, by rows */
876: PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
877: v = a->v;
878: for (j=0; j<n; j++) {
879: for (i=0; i<m; i++) {
880: vals[j + i*n] = *v++;
881: }
882: }
883: PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
884: PetscFree(vals);
885: } else {
886: PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
887: col_lens[0] = MAT_FILE_COOKIE;
888: col_lens[1] = m;
889: col_lens[2] = n;
890: col_lens[3] = nz;
892: /* store lengths of each row and write (including header) to file */
893: for (i=0; i<m; i++) col_lens[4+i] = n;
894: PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);
896: /* Possibly should write in smaller increments, not whole matrix at once? */
897: /* store column indices (zero start index) */
898: ict = 0;
899: for (i=0; i<m; i++) {
900: for (j=0; j<n; j++) col_lens[ict++] = j;
901: }
902: PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
903: PetscFree(col_lens);
905: /* store nonzero values */
906: PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
907: ict = 0;
908: for (i=0; i<m; i++) {
909: v = a->v + i;
910: for (j=0; j<n; j++) {
911: anonz[ict++] = *v; v += a->lda;
912: }
913: }
914: PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
915: PetscFree(anonz);
916: }
917: return(0);
918: }
922: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
923: {
924: Mat A = (Mat) Aa;
925: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
926: PetscErrorCode ierr;
927: PetscInt m = A->rmap.n,n = A->cmap.n,color,i,j;
928: PetscScalar *v = a->v;
929: PetscViewer viewer;
930: PetscDraw popup;
931: PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
932: PetscViewerFormat format;
936: PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
937: PetscViewerGetFormat(viewer,&format);
938: PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);
940: /* Loop over matrix elements drawing boxes */
941: if (format != PETSC_VIEWER_DRAW_CONTOUR) {
942: /* Blue for negative and Red for positive */
943: color = PETSC_DRAW_BLUE;
944: for(j = 0; j < n; j++) {
945: x_l = j;
946: x_r = x_l + 1.0;
947: for(i = 0; i < m; i++) {
948: y_l = m - i - 1.0;
949: y_r = y_l + 1.0;
950: #if defined(PETSC_USE_COMPLEX)
951: if (PetscRealPart(v[j*m+i]) > 0.) {
952: color = PETSC_DRAW_RED;
953: } else if (PetscRealPart(v[j*m+i]) < 0.) {
954: color = PETSC_DRAW_BLUE;
955: } else {
956: continue;
957: }
958: #else
959: if (v[j*m+i] > 0.) {
960: color = PETSC_DRAW_RED;
961: } else if (v[j*m+i] < 0.) {
962: color = PETSC_DRAW_BLUE;
963: } else {
964: continue;
965: }
966: #endif
967: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
968: }
969: }
970: } else {
971: /* use contour shading to indicate magnitude of values */
972: /* first determine max of all nonzero values */
973: for(i = 0; i < m*n; i++) {
974: if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
975: }
976: scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
977: PetscDrawGetPopup(draw,&popup);
978: if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
979: for(j = 0; j < n; j++) {
980: x_l = j;
981: x_r = x_l + 1.0;
982: for(i = 0; i < m; i++) {
983: y_l = m - i - 1.0;
984: y_r = y_l + 1.0;
985: color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
986: PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
987: }
988: }
989: }
990: return(0);
991: }
995: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
996: {
997: PetscDraw draw;
998: PetscTruth isnull;
999: PetscReal xr,yr,xl,yl,h,w;
1003: PetscViewerDrawGetDraw(viewer,0,&draw);
1004: PetscDrawIsNull(draw,&isnull);
1005: if (isnull) return(0);
1007: PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1008: xr = A->cmap.n; yr = A->rmap.n; h = yr/10.0; w = xr/10.0;
1009: xr += w; yr += h; xl = -w; yl = -h;
1010: PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1011: PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1012: PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1013: return(0);
1014: }
1018: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1019: {
1021: PetscTruth iascii,isbinary,isdraw;
1024: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
1025: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
1026: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
1028: if (iascii) {
1029: MatView_SeqDense_ASCII(A,viewer);
1030: } else if (isbinary) {
1031: MatView_SeqDense_Binary(A,viewer);
1032: } else if (isdraw) {
1033: MatView_SeqDense_Draw(A,viewer);
1034: } else {
1035: SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1036: }
1037: return(0);
1038: }
1042: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1043: {
1044: Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1048: #if defined(PETSC_USE_LOG)
1049: PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap.n,mat->cmap.n);
1050: #endif
1051: PetscFree(l->pivots);
1052: if (!l->user_alloc) {PetscFree(l->v);}
1053: PetscFree(l);
1055: PetscObjectChangeTypeName((PetscObject)mat,0);
1056: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1057: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1058: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1059: PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1060: return(0);
1061: }
1065: PetscErrorCode MatTranspose_SeqDense(Mat A,Mat *matout)
1066: {
1067: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1069: PetscInt k,j,m,n,M;
1070: PetscScalar *v,tmp;
1073: v = mat->v; m = A->rmap.n; M = mat->lda; n = A->cmap.n;
1074: if (!matout) { /* in place transpose */
1075: if (m != n) {
1076: SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1077: } else {
1078: for (j=0; j<m; j++) {
1079: for (k=0; k<j; k++) {
1080: tmp = v[j + k*M];
1081: v[j + k*M] = v[k + j*M];
1082: v[k + j*M] = tmp;
1083: }
1084: }
1085: }
1086: } else { /* out-of-place transpose */
1087: Mat tmat;
1088: Mat_SeqDense *tmatd;
1089: PetscScalar *v2;
1091: MatCreate(((PetscObject)A)->comm,&tmat);
1092: MatSetSizes(tmat,A->cmap.n,A->rmap.n,A->cmap.n,A->rmap.n);
1093: MatSetType(tmat,((PetscObject)A)->type_name);
1094: MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1095: tmatd = (Mat_SeqDense*)tmat->data;
1096: v = mat->v; v2 = tmatd->v;
1097: for (j=0; j<n; j++) {
1098: for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1099: }
1100: MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1101: MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1102: *matout = tmat;
1103: }
1104: return(0);
1105: }
1109: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1110: {
1111: Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1112: Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1113: PetscInt i,j;
1114: PetscScalar *v1 = mat1->v,*v2 = mat2->v;
1117: if (A1->rmap.n != A2->rmap.n) {*flg = PETSC_FALSE; return(0);}
1118: if (A1->cmap.n != A2->cmap.n) {*flg = PETSC_FALSE; return(0);}
1119: for (i=0; i<A1->rmap.n; i++) {
1120: v1 = mat1->v+i; v2 = mat2->v+i;
1121: for (j=0; j<A1->cmap.n; j++) {
1122: if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1123: v1 += mat1->lda; v2 += mat2->lda;
1124: }
1125: }
1126: *flg = PETSC_TRUE;
1127: return(0);
1128: }
1132: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1133: {
1134: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1136: PetscInt i,n,len;
1137: PetscScalar *x,zero = 0.0;
1140: VecSet(v,zero);
1141: VecGetSize(v,&n);
1142: VecGetArray(v,&x);
1143: len = PetscMin(A->rmap.n,A->cmap.n);
1144: if (n != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1145: for (i=0; i<len; i++) {
1146: x[i] = mat->v[i*mat->lda + i];
1147: }
1148: VecRestoreArray(v,&x);
1149: return(0);
1150: }
1154: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1155: {
1156: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1157: PetscScalar *l,*r,x,*v;
1159: PetscInt i,j,m = A->rmap.n,n = A->cmap.n;
1162: if (ll) {
1163: VecGetSize(ll,&m);
1164: VecGetArray(ll,&l);
1165: if (m != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1166: for (i=0; i<m; i++) {
1167: x = l[i];
1168: v = mat->v + i;
1169: for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1170: }
1171: VecRestoreArray(ll,&l);
1172: PetscLogFlops(n*m);
1173: }
1174: if (rr) {
1175: VecGetSize(rr,&n);
1176: VecGetArray(rr,&r);
1177: if (n != A->cmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1178: for (i=0; i<n; i++) {
1179: x = r[i];
1180: v = mat->v + i*m;
1181: for (j=0; j<m; j++) { (*v++) *= x;}
1182: }
1183: VecRestoreArray(rr,&r);
1184: PetscLogFlops(n*m);
1185: }
1186: return(0);
1187: }
1191: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1192: {
1193: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1194: PetscScalar *v = mat->v;
1195: PetscReal sum = 0.0;
1196: PetscInt lda=mat->lda,m=A->rmap.n,i,j;
1200: if (type == NORM_FROBENIUS) {
1201: if (lda>m) {
1202: for (j=0; j<A->cmap.n; j++) {
1203: v = mat->v+j*lda;
1204: for (i=0; i<m; i++) {
1205: #if defined(PETSC_USE_COMPLEX)
1206: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1207: #else
1208: sum += (*v)*(*v); v++;
1209: #endif
1210: }
1211: }
1212: } else {
1213: for (i=0; i<A->cmap.n*A->rmap.n; i++) {
1214: #if defined(PETSC_USE_COMPLEX)
1215: sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1216: #else
1217: sum += (*v)*(*v); v++;
1218: #endif
1219: }
1220: }
1221: *nrm = sqrt(sum);
1222: PetscLogFlops(2*A->cmap.n*A->rmap.n);
1223: } else if (type == NORM_1) {
1224: *nrm = 0.0;
1225: for (j=0; j<A->cmap.n; j++) {
1226: v = mat->v + j*mat->lda;
1227: sum = 0.0;
1228: for (i=0; i<A->rmap.n; i++) {
1229: sum += PetscAbsScalar(*v); v++;
1230: }
1231: if (sum > *nrm) *nrm = sum;
1232: }
1233: PetscLogFlops(A->cmap.n*A->rmap.n);
1234: } else if (type == NORM_INFINITY) {
1235: *nrm = 0.0;
1236: for (j=0; j<A->rmap.n; j++) {
1237: v = mat->v + j;
1238: sum = 0.0;
1239: for (i=0; i<A->cmap.n; i++) {
1240: sum += PetscAbsScalar(*v); v += mat->lda;
1241: }
1242: if (sum > *nrm) *nrm = sum;
1243: }
1244: PetscLogFlops(A->cmap.n*A->rmap.n);
1245: } else {
1246: SETERRQ(PETSC_ERR_SUP,"No two norm");
1247: }
1248: return(0);
1249: }
1253: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscTruth flg)
1254: {
1255: Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1257:
1259: switch (op) {
1260: case MAT_ROW_ORIENTED:
1261: aij->roworiented = flg;
1262: break;
1263: case MAT_NEW_NONZERO_LOCATIONS:
1264: case MAT_NEW_NONZERO_LOCATION_ERR:
1265: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1266: case MAT_NEW_DIAGONALS:
1267: case MAT_IGNORE_OFF_PROC_ENTRIES:
1268: case MAT_USE_HASH_TABLE:
1269: case MAT_SYMMETRIC:
1270: case MAT_STRUCTURALLY_SYMMETRIC:
1271: case MAT_HERMITIAN:
1272: case MAT_SYMMETRY_ETERNAL:
1273: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1274: break;
1275: default:
1276: SETERRQ1(PETSC_ERR_SUP,"unknown option %d",op);
1277: }
1278: return(0);
1279: }
1283: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1284: {
1285: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1287: PetscInt lda=l->lda,m=A->rmap.n,j;
1290: if (lda>m) {
1291: for (j=0; j<A->cmap.n; j++) {
1292: PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1293: }
1294: } else {
1295: PetscMemzero(l->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
1296: }
1297: return(0);
1298: }
1302: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
1303: {
1304: Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1305: PetscInt n = A->cmap.n,i,j;
1306: PetscScalar *slot;
1309: for (i=0; i<N; i++) {
1310: slot = l->v + rows[i];
1311: for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1312: }
1313: if (diag != 0.0) {
1314: for (i=0; i<N; i++) {
1315: slot = l->v + (n+1)*rows[i];
1316: *slot = diag;
1317: }
1318: }
1319: return(0);
1320: }
1324: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1325: {
1326: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1329: if (mat->lda != A->rmap.n) SETERRQ(PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows");
1330: *array = mat->v;
1331: return(0);
1332: }
1336: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1337: {
1339: *array = 0; /* user cannot accidently use the array later */
1340: return(0);
1341: }
1345: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1346: {
1347: Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1349: PetscInt i,j,*irow,*icol,nrows,ncols;
1350: PetscScalar *av,*bv,*v = mat->v;
1351: Mat newmat;
1354: ISGetIndices(isrow,&irow);
1355: ISGetIndices(iscol,&icol);
1356: ISGetLocalSize(isrow,&nrows);
1357: ISGetLocalSize(iscol,&ncols);
1358:
1359: /* Check submatrixcall */
1360: if (scall == MAT_REUSE_MATRIX) {
1361: PetscInt n_cols,n_rows;
1362: MatGetSize(*B,&n_rows,&n_cols);
1363: if (n_rows != nrows || n_cols != ncols) {
1364: /* resize the result result matrix to match number of requested rows/columns */
1365: MatSetSizes(*B,nrows,nrows,nrows,nrows);
1366: }
1367: newmat = *B;
1368: } else {
1369: /* Create and fill new matrix */
1370: MatCreate(((PetscObject)A)->comm,&newmat);
1371: MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1372: MatSetType(newmat,((PetscObject)A)->type_name);
1373: MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1374: }
1376: /* Now extract the data pointers and do the copy,column at a time */
1377: bv = ((Mat_SeqDense*)newmat->data)->v;
1378:
1379: for (i=0; i<ncols; i++) {
1380: av = v + mat->lda*icol[i];
1381: for (j=0; j<nrows; j++) {
1382: *bv++ = av[irow[j]];
1383: }
1384: }
1386: /* Assemble the matrices so that the correct flags are set */
1387: MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1388: MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
1390: /* Free work space */
1391: ISRestoreIndices(isrow,&irow);
1392: ISRestoreIndices(iscol,&icol);
1393: *B = newmat;
1394: return(0);
1395: }
1399: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1400: {
1402: PetscInt i;
1405: if (scall == MAT_INITIAL_MATRIX) {
1406: PetscMalloc((n+1)*sizeof(Mat),B);
1407: }
1409: for (i=0; i<n; i++) {
1410: MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1411: }
1412: return(0);
1413: }
1417: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1418: {
1420: return(0);
1421: }
1425: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1426: {
1428: return(0);
1429: }
1433: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1434: {
1435: Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1437: PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap.n,n=A->cmap.n, j;
1440: /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1441: if (A->ops->copy != B->ops->copy) {
1442: MatCopy_Basic(A,B,str);
1443: return(0);
1444: }
1445: if (m != B->rmap.n || n != B->cmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1446: if (lda1>m || lda2>m) {
1447: for (j=0; j<n; j++) {
1448: PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1449: }
1450: } else {
1451: PetscMemcpy(b->v,a->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
1452: }
1453: return(0);
1454: }
1458: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1459: {
1463: MatSeqDenseSetPreallocation(A,0);
1464: return(0);
1465: }
1469: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1470: {
1471: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1474: /* this will not be called before lda, Mmax, and Nmax have been set */
1475: m = PetscMax(m,M);
1476: n = PetscMax(n,N);
1477: 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);
1478: 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);
1479: A->rmap.n = A->rmap.n = m;
1480: A->cmap.n = A->cmap.N = n;
1481: if (a->changelda) a->lda = m;
1482: PetscMemzero(a->v,m*n*sizeof(PetscScalar));
1483: return(0);
1484: }
1486: /* ----------------------------------------------------------------*/
1489: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1490: {
1494: if (scall == MAT_INITIAL_MATRIX){
1495: MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1496: }
1497: MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1498: return(0);
1499: }
1503: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1504: {
1506: PetscInt m=A->rmap.n,n=B->cmap.n;
1507: Mat Cmat;
1510: 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);
1511: MatCreate(PETSC_COMM_SELF,&Cmat);
1512: MatSetSizes(Cmat,m,n,m,n);
1513: MatSetType(Cmat,MATSEQDENSE);
1514: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1515: Cmat->assembled = PETSC_TRUE;
1516: *C = Cmat;
1517: return(0);
1518: }
1522: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1523: {
1524: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1525: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1526: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1527: PetscBLASInt m=(PetscBLASInt)A->rmap.n,n=(PetscBLASInt)B->cmap.n,k=(PetscBLASInt)A->cmap.n;
1528: PetscScalar _DOne=1.0,_DZero=0.0;
1531: BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1532: return(0);
1533: }
1537: PetscErrorCode MatMatMultTranspose_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1538: {
1542: if (scall == MAT_INITIAL_MATRIX){
1543: MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1544: }
1545: MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1546: return(0);
1547: }
1551: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1552: {
1554: PetscInt m=A->cmap.n,n=B->cmap.n;
1555: Mat Cmat;
1558: 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);
1559: MatCreate(PETSC_COMM_SELF,&Cmat);
1560: MatSetSizes(Cmat,m,n,m,n);
1561: MatSetType(Cmat,MATSEQDENSE);
1562: MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1563: Cmat->assembled = PETSC_TRUE;
1564: *C = Cmat;
1565: return(0);
1566: }
1570: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1571: {
1572: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1573: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1574: Mat_SeqDense *c = (Mat_SeqDense*)C->data;
1575: PetscBLASInt m=(PetscBLASInt)A->cmap.n,n=(PetscBLASInt)B->cmap.n,k=(PetscBLASInt)A->rmap.n;
1576: PetscScalar _DOne=1.0,_DZero=0.0;
1579: BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1580: return(0);
1581: }
1585: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1586: {
1587: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1589: PetscInt i,j,m = A->rmap.n,n = A->cmap.n,p;
1590: PetscScalar *x;
1591: MatScalar *aa = a->v;
1594: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1596: VecSet(v,0.0);
1597: VecGetArray(v,&x);
1598: VecGetLocalSize(v,&p);
1599: if (p != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1600: for (i=0; i<m; i++) {
1601: x[i] = aa[i]; if (idx) idx[i] = 0;
1602: for (j=1; j<n; j++){
1603: if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1604: }
1605: }
1606: VecRestoreArray(v,&x);
1607: return(0);
1608: }
1612: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1613: {
1614: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1616: PetscInt i,j,m = A->rmap.n,n = A->cmap.n,p;
1617: PetscScalar *x;
1618: PetscReal atmp;
1619: MatScalar *aa = a->v;
1622: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1624: VecSet(v,0.0);
1625: VecGetArray(v,&x);
1626: VecGetLocalSize(v,&p);
1627: if (p != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1628: for (i=0; i<m; i++) {
1629: x[i] = PetscAbsScalar(aa[i]); if (idx) idx[i] = 0;
1630: for (j=1; j<n; j++){
1631: atmp = PetscAbsScalar(aa[i+m*j]);
1632: if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1633: }
1634: }
1635: VecRestoreArray(v,&x);
1636: return(0);
1637: }
1641: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1642: {
1643: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1645: PetscInt i,j,m = A->rmap.n,n = A->cmap.n,p;
1646: PetscScalar *x;
1647: MatScalar *aa = a->v;
1650: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1652: VecSet(v,0.0);
1653: VecGetArray(v,&x);
1654: VecGetLocalSize(v,&p);
1655: if (p != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1656: for (i=0; i<m; i++) {
1657: x[i] = aa[i]; if (idx) idx[i] = 0;
1658: for (j=1; j<n; j++){
1659: if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1660: }
1661: }
1662: VecRestoreArray(v,&x);
1663: return(0);
1664: }
1668: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1669: {
1670: Mat_SeqDense *a = (Mat_SeqDense*)A->data;
1672: PetscScalar *x;
1675: if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1677: VecGetArray(v,&x);
1678: PetscMemcpy(x,a->v+col*a->lda,A->rmap.n*sizeof(PetscScalar));
1679: VecRestoreArray(v,&x);
1680: return(0);
1681: }
1683: /* -------------------------------------------------------------------*/
1684: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1685: MatGetRow_SeqDense,
1686: MatRestoreRow_SeqDense,
1687: MatMult_SeqDense,
1688: /* 4*/ MatMultAdd_SeqDense,
1689: MatMultTranspose_SeqDense,
1690: MatMultTransposeAdd_SeqDense,
1691: MatSolve_SeqDense,
1692: MatSolveAdd_SeqDense,
1693: MatSolveTranspose_SeqDense,
1694: /*10*/ MatSolveTransposeAdd_SeqDense,
1695: MatLUFactor_SeqDense,
1696: MatCholeskyFactor_SeqDense,
1697: MatRelax_SeqDense,
1698: MatTranspose_SeqDense,
1699: /*15*/ MatGetInfo_SeqDense,
1700: MatEqual_SeqDense,
1701: MatGetDiagonal_SeqDense,
1702: MatDiagonalScale_SeqDense,
1703: MatNorm_SeqDense,
1704: /*20*/ MatAssemblyBegin_SeqDense,
1705: MatAssemblyEnd_SeqDense,
1706: 0,
1707: MatSetOption_SeqDense,
1708: MatZeroEntries_SeqDense,
1709: /*25*/ MatZeroRows_SeqDense,
1710: MatLUFactorSymbolic_SeqDense,
1711: MatLUFactorNumeric_SeqDense,
1712: MatCholeskyFactorSymbolic_SeqDense,
1713: MatCholeskyFactorNumeric_SeqDense,
1714: /*30*/ MatSetUpPreallocation_SeqDense,
1715: 0,
1716: 0,
1717: MatGetArray_SeqDense,
1718: MatRestoreArray_SeqDense,
1719: /*35*/ MatDuplicate_SeqDense,
1720: 0,
1721: 0,
1722: 0,
1723: 0,
1724: /*40*/ MatAXPY_SeqDense,
1725: MatGetSubMatrices_SeqDense,
1726: 0,
1727: MatGetValues_SeqDense,
1728: MatCopy_SeqDense,
1729: /*45*/ MatGetRowMax_SeqDense,
1730: MatScale_SeqDense,
1731: 0,
1732: 0,
1733: 0,
1734: /*50*/ 0,
1735: 0,
1736: 0,
1737: 0,
1738: 0,
1739: /*55*/ 0,
1740: 0,
1741: 0,
1742: 0,
1743: 0,
1744: /*60*/ 0,
1745: MatDestroy_SeqDense,
1746: MatView_SeqDense,
1747: 0,
1748: 0,
1749: /*65*/ 0,
1750: 0,
1751: 0,
1752: 0,
1753: 0,
1754: /*70*/ MatGetRowMaxAbs_SeqDense,
1755: 0,
1756: 0,
1757: 0,
1758: 0,
1759: /*75*/ 0,
1760: 0,
1761: 0,
1762: 0,
1763: 0,
1764: /*80*/ 0,
1765: 0,
1766: 0,
1767: 0,
1768: /*84*/ MatLoad_SeqDense,
1769: 0,
1770: MatIsHermitian_SeqDense,
1771: 0,
1772: 0,
1773: 0,
1774: /*90*/ MatMatMult_SeqDense_SeqDense,
1775: MatMatMultSymbolic_SeqDense_SeqDense,
1776: MatMatMultNumeric_SeqDense_SeqDense,
1777: 0,
1778: 0,
1779: /*95*/ 0,
1780: MatMatMultTranspose_SeqDense_SeqDense,
1781: MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1782: MatMatMultTransposeNumeric_SeqDense_SeqDense,
1783: 0,
1784: /*100*/0,
1785: 0,
1786: 0,
1787: 0,
1788: MatSetSizes_SeqDense,
1789: 0,
1790: 0,
1791: 0,
1792: 0,
1793: 0,
1794: /*110*/0,
1795: 0,
1796: MatGetRowMin_SeqDense,
1797: MatGetColumnVector_SeqDense
1798: };
1802: /*@C
1803: MatCreateSeqDense - Creates a sequential dense matrix that
1804: is stored in column major order (the usual Fortran 77 manner). Many
1805: of the matrix operations use the BLAS and LAPACK routines.
1807: Collective on MPI_Comm
1809: Input Parameters:
1810: + comm - MPI communicator, set to PETSC_COMM_SELF
1811: . m - number of rows
1812: . n - number of columns
1813: - data - optional location of matrix data. Set data=PETSC_NULL for PETSc
1814: to control all matrix memory allocation.
1816: Output Parameter:
1817: . A - the matrix
1819: Notes:
1820: The data input variable is intended primarily for Fortran programmers
1821: who wish to allocate their own matrix memory space. Most users should
1822: set data=PETSC_NULL.
1824: Level: intermediate
1826: .keywords: dense, matrix, LAPACK, BLAS
1828: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1829: @*/
1830: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1831: {
1835: MatCreate(comm,A);
1836: MatSetSizes(*A,m,n,m,n);
1837: MatSetType(*A,MATSEQDENSE);
1838: MatSeqDenseSetPreallocation(*A,data);
1839: return(0);
1840: }
1844: /*@C
1845: MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements
1847: Collective on MPI_Comm
1849: Input Parameters:
1850: + A - the matrix
1851: - data - the array (or PETSC_NULL)
1853: Notes:
1854: The data input variable is intended primarily for Fortran programmers
1855: who wish to allocate their own matrix memory space. Most users should
1856: need not call this routine.
1858: Level: intermediate
1860: .keywords: dense, matrix, LAPACK, BLAS
1862: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1863: @*/
1864: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1865: {
1866: PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);
1869: PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1870: if (f) {
1871: (*f)(B,data);
1872: }
1873: return(0);
1874: }
1879: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1880: {
1881: Mat_SeqDense *b;
1885: B->preallocated = PETSC_TRUE;
1886: b = (Mat_SeqDense*)B->data;
1887: if (!data) { /* petsc-allocated storage */
1888: if (!b->user_alloc) { PetscFree(b->v); }
1889: PetscMalloc((b->lda*b->Nmax+1)*sizeof(PetscScalar),&b->v);
1890: PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
1891: PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
1892: b->user_alloc = PETSC_FALSE;
1893: } else { /* user-allocated storage */
1894: if (!b->user_alloc) { PetscFree(b->v); }
1895: b->v = data;
1896: b->user_alloc = PETSC_TRUE;
1897: }
1898: return(0);
1899: }
1904: /*@C
1905: MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array
1907: Input parameter:
1908: + A - the matrix
1909: - lda - the leading dimension
1911: Notes:
1912: This routine is to be used in conjunction with MatSeqDenseSetPreallocation;
1913: it asserts that the preallocation has a leading dimension (the LDA parameter
1914: of Blas and Lapack fame) larger than M, the first dimension of the matrix.
1916: Level: intermediate
1918: .keywords: dense, matrix, LAPACK, BLAS
1920: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
1921: @*/
1922: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
1923: {
1924: Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1927: if (lda < B->rmap.n) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap.n);
1928: b->lda = lda;
1929: b->changelda = PETSC_FALSE;
1930: b->Mmax = PetscMax(b->Mmax,lda);
1931: return(0);
1932: }
1934: /*MC
1935: MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.
1937: Options Database Keys:
1938: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()
1940: Level: beginner
1942: .seealso: MatCreateSeqDense()
1944: M*/
1949: PetscErrorCode MatCreate_SeqDense(Mat B)
1950: {
1951: Mat_SeqDense *b;
1953: PetscMPIInt size;
1956: MPI_Comm_size(((PetscObject)B)->comm,&size);
1957: if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"Comm must be of size 1");
1959: B->rmap.bs = B->cmap.bs = 1;
1960: PetscMapSetUp(&B->rmap);
1961: PetscMapSetUp(&B->cmap);
1963: PetscNewLog(B,Mat_SeqDense,&b);
1964: PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
1965: B->factor = 0;
1966: B->mapping = 0;
1967: B->data = (void*)b;
1970: b->pivots = 0;
1971: b->roworiented = PETSC_TRUE;
1972: b->v = 0;
1973: b->lda = B->rmap.n;
1974: b->changelda = PETSC_FALSE;
1975: b->Mmax = B->rmap.n;
1976: b->Nmax = B->cmap.n;
1978: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
1979: "MatSeqDenseSetPreallocation_SeqDense",
1980: MatSeqDenseSetPreallocation_SeqDense);
1981: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
1982: "MatMatMult_SeqAIJ_SeqDense",
1983: MatMatMult_SeqAIJ_SeqDense);
1984: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
1985: "MatMatMultSymbolic_SeqAIJ_SeqDense",
1986: MatMatMultSymbolic_SeqAIJ_SeqDense);
1987: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
1988: "MatMatMultNumeric_SeqAIJ_SeqDense",
1989: MatMatMultNumeric_SeqAIJ_SeqDense);
1990: PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
1991: return(0);
1992: }