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            = 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: }
 78: 
 79: /* ---------------------------------------------------------------*/
 80: /* COMMENT: I have chosen to hide row permutation in the pivots,
 81:    rather than put it in the Mat->row slot.*/
 84: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,MatFactorInfo *minfo)
 85: {
 86: #if defined(PETSC_MISSING_LAPACK_GETRF) 
 88:   SETERRQ(PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
 89: #else
 90:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
 92:   PetscBLASInt   n = (PetscBLASInt)A->cmap.n,m = (PetscBLASInt)A->rmap.n,info;

 95:   if (!mat->pivots) {
 96:     PetscMalloc((A->rmap.n+1)*sizeof(PetscBLASInt),&mat->pivots);
 97:     PetscLogObjectMemory(A,A->rmap.n*sizeof(PetscBLASInt));
 98:   }
 99:   A->factor = FACTOR_LU;
100:   if (!A->rmap.n || !A->cmap.n) return(0);
101:   LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
102:   if (info<0) SETERRQ(PETSC_ERR_LIB,"Bad argument to LU factorization");
103:   if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
104:   PetscLogFlops((2*A->cmap.n*A->cmap.n*A->cmap.n)/3);
105: #endif
106:   return(0);
107: }

111: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
112: {
113:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l;
115:   PetscInt       lda = (PetscInt)mat->lda,j,m;
116:   Mat            newi;

119:   MatCreate(A->comm,&newi);
120:   MatSetSizes(newi,A->rmap.n,A->cmap.n,A->rmap.n,A->cmap.n);
121:   MatSetType(newi,A->type_name);
122:   MatSeqDenseSetPreallocation(newi,PETSC_NULL);
123:   if (cpvalues == MAT_COPY_VALUES) {
124:     l = (Mat_SeqDense*)newi->data;
125:     if (lda>A->rmap.n) {
126:       m = A->rmap.n;
127:       for (j=0; j<A->cmap.n; j++) {
128:         PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
129:       }
130:     } else {
131:       PetscMemcpy(l->v,mat->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
132:     }
133:   }
134:   newi->assembled = PETSC_TRUE;
135:   *newmat = newi;
136:   return(0);
137: }

141: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat A,IS row,IS col,MatFactorInfo *info,Mat *fact)
142: {

146:   MatDuplicate_SeqDense(A,MAT_DO_NOT_COPY_VALUES,fact);
147:   return(0);
148: }

152: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat A,MatFactorInfo *info_dummy,Mat *fact)
153: {
154:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l = (Mat_SeqDense*)(*fact)->data;
156:   PetscInt       lda1=mat->lda,lda2=l->lda, m=A->rmap.n,n=A->cmap.n, j;
157:   MatFactorInfo  info;

160:   /* copy the numerical values */
161:   if (lda1>m || lda2>m ) {
162:     for (j=0; j<n; j++) {
163:       PetscMemcpy(l->v+j*lda2,mat->v+j*lda1,m*sizeof(PetscScalar));
164:     }
165:   } else {
166:     PetscMemcpy(l->v,mat->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
167:   }
168:   (*fact)->factor = 0;
169:   MatLUFactor(*fact,0,0,&info);
170:   return(0);
171: }

175: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat A,IS row,MatFactorInfo *info,Mat *fact)
176: {

180:   MatConvert(A,MATSAME,MAT_INITIAL_MATRIX,fact);
181:   return(0);
182: }

