Actual source code: dense.c

  1: /*
  2:      Defines the basic matrix operations for sequential dense.
  3: */

 5:  #include src/mat/impls/dense/seq/dense.h
 6:  #include petscblaslapack.h

 10: PetscErrorCode MatAXPY_SeqDense(const PetscScalar *alpha,Mat X,Mat Y,MatStructure str)
 11: {
 12:   Mat_SeqDense *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
 13:   PetscInt     j;
 14:   PetscBLASInt N = (PetscBLASInt)X->m*X->n,m=(PetscBLASInt)X->m,ldax = x->lda,lday=y->lda,one = 1;

 17:   if (X->m != Y->m || X->n != Y->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
 18:   if (ldax>m || lday>m) {
 19:     for (j=0; j<X->n; j++) {
 20:       BLaxpy_(&m,(PetscScalar*)alpha,x->v+j*ldax,&one,y->v+j*lday,&one);
 21:     }
 22:   } else {
 23:     BLaxpy_(&N,(PetscScalar*)alpha,x->v,&one,y->v,&one);
 24:   }
 25:   PetscLogFlops(2*N-1);
 26:   return(0);
 27: }

 31: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
 32: {
 33:   Mat_SeqDense *a = (Mat_SeqDense*)A->data;
 34:   PetscInt     i,N = A->m*A->n,count = 0;
 35:   PetscScalar  *v = a->v;

 38:   for (i=0; i<N; i++) {if (*v != 0.0) count++; v++;}

 40:   info->rows_global       = (double)A->m;
 41:   info->columns_global    = (double)A->n;
 42:   info->rows_local        = (double)A->m;
 43:   info->columns_local     = (double)A->n;
 44:   info->block_size        = 1.0;
 45:   info->nz_allocated      = (double)N;
 46:   info->nz_used           = (double)count;
 47:   info->nz_unneeded       = (double)(N-count);
 48:   info->assemblies        = (double)A->num_ass;
 49:   info->mallocs           = 0;
 50:   info->memory            = A->mem;
 51:   info->fill_ratio_given  = 0;
 52:   info->fill_ratio_needed = 0;
 53:   info->factor_mallocs    = 0;

 55:   return(0);
 56: }

 60: PetscErrorCode MatScale_SeqDense(const PetscScalar *alpha,Mat A)
 61: {
 62:   Mat_SeqDense *a = (Mat_SeqDense*)A->data;
 63:   PetscBLASInt one = 1,lda = a->lda,j,nz;

 66:   if (lda>A->m) {
 67:     nz = (PetscBLASInt)A->m;
 68:     for (j=0; j<A->n; j++) {
 69:       BLscal_(&nz,(PetscScalar*)alpha,a->v+j*lda,&one);
 70:     }
 71:   } else {
 72:     nz = (PetscBLASInt)A->m*A->n;
 73:     BLscal_(&nz,(PetscScalar*)alpha,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->n,m = (PetscBLASInt)A->m,info;

 95:   if (!mat->pivots) {
 96:     PetscMalloc((A->m+1)*sizeof(PetscBLASInt),&mat->pivots);
 97:     PetscLogObjectMemory(A,A->m*sizeof(PetscBLASInt));
 98:   }
 99:   A->factor = FACTOR_LU;
100:   if (!A->m || !A->n) return(0);
101:   LAgetrf_(&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->n*A->n*A->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,A->m,A->n,A->m,A->n,&newi);
120:   MatSetType(newi,A->type_name);
121:   MatSeqDenseSetPreallocation(newi,PETSC_NULL);
122:   if (cpvalues == MAT_COPY_VALUES) {
123:     l = (Mat_SeqDense*)newi->data;
124:     if (lda>A->m) {
125:       m = A->m;
126:       for (j=0; j<A->n; j++) {
127:         PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
128:       }
129:     } else {
130:       PetscMemcpy(l->v,mat->v,A->m*A->n*sizeof(PetscScalar));
131:     }
132:   }
133:   newi->assembled = PETSC_TRUE;
134:   *newmat = newi;
135:   return(0);
136: }

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

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

151: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat A,Mat *fact)
152: {
153:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l = (Mat_SeqDense*)(*fact)->data;
155:   PetscInt       lda1=mat->lda,lda2=l->lda, m=A->m,n=A->n, j;
156:   MatFactorInfo  info;

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

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

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

185: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,MatFactorInfo *factinfo)
186: {
187: #if defined(PETSC_MISSING_LAPACK_POTRF) 
189:   SETERRQ(PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
190: #else
191:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
193:   PetscBLASInt   n = (PetscBLASInt)A->n,info;
194: 
196:   if (mat->pivots) {
197:     PetscFree(mat->pivots);
198:     PetscLogObjectMemory(A,-A->m*sizeof(PetscInt));
199:     mat->pivots = 0;
200:   }
201:   if (!A->m || !A->n) return(0);
202:   LApotrf_("L",&n,mat->v,&mat->lda,&info);
203:   if (info) SETERRQ1(PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
204:   A->factor = FACTOR_CHOLESKY;
205:   PetscLogFlops((A->n*A->n*A->n)/3);
206: #endif
207:   return(0);
208: }

212: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat A,Mat *fact)
213: {
215:   MatFactorInfo  info;

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

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

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

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

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

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

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

461:   if (!A->m || !A->n) return(0);
462:   VecGetArray(xx,&x);
463:   VecGetArray(yy,&y);
464:   LAgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
465:   VecRestoreArray(xx,&x);
466:   VecRestoreArray(yy,&y);
467:   PetscLogFlops(2*A->m*A->n - A->n);
468:   return(0);
469: }

473: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
474: {
475:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
476:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
478:   PetscBLASInt   m = (PetscBLASInt)A->m, n = (PetscBLASInt)A->n, _One=1;

481:   if (!A->m || !A->n) return(0);
482:   VecGetArray(xx,&x);
483:   VecGetArray(yy,&y);
484:   LAgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
485:   VecRestoreArray(xx,&x);
486:   VecRestoreArray(yy,&y);
487:   PetscLogFlops(2*A->m*A->n - A->m);
488:   return(0);
489: }

493: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
494: {
495:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
496:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
498:   PetscBLASInt   m = (PetscBLASInt)A->m, n = (PetscBLASInt)A->n, _One=1;

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

514: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
515: {
516:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
517:   PetscScalar    *v = mat->v,*x,*y;
519:   PetscBLASInt   m = (PetscBLASInt)A->m, n = (PetscBLASInt)A->n, _One=1;
520:   PetscScalar    _DOne=1.0;

523:   if (!A->m || !A->n) return(0);
524:   if (zz != yy) {VecCopy(zz,yy);}
525:   VecGetArray(xx,&x);
526:   VecGetArray(yy,&y);
527:   LAgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
528:   VecRestoreArray(xx,&x);
529:   VecRestoreArray(yy,&y);
530:   PetscLogFlops(2*A->m*A->n);
531:   return(0);
532: }

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

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

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

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

659: /* -----------------------------------------------------------------*/

661:  #include petscsys.h

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

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

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

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

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

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

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

742:  #include petscsys.h

746: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
747: {
748:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
749:   PetscErrorCode    ierr;
750:   PetscInt          i,j;
751:   char              *name;
752:   PetscScalar       *v;
753:   PetscViewerFormat format;

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

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

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

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

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

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

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

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

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


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

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

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

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

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

992: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
993: {
994:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
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 (issocket) {
1005:     if (a->lda>A->m) SETERRQ(PETSC_ERR_SUP,"Case can not handle LDA");
1006:     PetscViewerSocketPutScalar(viewer,A->m,A->n,a->v);
1007:   } else if (iascii) {
1008:     MatView_SeqDense_ASCII(A,viewer);
1009:   } else if (isbinary) {
1010:     MatView_SeqDense_Binary(A,viewer);
1011:   } else if (isdraw) {
1012:     MatView_SeqDense_Draw(A,viewer);
1013:   } else {
1014:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1015:   }
1016:   return(0);
1017: }

1021: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1022: {
1023:   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;

1027: #if defined(PETSC_USE_LOG)
1028:   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->m,mat->n);
1029: #endif
1030:   if (l->pivots) {PetscFree(l->pivots);}
1031:   if (!l->user_alloc) {PetscFree(l->v);}
1032:   PetscFree(l);
1033:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1034:   return(0);
1035: }

1039: PetscErrorCode MatTranspose_SeqDense(Mat A,Mat *matout)
1040: {
1041:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1043:   PetscInt       k,j,m,n,M;
1044:   PetscScalar    *v,tmp;

1047:   v = mat->v; m = A->m; M = mat->lda; n = A->n;
1048:   if (!matout) { /* in place transpose */
1049:     if (m != n) {
1050:       SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1051:     } else {
1052:       for (j=0; j<m; j++) {
1053:         for (k=0; k<j; k++) {
1054:           tmp = v[j + k*M];
1055:           v[j + k*M] = v[k + j*M];
1056:           v[k + j*M] = tmp;
1057:         }
1058:       }
1059:     }
1060:   } else { /* out-of-place transpose */
1061:     Mat          tmat;
1062:     Mat_SeqDense *tmatd;
1063:     PetscScalar  *v2;

1065:     MatCreate(A->comm,A->n,A->m,A->n,A->m,&tmat);
1066:     MatSetType(tmat,A->type_name);
1067:     MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1068:     tmatd = (Mat_SeqDense*)tmat->data;
1069:     v = mat->v; v2 = tmatd->v;
1070:     for (j=0; j<n; j++) {
1071:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1072:     }
1073:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1074:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1075:     *matout = tmat;
1076:   }
1077:   return(0);
1078: }

1082: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1083: {
1084:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1085:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1086:   PetscInt     i,j;
1087:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1090:   if (A1->m != A2->m) {*flg = PETSC_FALSE; return(0);}
1091:   if (A1->n != A2->n) {*flg = PETSC_FALSE; return(0);}
1092:   for (i=0; i<A1->m; i++) {
1093:     v1 = mat1->v+i; v2 = mat2->v+i;
1094:     for (j=0; j<A1->n; j++) {
1095:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1096:       v1 += mat1->lda; v2 += mat2->lda;
1097:     }
1098:   }
1099:   *flg = PETSC_TRUE;
1100:   return(0);
1101: }

1105: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1106: {
1107:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1109:   PetscInt       i,n,len;
1110:   PetscScalar    *x,zero = 0.0;

1113:   VecSet(&zero,v);
1114:   VecGetSize(v,&n);
1115:   VecGetArray(v,&x);
1116:   len = PetscMin(A->m,A->n);
1117:   if (n != A->m) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1118:   for (i=0; i<len; i++) {
1119:     x[i] = mat->v[i*mat->lda + i];
1120:   }
1121:   VecRestoreArray(v,&x);
1122:   return(0);
1123: }

1127: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1128: {
1129:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1130:   PetscScalar    *l,*r,x,*v;
1132:   PetscInt       i,j,m = A->m,n = A->n;

1135:   if (ll) {
1136:     VecGetSize(ll,&m);
1137:     VecGetArray(ll,&l);
1138:     if (m != A->m) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1139:     for (i=0; i<m; i++) {
1140:       x = l[i];
1141:       v = mat->v + i;
1142:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1143:     }
1144:     VecRestoreArray(ll,&l);
1145:     PetscLogFlops(n*m);
1146:   }
1147:   if (rr) {
1148:     VecGetSize(rr,&n);
1149:     VecGetArray(rr,&r);
1150:     if (n != A->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1151:     for (i=0; i<n; i++) {
1152:       x = r[i];
1153:       v = mat->v + i*m;
1154:       for (j=0; j<m; j++) { (*v++) *= x;}
1155:     }
1156:     VecRestoreArray(rr,&r);
1157:     PetscLogFlops(n*m);
1158:   }
1159:   return(0);
1160: }

1164: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1165: {
1166:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1167:   PetscScalar  *v = mat->v;
1168:   PetscReal    sum = 0.0;
1169:   PetscInt     lda=mat->lda,m=A->m,i,j;

1172:   if (type == NORM_FROBENIUS) {
1173:     if (lda>m) {
1174:       for (j=0; j<A->n; j++) {
1175:         v = mat->v+j*lda;
1176:         for (i=0; i<m; i++) {
1177: #if defined(PETSC_USE_COMPLEX)
1178:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1179: #else
1180:           sum += (*v)*(*v); v++;
1181: #endif
1182:         }
1183:       }
1184:     } else {
1185:       for (i=0; i<A->n*A->m; i++) {
1186: #if defined(PETSC_USE_COMPLEX)
1187:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1188: #else
1189:         sum += (*v)*(*v); v++;
1190: #endif
1191:       }
1192:     }
1193:     *nrm = sqrt(sum);
1194:     PetscLogFlops(2*A->n*A->m);
1195:   } else if (type == NORM_1) {
1196:     *nrm = 0.0;
1197:     for (j=0; j<A->n; j++) {
1198:       v = mat->v + j*mat->lda;
1199:       sum = 0.0;
1200:       for (i=0; i<A->m; i++) {
1201:         sum += PetscAbsScalar(*v);  v++;
1202:       }
1203:       if (sum > *nrm) *nrm = sum;
1204:     }
1205:     PetscLogFlops(A->n*A->m);
1206:   } else if (type == NORM_INFINITY) {
1207:     *nrm = 0.0;
1208:     for (j=0; j<A->m; j++) {
1209:       v = mat->v + j;
1210:       sum = 0.0;
1211:       for (i=0; i<A->n; i++) {
1212:         sum += PetscAbsScalar(*v); v += mat->lda;
1213:       }
1214:       if (sum > *nrm) *nrm = sum;
1215:     }
1216:     PetscLogFlops(A->n*A->m);
1217:   } else {
1218:     SETERRQ(PETSC_ERR_SUP,"No two norm");
1219:   }
1220:   return(0);
1221: }

1225: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op)
1226: {
1227:   Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1228: 
1230:   switch (op) {
1231:   case MAT_ROW_ORIENTED:
1232:     aij->roworiented = PETSC_TRUE;
1233:     break;
1234:   case MAT_COLUMN_ORIENTED:
1235:     aij->roworiented = PETSC_FALSE;
1236:     break;
1237:   case MAT_ROWS_SORTED:
1238:   case MAT_ROWS_UNSORTED:
1239:   case MAT_COLUMNS_SORTED:
1240:   case MAT_COLUMNS_UNSORTED:
1241:   case MAT_NO_NEW_NONZERO_LOCATIONS:
1242:   case MAT_YES_NEW_NONZERO_LOCATIONS:
1243:   case MAT_NEW_NONZERO_LOCATION_ERR:
1244:   case MAT_NO_NEW_DIAGONALS:
1245:   case MAT_YES_NEW_DIAGONALS:
1246:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1247:   case MAT_USE_HASH_TABLE:
1248:     PetscLogInfo(A,"MatSetOption_SeqDense:Option ignored\n");
1249:     break;
1250:   case MAT_SYMMETRIC:
1251:   case MAT_STRUCTURALLY_SYMMETRIC:
1252:   case MAT_NOT_SYMMETRIC:
1253:   case MAT_NOT_STRUCTURALLY_SYMMETRIC:
1254:   case MAT_HERMITIAN:
1255:   case MAT_NOT_HERMITIAN:
1256:   case MAT_SYMMETRY_ETERNAL:
1257:   case MAT_NOT_SYMMETRY_ETERNAL:
1258:     break;
1259:   default:
1260:     SETERRQ(PETSC_ERR_SUP,"unknown option");
1261:   }
1262:   return(0);
1263: }

1267: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1268: {
1269:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1271:   PetscInt       lda=l->lda,m=A->m,j;

1274:   if (lda>m) {
1275:     for (j=0; j<A->n; j++) {
1276:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1277:     }
1278:   } else {
1279:     PetscMemzero(l->v,A->m*A->n*sizeof(PetscScalar));
1280:   }
1281:   return(0);
1282: }

1286: PetscErrorCode MatZeroRows_SeqDense(Mat A,IS is,const PetscScalar *diag)
1287: {
1288:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1290:   PetscInt       n = A->n,i,j,N,*rows;
1291:   PetscScalar    *slot;

1294:   ISGetLocalSize(is,&N);
1295:   ISGetIndices(is,&rows);
1296:   for (i=0; i<N; i++) {
1297:     slot = l->v + rows[i];
1298:     for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1299:   }
1300:   if (diag) {
1301:     for (i=0; i<N; i++) {
1302:       slot = l->v + (n+1)*rows[i];
1303:       *slot = *diag;
1304:     }
1305:   }
1306:   ISRestoreIndices(is,&rows);
1307:   return(0);
1308: }

1312: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1313: {
1314:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

1317:   *array = mat->v;
1318:   return(0);
1319: }

1323: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1324: {
1326:   *array = 0; /* user cannot accidently use the array later */
1327:   return(0);
1328: }

1332: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1333: {
1334:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1336:   PetscInt       i,j,m = A->m,*irow,*icol,nrows,ncols;
1337:   PetscScalar    *av,*bv,*v = mat->v;
1338:   Mat            newmat;

1341:   ISGetIndices(isrow,&irow);
1342:   ISGetIndices(iscol,&icol);
1343:   ISGetLocalSize(isrow,&nrows);
1344:   ISGetLocalSize(iscol,&ncols);
1345: 
1346:   /* Check submatrixcall */
1347:   if (scall == MAT_REUSE_MATRIX) {
1348:     PetscInt n_cols,n_rows;
1349:     MatGetSize(*B,&n_rows,&n_cols);
1350:     if (n_rows != nrows || n_cols != ncols) SETERRQ(PETSC_ERR_ARG_SIZ,"Reused submatrix wrong size");
1351:     newmat = *B;
1352:   } else {
1353:     /* Create and fill new matrix */
1354:     MatCreate(A->comm,nrows,ncols,nrows,ncols,&newmat);
1355:     MatSetType(newmat,A->type_name);
1356:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1357:   }

1359:   /* Now extract the data pointers and do the copy,column at a time */
1360:   bv = ((Mat_SeqDense*)newmat->data)->v;
1361: 
1362:   for (i=0; i<ncols; i++) {
1363:     av = v + m*icol[i];
1364:     for (j=0; j<nrows; j++) {
1365:       *bv++ = av[irow[j]];
1366:     }
1367:   }

1369:   /* Assemble the matrices so that the correct flags are set */
1370:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1371:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1373:   /* Free work space */
1374:   ISRestoreIndices(isrow,&irow);
1375:   ISRestoreIndices(iscol,&icol);
1376:   *B = newmat;
1377:   return(0);
1378: }

1382: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1383: {
1385:   PetscInt       i;

1388:   if (scall == MAT_INITIAL_MATRIX) {
1389:     PetscMalloc((n+1)*sizeof(Mat),B);
1390:   }

1392:   for (i=0; i<n; i++) {
1393:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1394:   }
1395:   return(0);
1396: }

1400: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1401: {
1402:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1404:   PetscInt       lda1=a->lda,lda2=b->lda, m=A->m,n=A->n, j;

1407:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1408:   if (A->ops->copy != B->ops->copy) {
1409:     MatCopy_Basic(A,B,str);
1410:     return(0);
1411:   }
1412:   if (m != B->m || n != B->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1413:   if (lda1>m || lda2>m) {
1414:     for (j=0; j<n; j++) {
1415:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1416:     }
1417:   } else {
1418:     PetscMemcpy(b->v,a->v,A->m*A->n*sizeof(PetscScalar));
1419:   }
1420:   return(0);
1421: }

1425: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1426: {

1430:    MatSeqDenseSetPreallocation(A,0);
1431:   return(0);
1432: }

1434: /* -------------------------------------------------------------------*/
1435: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1436:        MatGetRow_SeqDense,
1437:        MatRestoreRow_SeqDense,
1438:        MatMult_SeqDense,
1439: /* 4*/ MatMultAdd_SeqDense,
1440:        MatMultTranspose_SeqDense,
1441:        MatMultTransposeAdd_SeqDense,
1442:        MatSolve_SeqDense,
1443:        MatSolveAdd_SeqDense,
1444:        MatSolveTranspose_SeqDense,
1445: /*10*/ MatSolveTransposeAdd_SeqDense,
1446:        MatLUFactor_SeqDense,
1447:        MatCholeskyFactor_SeqDense,
1448:        MatRelax_SeqDense,
1449:        MatTranspose_SeqDense,
1450: /*15*/ MatGetInfo_SeqDense,
1451:        MatEqual_SeqDense,
1452:        MatGetDiagonal_SeqDense,
1453:        MatDiagonalScale_SeqDense,
1454:        MatNorm_SeqDense,
1455: /*20*/ 0,
1456:        0,
1457:        0,
1458:        MatSetOption_SeqDense,
1459:        MatZeroEntries_SeqDense,
1460: /*25*/ MatZeroRows_SeqDense,
1461:        MatLUFactorSymbolic_SeqDense,
1462:        MatLUFactorNumeric_SeqDense,
1463:        MatCholeskyFactorSymbolic_SeqDense,
1464:        MatCholeskyFactorNumeric_SeqDense,
1465: /*30*/ MatSetUpPreallocation_SeqDense,
1466:        0,
1467:        0,
1468:        MatGetArray_SeqDense,
1469:        MatRestoreArray_SeqDense,
1470: /*35*/ MatDuplicate_SeqDense,
1471:        0,
1472:        0,
1473:        0,
1474:        0,
1475: /*40*/ MatAXPY_SeqDense,
1476:        MatGetSubMatrices_SeqDense,
1477:        0,
1478:        MatGetValues_SeqDense,
1479:        MatCopy_SeqDense,
1480: /*45*/ 0,
1481:        MatScale_SeqDense,
1482:        0,
1483:        0,
1484:        0,
1485: /*50*/ 0,
1486:        0,
1487:        0,
1488:        0,
1489:        0,
1490: /*55*/ 0,
1491:        0,
1492:        0,
1493:        0,
1494:        0,
1495: /*60*/ 0,
1496:        MatDestroy_SeqDense,
1497:        MatView_SeqDense,
1498:        MatGetPetscMaps_Petsc,
1499:        0,
1500: /*65*/ 0,
1501:        0,
1502:        0,
1503:        0,
1504:        0,
1505: /*70*/ 0,
1506:        0,
1507:        0,
1508:        0,
1509:        0,
1510: /*75*/ 0,
1511:        0,
1512:        0,
1513:        0,
1514:        0,
1515: /*80*/ 0,
1516:        0,
1517:        0,
1518:        0,
1519: /*84*/ MatLoad_SeqDense,
1520:        0,
1521:        0,
1522:        0,
1523:        0,
1524:        0,
1525: /*90*/ 0,
1526:        0,
1527:        0,
1528:        0,
1529:        0,
1530: /*95*/ 0,
1531:        0,
1532:        0,
1533:        0};

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

1542:    Collective on MPI_Comm

1544:    Input Parameters:
1545: +  comm - MPI communicator, set to PETSC_COMM_SELF
1546: .  m - number of rows
1547: .  n - number of columns
1548: -  data - optional location of matrix data.  Set data=PETSC_NULL for PETSc
1549:    to control all matrix memory allocation.

1551:    Output Parameter:
1552: .  A - the matrix

1554:    Notes:
1555:    The data input variable is intended primarily for Fortran programmers
1556:    who wish to allocate their own matrix memory space.  Most users should
1557:    set data=PETSC_NULL.

1559:    Level: intermediate

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

1563: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1564: @*/
1565: PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1566: {

1570:   MatCreate(comm,m,n,m,n,A);
1571:   MatSetType(*A,MATSEQDENSE);
1572:   MatSeqDenseSetPreallocation(*A,data);
1573:   return(0);
1574: }

1578: /*@C
1579:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

1581:    Collective on MPI_Comm

1583:    Input Parameters:
1584: +  A - the matrix
1585: -  data - the array (or PETSC_NULL)

1587:    Notes:
1588:    The data input variable is intended primarily for Fortran programmers
1589:    who wish to allocate their own matrix memory space.  Most users should
1590:    set data=PETSC_NULL.

1592:    Level: intermediate

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

1596: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1597: @*/
1598: PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1599: {
1600:   PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);

1603:   PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1604:   if (f) {
1605:     (*f)(B,data);
1606:   }
1607:   return(0);
1608: }

1613: PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1614: {
1615:   Mat_SeqDense   *b;

1619:   B->preallocated = PETSC_TRUE;
1620:   b               = (Mat_SeqDense*)B->data;
1621:   if (!data) {
1622:     PetscMalloc((B->m*B->n+1)*sizeof(PetscScalar),&b->v);
1623:     PetscMemzero(b->v,B->m*B->n*sizeof(PetscScalar));
1624:     b->user_alloc = PETSC_FALSE;
1625:     PetscLogObjectMemory(B,B->n*B->m*sizeof(PetscScalar));
1626:   } else { /* user-allocated storage */
1627:     b->v          = data;
1628:     b->user_alloc = PETSC_TRUE;
1629:   }
1630:   return(0);
1631: }

1636: /*@C
1637:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

1639:   Input parameter:
1640: + A - the matrix
1641: - lda - the leading dimension

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

1648:   Level: intermediate

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

1652: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation()
1653: @*/
1654: PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda)
1655: {
1656:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1658:   if (lda < B->m) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->m);
1659:   b->lda = lda;
1660:   return(0);
1661: }

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

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

1669:   Level: beginner

1671: .seealso: MatCreateSeqDense
1672: M*/

1677: PetscErrorCode MatCreate_SeqDense(Mat B)
1678: {
1679:   Mat_SeqDense   *b;
1681:   PetscMPIInt    size;

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

1687:   B->m = B->M = PetscMax(B->m,B->M);
1688:   B->n = B->N = PetscMax(B->n,B->N);

1690:   PetscNew(Mat_SeqDense,&b);
1691:   PetscMemzero(b,sizeof(Mat_SeqDense));
1692:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
1693:   B->factor       = 0;
1694:   B->mapping      = 0;
1695:   PetscLogObjectMemory(B,sizeof(struct _p_Mat));
1696:   B->data         = (void*)b;

1698:   PetscMapCreateMPI(B->comm,B->m,B->m,&B->rmap);
1699:   PetscMapCreateMPI(B->comm,B->n,B->n,&B->cmap);

1701:   b->pivots       = 0;
1702:   b->roworiented  = PETSC_TRUE;
1703:   b->v            = 0;
1704:   b->lda          = B->m;

1706:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
1707:                                     "MatSeqDenseSetPreallocation_SeqDense",
1708:                                      MatSeqDenseSetPreallocation_SeqDense);
1709:   return(0);
1710: }