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: }