186: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,MatFactorInfo *factinfo)
187: {
188: #if defined(PETSC_MISSING_LAPACK_POTRF) 
190:   SETERRQ(PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
191: #else
192:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
194:   PetscBLASInt   n = (PetscBLASInt)A->cmap.n,info;
195: 
197:   PetscFree(mat->pivots);
198:   mat->pivots = 0;

200:   if (!A->rmap.n || !A->cmap.n) return(0);
201:   LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
202:   if (info) SETERRQ1(PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
203:   A->factor = FACTOR_CHOLESKY;
204:   PetscLogFlops((A->cmap.n*A->cmap.n*A->cmap.n)/3);
205: #endif
206:   return(0);
207: }

211: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat A,MatFactorInfo *info_dummy,Mat *fact)
212: {
214:   MatFactorInfo  info;

217:   info.fill = 1.0;
218:   MatCholeskyFactor_SeqDense(*fact,0,&info);
219:   return(0);
220: }

224: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
225: {
226:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
228:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n, one = 1,info;
229:   PetscScalar    *x,*y;
230: 
232:   VecGetArray(xx,&x);
233:   VecGetArray(yy,&y);
234:   PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
235:   if (A->factor == FACTOR_LU) {
236: #if defined(PETSC_MISSING_LAPACK_GETRS) 
237:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
238: #else
239:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
240:     if (info) SETERRQ(PETSC_ERR_LIB,"GETRS - Bad solve");
241: #endif
242:   } else if (A->factor == FACTOR_CHOLESKY){
243: #if defined(PETSC_MISSING_LAPACK_POTRS) 
244:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
245: #else
246:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
247:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS Bad solve");
248: #endif
249:   }
250:   else SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
251:   VecRestoreArray(xx,&x);
252:   VecRestoreArray(yy,&y);
253:   PetscLogFlops(2*A->cmap.n*A->cmap.n - A->cmap.n);
254:   return(0);
255: }

259: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
260: {
261:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
263:   PetscBLASInt   m = (PetscBLASInt) A->rmap.n,one = 1,info;
264:   PetscScalar    *x,*y;
265: 
267:   VecGetArray(xx,&x);
268:   VecGetArray(yy,&y);
269:   PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
270:   /* assume if pivots exist then use LU; else Cholesky */
271:   if (mat->pivots) {
272: #if defined(PETSC_MISSING_LAPACK_GETRS) 
273:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
274: #else
275:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
276:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
277: #endif
278:   } else {
279: #if defined(PETSC_MISSING_LAPACK_POTRS) 
280:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
281: #else
282:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
283:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
284: #endif
285:   }
286:   VecRestoreArray(xx,&x);
287:   VecRestoreArray(yy,&y);
288:   PetscLogFlops(2*A->cmap.n*A->cmap.n - A->cmap.n);
289:   return(0);
290: }

294: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
295: {
296:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
298:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n,one = 1,info;
299:   PetscScalar    *x,*y,sone = 1.0;
300:   Vec            tmp = 0;
301: 
303:   VecGetArray(xx,&x);
304:   VecGetArray(yy,&y);
305:   if (!A->rmap.n || !A->cmap.n) return(0);
306:   if (yy == zz) {
307:     VecDuplicate(yy,&tmp);
308:     PetscLogObjectParent(A,tmp);
309:     VecCopy(yy,tmp);
310:   }
311:   PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
312:   /* assume if pivots exist then use LU; else Cholesky */
313:   if (mat->pivots) {
314: #if defined(PETSC_MISSING_LAPACK_GETRS) 
315:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
316: #else
317:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
318:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
319: #endif
320:   } else {
321: #if defined(PETSC_MISSING_LAPACK_POTRS) 
322:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
323: #else
324:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
325:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
326: #endif
327:   }
328:   if (tmp) {VecAXPY(yy,sone,tmp); VecDestroy(tmp);}
329:   else     {VecAXPY(yy,sone,zz);}
330:   VecRestoreArray(xx,&x);
331:   VecRestoreArray(yy,&y);
332:   PetscLogFlops(2*A->cmap.n*A->cmap.n);
333:   return(0);
334: }

338: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
339: {
340:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
342:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n,one = 1,info;
343:   PetscScalar    *x,*y,sone = 1.0;
344:   Vec            tmp;
345: 
347:   if (!A->rmap.n || !A->cmap.n) return(0);
348:   VecGetArray(xx,&x);
349:   VecGetArray(yy,&y);
350:   if (yy == zz) {
351:     VecDuplicate(yy,&tmp);
352:     PetscLogObjectParent(A,tmp);
353:     VecCopy(yy,tmp);
354:   }
355:   PetscMemcpy(y,x,A->rmap.n*sizeof(PetscScalar));
356:   /* assume if pivots exist then use LU; else Cholesky */
357:   if (mat->pivots) {
358: #if defined(PETSC_MISSING_LAPACK_GETRS) 
359:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
360: #else
361:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
362:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
363: #endif
364:   } else {
365: #if defined(PETSC_MISSING_LAPACK_POTRS) 
366:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
367: #else
368:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
369:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
370: #endif
371:   }
372:   if (tmp) {
373:     VecAXPY(yy,sone,tmp);
374:     VecDestroy(tmp);
375:   } else {
376:     VecAXPY(yy,sone,zz);
377:   }
378:   VecRestoreArray(xx,&x);
379:   VecRestoreArray(yy,&y);
380:   PetscLogFlops(2*A->cmap.n*A->cmap.n);
381:   return(0);
382: }
383: /* ------------------------------------------------------------------*/
386: PetscErrorCode MatRelax_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
387: {
388:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
389:   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
391:   PetscInt       m = A->rmap.n,i;
392: #if !defined(PETSC_USE_COMPLEX)
393:   PetscBLASInt   bm = (PetscBLASInt)m, o = 1;
394: #endif

397:   if (flag & SOR_ZERO_INITIAL_GUESS) {
398:     /* this is a hack fix, should have another version without the second BLASdot */
399:     VecSet(xx,zero);
400:   }
401:   VecGetArray(xx,&x);
402:   VecGetArray(bb,&b);
403:   its  = its*lits;
404:   if (its <= 0) SETERRQ2(PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
405:   while (its--) {
406:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
407:       for (i=0; i<m; i++) {
408: #if defined(PETSC_USE_COMPLEX)
409:         /* cannot use BLAS dot for complex because compiler/linker is 
410:            not happy about returning a double complex */
411:         PetscInt         _i;
412:         PetscScalar sum = b[i];
413:         for (_i=0; _i<m; _i++) {
414:           sum -= PetscConj(v[i+_i*m])*x[_i];
415:         }
416:         xt = sum;
417: #else
418:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
419: #endif
420:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
421:       }
422:     }
423:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
424:       for (i=m-1; i>=0; i--) {
425: #if defined(PETSC_USE_COMPLEX)
426:         /* cannot use BLAS dot for complex because compiler/linker is 
427:            not happy about returning a double complex */
428:         PetscInt         _i;
429:         PetscScalar sum = b[i];
430:         for (_i=0; _i<m; _i++) {
431:           sum -= PetscConj(v[i+_i*m])*x[_i];
432:         }
433:         xt = sum;
434: #else
435:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
436: #endif
437:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
438:       }
439:     }
440:   }
441:   VecRestoreArray(bb,&b);
442:   VecRestoreArray(xx,&x);
443:   return(0);
444: }

446: /* -----------------------------------------------------------------*/
449: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
450: {
451:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
452:   PetscScalar    *v = mat->v,*x,*y;
454:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n,_One=1;
455:   PetscScalar    _DOne=1.0,_DZero=0.0;

458:   if (!A->rmap.n || !A->cmap.n) return(0);
459:   VecGetArray(xx,&x);
460:   VecGetArray(yy,&y);
461:   BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
462:   VecRestoreArray(xx,&x);
463:   VecRestoreArray(yy,&y);
464:   PetscLogFlops(2*A->rmap.n*A->cmap.n - A->cmap.n);
465:   return(0);
466: }

470: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
471: {
472:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
473:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
475:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;

478:   if (!A->rmap.n || !A->cmap.n) return(0);
479:   VecGetArray(xx,&x);
480:   VecGetArray(yy,&y);
481:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
482:   VecRestoreArray(xx,&x);
483:   VecRestoreArray(yy,&y);
484:   PetscLogFlops(2*A->rmap.n*A->cmap.n - A->rmap.n);
485:   return(0);
486: }

490: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
491: {
492:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
493:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
495:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;

498:   if (!A->rmap.n || !A->cmap.n) return(0);
499:   if (zz != yy) {VecCopy(zz,yy);}
500:   VecGetArray(xx,&x);
501:   VecGetArray(yy,&y);
502:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
503:   VecRestoreArray(xx,&x);
504:   VecRestoreArray(yy,&y);
505:   PetscLogFlops(2*A->rmap.n*A->cmap.n);
506:   return(0);
507: }

511: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
512: {
513:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
514:   PetscScalar    *v = mat->v,*x,*y;
516:   PetscBLASInt   m = (PetscBLASInt)A->rmap.n, n = (PetscBLASInt)A->cmap.n, _One=1;
517:   PetscScalar    _DOne=1.0;

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_("T",&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: }

531: /* -----------------------------------------------------------------*/
534: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
535: {
536:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
537:   PetscScalar    *v;
539:   PetscInt       i;
540: 
542:   *ncols = A->cmap.n;
543:   if (cols) {
544:     PetscMalloc((A->cmap.n+1)*sizeof(PetscInt),cols);
545:     for (i=0; i<A->cmap.n; i++) (*cols)[i] = i;
546:   }
547:   if (vals) {
548:     PetscMalloc((A->cmap.n+1)*sizeof(PetscScalar),vals);
549:     v    = mat->v + row;
550:     for (i=0; i<A->cmap.n; i++) {(*vals)[i] = *v; v += mat->lda;}
551:   }
552:   return(0);
553: }

557: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
558: {
561:   if (cols) {PetscFree(*cols);}
562:   if (vals) {PetscFree(*vals); }
563:   return(0);
564: }
565: /* ----------------------------------------------------------------*/
568: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
569: {
570:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
571:   PetscInt     i,j,idx=0;
572: 
574:   if (!mat->roworiented) {
575:     if (addv == INSERT_VALUES) {
576:       for (j=0; j<n; j++) {
577:         if (indexn[j] < 0) {idx += m; continue;}
578: #if defined(PETSC_USE_DEBUG)  
579:         if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
580: #endif
581:         for (i=0; i<m; i++) {
582:           if (indexm[i] < 0) {idx++; continue;}
583: #if defined(PETSC_USE_DEBUG)  
584:           if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
585: #endif
586:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
587:         }
588:       }
589:     } else {
590:       for (j=0; j<n; j++) {
591:         if (indexn[j] < 0) {idx += m; continue;}
592: #if defined(PETSC_USE_DEBUG)  
593:         if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
594: #endif
595:         for (i=0; i<m; i++) {
596:           if (indexm[i] < 0) {idx++; continue;}
597: #if defined(PETSC_USE_DEBUG)  
598:           if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
599: #endif
600:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
601:         }
602:       }
603:     }
604:   } else {
605:     if (addv == INSERT_VALUES) {
606:       for (i=0; i<m; i++) {
607:         if (indexm[i] < 0) { idx += n; continue;}
608: #if defined(PETSC_USE_DEBUG)  
609:         if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
610: #endif
611:         for (j=0; j<n; j++) {
612:           if (indexn[j] < 0) { idx++; continue;}
613: #if defined(PETSC_USE_DEBUG)  
614:           if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
615: #endif
616:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
617:         }
618:       }
619:     } else {
620:       for (i=0; i<m; i++) {
621:         if (indexm[i] < 0) { idx += n; continue;}
622: #if defined(PETSC_USE_DEBUG)  
623:         if (indexm[i] >= A->rmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap.n-1);
624: #endif
625:         for (j=0; j<n; j++) {
626:           if (indexn[j] < 0) { idx++; continue;}
627: #if defined(PETSC_USE_DEBUG)  
628:           if (indexn[j] >= A->cmap.n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap.n-1);
629: #endif
630:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
631:         }
632:       }
633:     }
634:   }
635:   return(0);
636: }

640: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
641: {
642:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
643:   PetscInt     i,j;
644:   PetscScalar  *vpt = v;

647:   /* row-oriented output */
648:   for (i=0; i<m; i++) {
649:     for (j=0; j<n; j++) {
650:       *vpt++ = mat->v[indexn[j]*mat->lda + indexm[i]];
651:     }
652:   }
653:   return(0);
654: }

656: /* -----------------------------------------------------------------*/

658:  #include petscsys.h

662: PetscErrorCode MatLoad_SeqDense(PetscViewer viewer, MatType type,Mat *A)
663: {
664:   Mat_SeqDense   *a;
665:   Mat            B;
667:   PetscInt       *scols,i,j,nz,header[4];
668:   int            fd;
669:   PetscMPIInt    size;
670:   PetscInt       *rowlengths = 0,M,N,*cols;
671:   PetscScalar    *vals,*svals,*v,*w;
672:   MPI_Comm       comm = ((PetscObject)viewer)->comm;

675:   MPI_Comm_size(comm,&size);
676:   if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
677:   PetscViewerBinaryGetDescriptor(viewer,&fd);
678:   PetscBinaryRead(fd,header,4,PETSC_INT);
679:   if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
680:   M = header[1]; N = header[2]; nz = header[3];

682:   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
683:     MatCreate(comm,A);
684:     MatSetSizes(*A,M,N,M,N);
685:     MatSetType(*A,type);
686:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
687:     B    = *A;
688:     a    = (Mat_SeqDense*)B->data;
689:     v    = a->v;
690:     /* Allocate some temp space to read in the values and then flip them
691:        from row major to column major */
692:     PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
693:     /* read in nonzero values */
694:     PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
695:     /* now flip the values and store them in the matrix*/
696:     for (j=0; j<N; j++) {
697:       for (i=0; i<M; i++) {
698:         *v++ =w[i*N+j];
699:       }
700:     }
701:     PetscFree(w);
702:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
703:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
704:   } else {
705:     /* read row lengths */
706:     PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
707:     PetscBinaryRead(fd,rowlengths,M,PETSC_INT);

709:     /* create our matrix */
710:     MatCreate(comm,A);
711:     MatSetSizes(*A,M,N,M,N);
712:     MatSetType(*A,type);
713:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
714:     B = *A;
715:     a = (Mat_SeqDense*)B->data;
716:     v = a->v;

718:     /* read column indices and nonzeros */
719:     PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
720:     cols = scols;
721:     PetscBinaryRead(fd,cols,nz,PETSC_INT);
722:     PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
723:     vals = svals;
724:     PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);

726:     /* insert into matrix */
727:     for (i=0; i<M; i++) {
728:       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
729:       svals += rowlengths[i]; scols += rowlengths[i];
730:     }
731:     PetscFree(vals);
732:     PetscFree(cols);
733:     PetscFree(rowlengths);

735:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
736:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
737:   }
738:   return(0);
739: }

741:  #include petscsys.h

745: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
746: {
747:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
748:   PetscErrorCode    ierr;
749:   PetscInt          i,j;
750:   const char        *name;
751:   PetscScalar       *v;
752:   PetscViewerFormat format;
753: #if defined(PETSC_USE_COMPLEX)
754:   PetscTruth allreal = PETSC_TRUE;
755: #endif

758:   PetscObjectGetName((PetscObject)A,&name);
759:   PetscViewerGetFormat(viewer,&format);
760:   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
761:     return(0);  /* do nothing for now */
762:   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
763:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
764:     for (i=0; i<A->rmap.n; i++) {
765:       v = a->v + i;
766:       PetscViewerASCIIPrintf(viewer,"row %D:",i);
767:       for (j=0; j<A->cmap.n; j++) {
768: #if defined(PETSC_USE_COMPLEX)
769:         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
770:           PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
771:         } else if (PetscRealPart(*v)) {
772:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
773:         }
774: #else
775:         if (*v) {
776:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
777:         }
778: #endif
779:         v += a->lda;
780:       }
781:       PetscViewerASCIIPrintf(viewer,"\n");
782:     }
783:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
784:   } else {
785:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
786: #if defined(PETSC_USE_COMPLEX)
787:     /* determine if matrix has all real values */
788:     v = a->v;
789:     for (i=0; i<A->rmap.n*A->cmap.n; i++) {
790:         if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
791:     }
792: #endif
793:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
794:       PetscObjectGetName((PetscObject)A,&name);
795:       PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap.n,A->cmap.n);
796:       PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap.n,A->cmap.n);
797:       PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
798:     }

800:     for (i=0; i<A->rmap.n; i++) {
801:       v = a->v + i;
802:       for (j=0; j<A->cmap.n; j++) {
803: #if defined(PETSC_USE_COMPLEX)
804:         if (allreal) {
805:           PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
806:         } else {
807:           PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
808:         }
809: #else
810:         PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
811: #endif
812:         v += a->lda;
813:       }
814:       PetscViewerASCIIPrintf(viewer,"\n");
815:     }
816:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
817:       PetscViewerASCIIPrintf(viewer,"];\n");
818:     }
819:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
820:   }
821:   PetscViewerFlush(viewer);
822:   return(0);
823: }

827: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
828: {
829:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
830:   PetscErrorCode    ierr;
831:   int               fd;
832:   PetscInt          ict,j,n = A->cmap.n,m = A->rmap.n,i,*col_lens,nz = m*n;
833:   PetscScalar       *v,*anonz,*vals;
834:   PetscViewerFormat format;
835: 
837:   PetscViewerBinaryGetDescriptor(viewer,&fd);

839:   PetscViewerGetFormat(viewer,&format);
840:   if (format == PETSC_VIEWER_BINARY_NATIVE) {
841:     /* store the matrix as a dense matrix */
842:     PetscMalloc(4*sizeof(PetscInt),&col_lens);
843:     col_lens[0] = MAT_FILE_COOKIE;
844:     col_lens[1] = m;
845:     col_lens[2] = n;
846:     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
847:     PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
848:     PetscFree(col_lens);

850:     /* write out matrix, by rows */
851:     PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
852:     v    = a->v;
853:     for (i=0; i<m; i++) {
854:       for (j=0; j<n; j++) {
855:         vals[i + j*m] = *v++;
856:       }
857:     }
858:     PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
859:     PetscFree(vals);
860:   } else {
861:     PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
862:     col_lens[0] = MAT_FILE_COOKIE;
863:     col_lens[1] = m;
864:     col_lens[2] = n;
865:     col_lens[3] = nz;

867:     /* store lengths of each row and write (including header) to file */
868:     for (i=0; i<m; i++) col_lens[4+i] = n;
869:     PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);

871:     /* Possibly should write in smaller increments, not whole matrix at once? */
872:     /* store column indices (zero start index) */
873:     ict = 0;
874:     for (i=0; i<m; i++) {
875:       for (j=0; j<n; j++) col_lens[ict++] = j;
876:     }
877:     PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
878:     PetscFree(col_lens);

880:     /* store nonzero values */
881:     PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
882:     ict  = 0;
883:     for (i=0; i<m; i++) {
884:       v = a->v + i;
885:       for (j=0; j<n; j++) {
886:         anonz[ict++] = *v; v += a->lda;
887:       }
888:     }
889:     PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
890:     PetscFree(anonz);
891:   }
892:   return(0);
893: }

897: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
898: {
899:   Mat               A = (Mat) Aa;
900:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
901:   PetscErrorCode    ierr;
902:   PetscInt          m = A->rmap.n,n = A->cmap.n,color,i,j;
903:   PetscScalar       *v = a->v;
904:   PetscViewer       viewer;
905:   PetscDraw         popup;
906:   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
907:   PetscViewerFormat format;


911:   PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
912:   PetscViewerGetFormat(viewer,&format);
913:   PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);

915:   /* Loop over matrix elements drawing boxes */
916:   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
917:     /* Blue for negative and Red for positive */
918:     color = PETSC_DRAW_BLUE;
919:     for(j = 0; j < n; j++) {
920:       x_l = j;
921:       x_r = x_l + 1.0;
922:       for(i = 0; i < m; i++) {
923:         y_l = m - i - 1.0;
924:         y_r = y_l + 1.0;
925: #if defined(PETSC_USE_COMPLEX)
926:         if (PetscRealPart(v[j*m+i]) >  0.) {
927:           color = PETSC_DRAW_RED;
928:         } else if (PetscRealPart(v[j*m+i]) <  0.) {
929:           color = PETSC_DRAW_BLUE;
930:         } else {
931:           continue;
932:         }
933: #else
934:         if (v[j*m+i] >  0.) {
935:           color = PETSC_DRAW_RED;
936:         } else if (v[j*m+i] <  0.) {
937:           color = PETSC_DRAW_BLUE;
938:         } else {
939:           continue;
940:         }
941: #endif
942:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
943:       }
944:     }
945:   } else {
946:     /* use contour shading to indicate magnitude of values */
947:     /* first determine max of all nonzero values */
948:     for(i = 0; i < m*n; i++) {
949:       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
950:     }
951:     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
952:     PetscDrawGetPopup(draw,&popup);
953:     if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
954:     for(j = 0; j < n; j++) {
955:       x_l = j;
956:       x_r = x_l + 1.0;
957:       for(i = 0; i < m; i++) {
958:         y_l   = m - i - 1.0;
959:         y_r   = y_l + 1.0;
960:         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
961:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
962:       }
963:     }
964:   }
965:   return(0);
966: }

970: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
971: {
972:   PetscDraw      draw;
973:   PetscTruth     isnull;
974:   PetscReal      xr,yr,xl,yl,h,w;

978:   PetscViewerDrawGetDraw(viewer,0,&draw);
979:   PetscDrawIsNull(draw,&isnull);
980:   if (isnull) return(0);

982:   PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
983:   xr  = A->cmap.n; yr = A->rmap.n; h = yr/10.0; w = xr/10.0;
984:   xr += w;    yr += h;  xl = -w;     yl = -h;
985:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
986:   PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
987:   PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
988:   return(0);
989: }

993: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
994: {
996:   PetscTruth     issocket,iascii,isbinary,isdraw;

999:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
1000:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
1001:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
1002:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);

1004:   if (iascii) {
1005:     MatView_SeqDense_ASCII(A,viewer);
1006: #if defined(PETSC_USE_SOCKET_VIEWER)
1007:   } else if (issocket) {
1008:     Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1009:     if (a->lda>A->rmap.n) SETERRQ(PETSC_ERR_SUP,"Case can not handle LDA");
1010:     PetscViewerSocketPutScalar(viewer,A->rmap.n,A->cmap.n,a->v);
1011: #endif
1012:   } else if (isbinary) {
1013:     MatView_SeqDense_Binary(A,viewer);
1014:   } else if (isdraw) {
1015:     MatView_SeqDense_Draw(A,viewer);
1016:   } else {
1017:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1018:   }
1019:   return(0);
1020: }

1024: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1025: {
1026:   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;

1030: #if defined(PETSC_USE_LOG)
1031:   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap.n,mat->cmap.n);
1032: #endif
1033:   PetscFree(l->pivots);
1034:   if (!l->user_alloc) {PetscFree(l->v);}
1035:   PetscFree(l);

1037:   PetscObjectChangeTypeName((PetscObject)mat,0);
1038:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1039:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1040:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1041:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1042:   return(0);
1043: }

1047: PetscErrorCode MatTranspose_SeqDense(Mat A,Mat *matout)
1048: {
1049:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1051:   PetscInt       k,j,m,n,M;
1052:   PetscScalar    *v,tmp;

1055:   v = mat->v; m = A->rmap.n; M = mat->lda; n = A->cmap.n;
1056:   if (!matout) { /* in place transpose */
1057:     if (m != n) {
1058:       SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1059:     } else {
1060:       for (j=0; j<m; j++) {
1061:         for (k=0; k<j; k++) {
1062:           tmp = v[j + k*M];
1063:           v[j + k*M] = v[k + j*M];
1064:           v[k + j*M] = tmp;
1065:         }
1066:       }
1067:     }
1068:   } else { /* out-of-place transpose */
1069:     Mat          tmat;
1070:     Mat_SeqDense *tmatd;
1071:     PetscScalar  *v2;

1073:     MatCreate(A->comm,&tmat);
1074:     MatSetSizes(tmat,A->cmap.n,A->rmap.n,A->cmap.n,A->rmap.n);
1075:     MatSetType(tmat,A->type_name);
1076:     MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1077:     tmatd = (Mat_SeqDense*)tmat->data;
1078:     v = mat->v; v2 = tmatd->v;
1079:     for (j=0; j<n; j++) {
1080:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1081:     }
1082:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1083:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1084:     *matout = tmat;
1085:   }
1086:   return(0);
1087: }

1091: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1092: {
1093:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1094:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1095:   PetscInt     i,j;
1096:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1099:   if (A1->rmap.n != A2->rmap.n) {*flg = PETSC_FALSE; return(0);}
1100:   if (A1->cmap.n != A2->cmap.n) {*flg = PETSC_FALSE; return(0);}
1101:   for (i=0; i<A1->rmap.n; i++) {
1102:     v1 = mat1->v+i; v2 = mat2->v+i;
1103:     for (j=0; j<A1->cmap.n; j++) {
1104:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1105:       v1 += mat1->lda; v2 += mat2->lda;
1106:     }
1107:   }
1108:   *flg = PETSC_TRUE;
1109:   return(0);
1110: }

1114: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1115: {
1116:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1118:   PetscInt       i,n,len;
1119:   PetscScalar    *x,zero = 0.0;

1122:   VecSet(v,zero);
1123:   VecGetSize(v,&n);
1124:   VecGetArray(v,&x);
1125:   len = PetscMin(A->rmap.n,A->cmap.n);
1126:   if (n != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1127:   for (i=0; i<len; i++) {
1128:     x[i] = mat->v[i*mat->lda + i];
1129:   }
1130:   VecRestoreArray(v,&x);
1131:   return(0);
1132: }

1136: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1137: {
1138:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1139:   PetscScalar    *l,*r,x,*v;
1141:   PetscInt       i,j,m = A->rmap.n,n = A->cmap.n;

1144:   if (ll) {
1145:     VecGetSize(ll,&m);
1146:     VecGetArray(ll,&l);
1147:     if (m != A->rmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1148:     for (i=0; i<m; i++) {
1149:       x = l[i];
1150:       v = mat->v + i;
1151:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1152:     }
1153:     VecRestoreArray(ll,&l);
1154:     PetscLogFlops(n*m);
1155:   }
1156:   if (rr) {
1157:     VecGetSize(rr,&n);
1158:     VecGetArray(rr,&r);
1159:     if (n != A->cmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1160:     for (i=0; i<n; i++) {
1161:       x = r[i];
1162:       v = mat->v + i*m;
1163:       for (j=0; j<m; j++) { (*v++) *= x;}
1164:     }
1165:     VecRestoreArray(rr,&r);
1166:     PetscLogFlops(n*m);
1167:   }
1168:   return(0);
1169: }

1173: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1174: {
1175:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1176:   PetscScalar  *v = mat->v;
1177:   PetscReal    sum = 0.0;
1178:   PetscInt     lda=mat->lda,m=A->rmap.n,i,j;

1182:   if (type == NORM_FROBENIUS) {
1183:     if (lda>m) {
1184:       for (j=0; j<A->cmap.n; j++) {
1185:         v = mat->v+j*lda;
1186:         for (i=0; i<m; i++) {
1187: #if defined(PETSC_USE_COMPLEX)
1188:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1189: #else
1190:           sum += (*v)*(*v); v++;
1191: #endif
1192:         }
1193:       }
1194:     } else {
1195:       for (i=0; i<A->cmap.n*A->rmap.n; i++) {
1196: #if defined(PETSC_USE_COMPLEX)
1197:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1198: #else
1199:         sum += (*v)*(*v); v++;
1200: #endif
1201:       }
1202:     }
1203:     *nrm = sqrt(sum);
1204:     PetscLogFlops(2*A->cmap.n*A->rmap.n);
1205:   } else if (type == NORM_1) {
1206:     *nrm = 0.0;
1207:     for (j=0; j<A->cmap.n; j++) {
1208:       v = mat->v + j*mat->lda;
1209:       sum = 0.0;
1210:       for (i=0; i<A->rmap.n; i++) {
1211:         sum += PetscAbsScalar(*v);  v++;
1212:       }
1213:       if (sum > *nrm) *nrm = sum;
1214:     }
1215:     PetscLogFlops(A->cmap.n*A->rmap.n);
1216:   } else if (type == NORM_INFINITY) {
1217:     *nrm = 0.0;
1218:     for (j=0; j<A->rmap.n; j++) {
1219:       v = mat->v + j;
1220:       sum = 0.0;
1221:       for (i=0; i<A->cmap.n; i++) {
1222:         sum += PetscAbsScalar(*v); v += mat->lda;
1223:       }
1224:       if (sum > *nrm) *nrm = sum;
1225:     }
1226:     PetscLogFlops(A->cmap.n*A->rmap.n);
1227:   } else {
1228:     SETERRQ(PETSC_ERR_SUP,"No two norm");
1229:   }
1230:   return(0);
1231: }

1235: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op)
1236: {
1237:   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1239: 
1241:   switch (op) {
1242:   case MAT_ROW_ORIENTED:
1243:     aij->roworiented = PETSC_TRUE;
1244:     break;
1245:   case MAT_COLUMN_ORIENTED:
1246:     aij->roworiented = PETSC_FALSE;
1247:     break;
1248:   case MAT_ROWS_SORTED:
1249:   case MAT_ROWS_UNSORTED:
1250:   case MAT_COLUMNS_SORTED:
1251:   case MAT_COLUMNS_UNSORTED:
1252:   case MAT_NO_NEW_NONZERO_LOCATIONS:
1253:   case MAT_YES_NEW_NONZERO_LOCATIONS:
1254:   case MAT_NEW_NONZERO_LOCATION_ERR:
1255:   case MAT_NO_NEW_DIAGONALS:
1256:   case MAT_YES_NEW_DIAGONALS:
1257:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1258:   case MAT_USE_HASH_TABLE:
1259:     PetscInfo1(A,"Option %d ignored\n",op);
1260:     break;
1261:   case MAT_SYMMETRIC:
1262:   case MAT_STRUCTURALLY_SYMMETRIC:
1263:   case MAT_NOT_SYMMETRIC:
1264:   case MAT_NOT_STRUCTURALLY_SYMMETRIC:
1265:   case MAT_HERMITIAN:
1266:   case MAT_NOT_HERMITIAN:
1267:   case MAT_SYMMETRY_ETERNAL:
1268:   case MAT_NOT_SYMMETRY_ETERNAL:
1269:     break;
1270:   default:
1271:     SETERRQ1(PETSC_ERR_SUP,"unknown option %d",op);
1272:   }
1273:   return(0);
1274: }

1278: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1279: {
1280:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1282:   PetscInt       lda=l->lda,m=A->rmap.n,j;

1285:   if (lda>m) {
1286:     for (j=0; j<A->cmap.n; j++) {
1287:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1288:     }
1289:   } else {
1290:     PetscMemzero(l->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
1291:   }
1292:   return(0);
1293: }

1297: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
1298: {
1299:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1300:   PetscInt       n = A->cmap.n,i,j;
1301:   PetscScalar    *slot;

1304:   for (i=0; i<N; i++) {
1305:     slot = l->v + rows[i];
1306:     for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1307:   }
1308:   if (diag != 0.0) {
1309:     for (i=0; i<N; i++) {
1310:       slot = l->v + (n+1)*rows[i];
1311:       *slot = diag;
1312:     }
1313:   }
1314:   return(0);
1315: }

1319: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1320: {
1321:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

1324:   if (mat->lda != A->rmap.n) SETERRQ(PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows");
1325:   *array = mat->v;
1326:   return(0);
1327: }

1331: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1332: {
1334:   *array = 0; /* user cannot accidently use the array later */
1335:   return(0);
1336: }

1340: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1341: {
1342:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1344:   PetscInt       i,j,*irow,*icol,nrows,ncols;
1345:   PetscScalar    *av,*bv,*v = mat->v;
1346:   Mat            newmat;

1349:   ISGetIndices(isrow,&irow);
1350:   ISGetIndices(iscol,&icol);
1351:   ISGetLocalSize(isrow,&nrows);
1352:   ISGetLocalSize(iscol,&ncols);
1353: 
1354:   /* Check submatrixcall */
1355:   if (scall == MAT_REUSE_MATRIX) {
1356:     PetscInt n_cols,n_rows;
1357:     MatGetSize(*B,&n_rows,&n_cols);
1358:     if (n_rows != nrows || n_cols != ncols) {
1359:       /* resize the result result matrix to match number of requested rows/columns */
1360:       MatSetSizes(*B,nrows,nrows,nrows,nrows);
1361:     }
1362:     newmat = *B;
1363:   } else {
1364:     /* Create and fill new matrix */
1365:     MatCreate(A->comm,&newmat);
1366:     MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1367:     MatSetType(newmat,A->type_name);
1368:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1369:   }

1371:   /* Now extract the data pointers and do the copy,column at a time */
1372:   bv = ((Mat_SeqDense*)newmat->data)->v;
1373: 
1374:   for (i=0; i<ncols; i++) {
1375:     av = v + mat->lda*icol[i];
1376:     for (j=0; j<nrows; j++) {
1377:       *bv++ = av[irow[j]];
1378:     }
1379:   }

1381:   /* Assemble the matrices so that the correct flags are set */
1382:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1383:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1385:   /* Free work space */
1386:   ISRestoreIndices(isrow,&irow);
1387:   ISRestoreIndices(iscol,&icol);
1388:   *B = newmat;
1389:   return(0);
1390: }

1394: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1395: {
1397:   PetscInt       i;

1400:   if (scall == MAT_INITIAL_MATRIX) {
1401:     PetscMalloc((n+1)*sizeof(Mat),B);
1402:   }

1404:   for (i=0; i<n; i++) {
1405:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1406:   }
1407:   return(0);
1408: }

1412: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1413: {
1415:   return(0);
1416: }

1420: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1421: {
1423:   return(0);
1424: }

1428: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1429: {
1430:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1432:   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap.n,n=A->cmap.n, j;

1435:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1436:   if (A->ops->copy != B->ops->copy) {
1437:     MatCopy_Basic(A,B,str);
1438:     return(0);
1439:   }
1440:   if (m != B->rmap.n || n != B->cmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1441:   if (lda1>m || lda2>m) {
1442:     for (j=0; j<n; j++) {
1443:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1444:     }
1445:   } else {
1446:     PetscMemcpy(b->v,a->v,A->rmap.n*A->cmap.n*sizeof(PetscScalar));
1447:   }
1448:   return(0);
1449: }

1453: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1454: {

1458:    MatSeqDenseSetPreallocation(A,0);
1459:   return(0);
1460: }

1464: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1465: {
1466:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1469:   /* this will not be called before lda, Mmax,  and Nmax have been set */
1470:   m = PetscMax(m,M);
1471:   n = PetscMax(n,N);
1472:   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);
1473:   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);
1474:   A->rmap.n = A->rmap.n = m;
1475:   A->cmap.n = A->cmap.N = n;
1476:   if (a->changelda) a->lda = m;
1477:   PetscMemzero(a->v,m*n*sizeof(PetscScalar));
1478:   return(0);
1479: }

1481: /* ----------------------------------------------------------------*/
1484: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1485: {

1489:   if (scall == MAT_INITIAL_MATRIX){
1490:     MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1491:   }
1492:   MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1493:   return(0);
1494: }

1498: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1499: {
1501:   PetscInt       m=A->rmap.n,n=B->cmap.n;
1502:   Mat            Cmat;

1505:   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);
1506:   MatCreate(PETSC_COMM_SELF,&Cmat);
1507:   MatSetSizes(Cmat,m,n,m,n);
1508:   MatSetType(Cmat,MATSEQDENSE);
1509:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1510:   Cmat->assembled = PETSC_TRUE;
1511:   *C = Cmat;
1512:   return(0);
1513: }

1517: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1518: {
1519:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1520:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1521:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1522:   PetscBLASInt   m=(PetscBLASInt)A->rmap.n,n=(PetscBLASInt)B->cmap.n,k=(PetscBLASInt)A->cmap.n;
1523:   PetscScalar    _DOne=1.0,_DZero=0.0;

1526:   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1527:   return(0);
1528: }

1532: PetscErrorCode MatMatMultTranspose_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1533: {

1537:   if (scall == MAT_INITIAL_MATRIX){
1538:     MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1539:   }
1540:   MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1541:   return(0);
1542: }

1546: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1547: {
1549:   PetscInt       m=A->cmap.n,n=B->cmap.n;
1550:   Mat            Cmat;

1553:   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);
1554:   MatCreate(PETSC_COMM_SELF,&Cmat);
1555:   MatSetSizes(Cmat,m,n,m,n);
1556:   MatSetType(Cmat,MATSEQDENSE);
1557:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1558:   Cmat->assembled = PETSC_TRUE;
1559:   *C = Cmat;
1560:   return(0);
1561: }

1565: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1566: {
1567:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1568:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1569:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1570:   PetscBLASInt   m=(PetscBLASInt)A->cmap.n,n=(PetscBLASInt)B->cmap.n,k=(PetscBLASInt)A->rmap.n;
1571:   PetscScalar    _DOne=1.0,_DZero=0.0;

1574:   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1575:   return(0);
1576: }
1577: /* -------------------------------------------------------------------*/
1578: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1579:        MatGetRow_SeqDense,
1580:        MatRestoreRow_SeqDense,
1581:        MatMult_SeqDense,
1582: /* 4*/ MatMultAdd_SeqDense,
1583:        MatMultTranspose_SeqDense,
1584:        MatMultTransposeAdd_SeqDense,
1585:        MatSolve_SeqDense,
1586:        MatSolveAdd_SeqDense,
1587:        MatSolveTranspose_SeqDense,
1588: /*10*/ MatSolveTransposeAdd_SeqDense,
1589:        MatLUFactor_SeqDense,
1590:        MatCholeskyFactor_SeqDense,
1591:        MatRelax_SeqDense,
1592:        MatTranspose_SeqDense,
1593: /*15*/ MatGetInfo_SeqDense,
1594:        MatEqual_SeqDense,
1595:        MatGetDiagonal_SeqDense,
1596:        MatDiagonalScale_SeqDense,
1597:        MatNorm_SeqDense,
1598: /*20*/ MatAssemblyBegin_SeqDense,
1599:        MatAssemblyEnd_SeqDense,
1600:        0,
1601:        MatSetOption_SeqDense,
1602:        MatZeroEntries_SeqDense,
1603: /*25*/ MatZeroRows_SeqDense,
1604:        MatLUFactorSymbolic_SeqDense,
1605:        MatLUFactorNumeric_SeqDense,
1606:        MatCholeskyFactorSymbolic_SeqDense,
1607:        MatCholeskyFactorNumeric_SeqDense,
1608: /*30*/ MatSetUpPreallocation_SeqDense,
1609:        0,
1610:        0,
1611:        MatGetArray_SeqDense,
1612:        MatRestoreArray_SeqDense,
1613: /*35*/ MatDuplicate_SeqDense,
1614:        0,
1615:        0,
1616:        0,
1617:        0,
1618: /*40*/ MatAXPY_SeqDense,
1619:        MatGetSubMatrices_SeqDense,
1620:        0,
1621:        MatGetValues_SeqDense,
1622:        MatCopy_SeqDense,
1623: /*45*/ 0,
1624:        MatScale_SeqDense,
1625:        0,
1626:        0,
1627:        0,
1628: /*50*/ 0,
1629:        0,
1630:        0,
1631:        0,
1632:        0,
1633: /*55*/ 0,
1634:        0,
1635:        0,
1636:        0,
1637:        0,
1638: /*60*/ 0,
1639:        MatDestroy_SeqDense,
1640:        MatView_SeqDense,
1641:        0,
1642:        0,
1643: /*65*/ 0,
1644:        0,
1645:        0,
1646:        0,
1647:        0,
1648: /*70*/ 0,
1649:        0,
1650:        0,
1651:        0,
1652:        0,
1653: /*75*/ 0,
1654:        0,
1655:        0,
1656:        0,
1657:        0,
1658: /*80*/ 0,
1659:        0,
1660:        0,
1661:        0,
1662: /*84*/ MatLoad_SeqDense,
1663:        0,
1664:        0,
1665:        0,
1666:        0,
1667:        0,
1668: /*90*/ MatMatMult_SeqDense_SeqDense,
1669:        MatMatMultSymbolic_SeqDense_SeqDense,
1670:        MatMatMultNumeric_SeqDense_SeqDense,
1671:        0,
1672:        0,
1673: /*95*/ 0,
1674:        MatMatMultTranspose_SeqDense_SeqDense,
1675:        MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1676:        MatMatMultTransposeNumeric_SeqDense_SeqDense,
1677:        0,
1678: /*100*/0,
1679:        0,
1680:        0,
1681:        0,
1682:        MatSetSizes_SeqDense};

1686: /*@C
1687:    MatCreateSeqDense - Creates a sequential dense matrix that 
1688:    is stored in column major order (the usual Fortran 77 manner). Many 
1689:    of the matrix operations use the BLAS and LAPACK routines.

1691:    Collective on MPI_Comm

1693:    Input Parameters:
1694: +  comm - MPI communicator, set to PETSC_COMM_SELF
1695: .  m - number of rows
1696: .  n - number of columns
1697: -  data - optional location of matrix data.  Set data=PETSC_NULL for PETSc
1698:    to control all matrix memory allocation.

1700:    Output Parameter:
1701: .  A - the matrix

1703:    Notes:
1704:    The data input variable is intended primarily for Fortran programmers
1705:    who wish to allocate their own matrix memory space.  Most users should
1706:    set data=PETSC_NULL.

1708:    Level: intermediate

1710: .keywords: dense, matrix, LAPACK, BLAS

1712: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1713: @*/
1714: PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1715: {

1719:   MatCreate(comm,A);
1720:   MatSetSizes(*A,m,n,m,n);
1721:   MatSetType(*A,MATSEQDENSE);
1722:   MatSeqDenseSetPreallocation(*A,data);
1723:   return(0);
1724: }

1728: /*@C
1729:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

1731:    Collective on MPI_Comm

1733:    Input Parameters:
1734: +  A - the matrix
1735: -  data - the array (or PETSC_NULL)

1737:    Notes:
1738:    The data input variable is intended primarily for Fortran programmers
1739:    who wish to allocate their own matrix memory space.  Most users should
1740:    need not call this routine.

1742:    Level: intermediate

1744: .keywords: dense, matrix, LAPACK, BLAS

1746: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1747: @*/
1748: PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1749: {
1750:   PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);

1753:   PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1754:   if (f) {
1755:     (*f)(B,data);
1756:   }
1757:   return(0);
1758: }

1763: PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1764: {
1765:   Mat_SeqDense   *b;

1769:   B->preallocated = PETSC_TRUE;
1770:   b               = (Mat_SeqDense*)B->data;
1771:   if (!data) {
1772:     PetscMalloc((b->lda*b->Nmax+1)*sizeof(PetscScalar),&b->v);
1773:     PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
1774:     b->user_alloc = PETSC_FALSE;
1775:     PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
1776:   } else { /* user-allocated storage */
1777:     b->v          = data;
1778:     b->user_alloc = PETSC_TRUE;
1779:   }
1780:   return(0);
1781: }

1786: /*@C
1787:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

1789:   Input parameter:
1790: + A - the matrix
1791: - lda - the leading dimension

1793:   Notes:
1794:   This routine is to be used in conjunction with MatSeqDenseSetPreallocation;
1795:   it asserts that the preallocation has a leading dimension (the LDA parameter
1796:   of Blas and Lapack fame) larger than M, the first dimension of the matrix.

1798:   Level: intermediate

1800: .keywords: dense, matrix, LAPACK, BLAS

1802: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()
1803: @*/
1804: PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
1805: {
1806:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;

1809:   if (lda < B->rmap.n) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap.n);
1810:   b->lda       = lda;
1811:   b->changelda = PETSC_FALSE;
1812:   b->Mmax      = PetscMax(b->Mmax,lda);
1813:   return(0);
1814: }

1816: /*MC
1817:    MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices.

1819:    Options Database Keys:
1820: . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions()

1822:   Level: beginner

1824: .seealso: MatCreateSeqDense()

1826: M*/

1831: PetscErrorCode  MatCreate_SeqDense(Mat B)
1832: {
1833:   Mat_SeqDense   *b;
1835:   PetscMPIInt    size;

1838:   MPI_Comm_size(B->comm,&size);
1839:   if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"Comm must be of size 1");

1841:   B->rmap.bs = B->cmap.bs = 1;
1842:   PetscMapInitialize(B->comm,&B->rmap);
1843:   PetscMapInitialize(B->comm,&B->cmap);

1845:   PetscNew(Mat_SeqDense,&b);
1846:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
1847:   B->factor       = 0;
1848:   B->mapping      = 0;
1849:   PetscLogObjectMemory(B,sizeof(struct _p_Mat));
1850:   B->data         = (void*)b;


1853:   b->pivots       = 0;
1854:   b->roworiented  = PETSC_TRUE;
1855:   b->v            = 0;
1856:   b->lda          = B->rmap.n;
1857:   b->changelda    = PETSC_FALSE;
1858:   b->Mmax         = B->rmap.n;
1859:   b->Nmax         = B->cmap.n;

1861:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
1862:                                     "MatSeqDenseSetPreallocation_SeqDense",
1863:                                      MatSeqDenseSetPreallocation_SeqDense);
1864:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
1865:                                      "MatMatMult_SeqAIJ_SeqDense",
1866:                                       MatMatMult_SeqAIJ_SeqDense);
1867:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
1868:                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
1869:                                       MatMatMultSymbolic_SeqAIJ_SeqDense);
1870:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
1871:                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
1872:                                       MatMatMultNumeric_SeqAIJ_SeqDense);
1873:   PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
1874:   return(0);
1875: }