Actual source code: dense.c

  1: /*$Id: dense.c,v 1.208 2001/09/07 20:09:16 bsmith Exp $*/
  2: /*
  3:      Defines the basic matrix operations for sequential dense.
  4: */

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

 11: int MatAXPY_SeqDense(const PetscScalar *alpha,Mat X,Mat Y,MatStructure str)
 12: {
 13:   Mat_SeqDense *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
 14:   int          N = X->m*X->n,m=X->m,ldax=x->lda,lday=y->lda, j,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: int MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
 32: {
 33:   Mat_SeqDense *a = (Mat_SeqDense*)A->data;
 34:   int          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: int MatScale_SeqDense(const PetscScalar *alpha,Mat A)
 61: {
 62:   Mat_SeqDense *a = (Mat_SeqDense*)A->data;
 63:   int          one = 1,lda = a->lda,j,nz;

 66:   if (lda>A->m) {
 67:     nz = 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 = 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: int 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;
 91:   int          info,ierr;

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

110: int MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
111: {
112:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l;
113:   int          lda = mat->lda,j,m,ierr;
114:   Mat          newi;

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

138: int MatLUFactorSymbolic_SeqDense(Mat A,IS row,IS col,MatFactorInfo *info,Mat *fact)
139: {

143:   MatDuplicate_SeqDense(A,MAT_DO_NOT_COPY_VALUES,fact);
144:   return(0);
145: }

149: int MatLUFactorNumeric_SeqDense(Mat A,Mat *fact)
150: {
151:   Mat_SeqDense  *mat = (Mat_SeqDense*)A->data,*l = (Mat_SeqDense*)(*fact)->data;
152:   int           lda1=mat->lda,lda2=l->lda, m=A->m,n=A->n, j,ierr;
153:   MatFactorInfo info;

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

171: int MatCholeskyFactorSymbolic_SeqDense(Mat A,IS row,MatFactorInfo *info,Mat *fact)
172: {

176:   MatConvert(A,MATSAME,fact);
177:   return(0);
178: }

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

208: int MatCholeskyFactorNumeric_SeqDense(Mat A,Mat *fact)
209: {
211:   MatFactorInfo info;

214:   info.fill = 1.0;
215:   MatCholeskyFactor_SeqDense(*fact,0,&info);
216:   return(0);
217: }

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

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

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

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

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

441: /* -----------------------------------------------------------------*/
444: int MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
445: {
446:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
447:   PetscScalar  *v = mat->v,*x,*y;
448:   int          ierr,_One=1;
449:   PetscScalar  _DOne=1.0,_DZero=0.0;

452:   if (!A->m || !A->n) return(0);
453:   VecGetArray(xx,&x);
454:   VecGetArray(yy,&y);
455:   LAgemv_("T",&(A->m),&(A->n),&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
456:   VecRestoreArray(xx,&x);
457:   VecRestoreArray(yy,&y);
458:   PetscLogFlops(2*A->m*A->n - A->n);
459:   return(0);
460: }

464: int MatMult_SeqDense(Mat A,Vec xx,Vec yy)
465: {
466:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
467:   PetscScalar  *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
468:   int          ierr,_One=1;

471:   if (!A->m || !A->n) return(0);
472:   VecGetArray(xx,&x);
473:   VecGetArray(yy,&y);
474:   LAgemv_("N",&(A->m),&(A->n),&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
475:   VecRestoreArray(xx,&x);
476:   VecRestoreArray(yy,&y);
477:   PetscLogFlops(2*A->m*A->n - A->m);
478:   return(0);
479: }

483: int MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
484: {
485:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
486:   PetscScalar  *v = mat->v,*x,*y,_DOne=1.0;
487:   int          ierr,_One=1;

490:   if (!A->m || !A->n) return(0);
491:   if (zz != yy) {VecCopy(zz,yy);}
492:   VecGetArray(xx,&x);
493:   VecGetArray(yy,&y);
494:   LAgemv_("N",&(A->m),&(A->n),&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
495:   VecRestoreArray(xx,&x);
496:   VecRestoreArray(yy,&y);
497:   PetscLogFlops(2*A->m*A->n);
498:   return(0);
499: }

503: int MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
504: {
505:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
506:   PetscScalar  *v = mat->v,*x,*y;
507:   int          ierr,_One=1;
508:   PetscScalar  _DOne=1.0;

511:   if (!A->m || !A->n) return(0);
512:   if (zz != yy) {VecCopy(zz,yy);}
513:   VecGetArray(xx,&x);
514:   VecGetArray(yy,&y);
515:   LAgemv_("T",&(A->m),&(A->n),&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
516:   VecRestoreArray(xx,&x);
517:   VecRestoreArray(yy,&y);
518:   PetscLogFlops(2*A->m*A->n);
519:   return(0);
520: }

522: /* -----------------------------------------------------------------*/
525: int MatGetRow_SeqDense(Mat A,int row,int *ncols,int **cols,PetscScalar **vals)
526: {
527:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
528:   PetscScalar  *v;
529:   int          i,ierr;
530: 
532:   *ncols = A->n;
533:   if (cols) {
534:     PetscMalloc((A->n+1)*sizeof(int),cols);
535:     for (i=0; i<A->n; i++) (*cols)[i] = i;
536:   }
537:   if (vals) {
538:     PetscMalloc((A->n+1)*sizeof(PetscScalar),vals);
539:     v    = mat->v + row;
540:     for (i=0; i<A->n; i++) {(*vals)[i] = *v; v += mat->lda;}
541:   }
542:   return(0);
543: }

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

630: int MatGetValues_SeqDense(Mat A,int m,const int indexm[],int n,const int indexn[],PetscScalar v[])
631: {
632:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
633:   int          i,j;
634:   PetscScalar  *vpt = v;

637:   /* row-oriented output */
638:   for (i=0; i<m; i++) {
639:     for (j=0; j<n; j++) {
640:       *vpt++ = mat->v[indexn[j]*mat->lda + indexm[i]];
641:     }
642:   }
643:   return(0);
644: }

646: /* -----------------------------------------------------------------*/

648:  #include petscsys.h

652: int MatLoad_SeqDense(PetscViewer viewer,const MatType type,Mat *A)
653: {
654:   Mat_SeqDense *a;
655:   Mat          B;
656:   int          *scols,i,j,nz,ierr,fd,header[4],size;
657:   int          *rowlengths = 0,M,N,*cols;
658:   PetscScalar  *vals,*svals,*v,*w;
659:   MPI_Comm     comm = ((PetscObject)viewer)->comm;

662:   MPI_Comm_size(comm,&size);
663:   if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
664:   PetscViewerBinaryGetDescriptor(viewer,&fd);
665:   PetscBinaryRead(fd,header,4,PETSC_INT);
666:   if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
667:   M = header[1]; N = header[2]; nz = header[3];

669:   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
670:     MatCreate(comm,M,N,M,N,A);
671:     MatSetType(*A,type);
672:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
673:     B    = *A;
674:     a    = (Mat_SeqDense*)B->data;
675:     v    = a->v;
676:     /* Allocate some temp space to read in the values and then flip them
677:        from row major to column major */
678:     PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
679:     /* read in nonzero values */
680:     PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
681:     /* now flip the values and store them in the matrix*/
682:     for (j=0; j<N; j++) {
683:       for (i=0; i<M; i++) {
684:         *v++ =w[i*N+j];
685:       }
686:     }
687:     PetscFree(w);
688:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
689:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
690:   } else {
691:     /* read row lengths */
692:     PetscMalloc((M+1)*sizeof(int),&rowlengths);
693:     PetscBinaryRead(fd,rowlengths,M,PETSC_INT);

695:     /* create our matrix */
696:     MatCreate(comm,M,N,M,N,A);
697:     MatSetType(*A,type);
698:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
699:     B = *A;
700:     a = (Mat_SeqDense*)B->data;
701:     v = a->v;

703:     /* read column indices and nonzeros */
704:     PetscMalloc((nz+1)*sizeof(int),&scols);
705:     cols = scols;
706:     PetscBinaryRead(fd,cols,nz,PETSC_INT);
707:     PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
708:     vals = svals;
709:     PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);

711:     /* insert into matrix */
712:     for (i=0; i<M; i++) {
713:       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
714:       svals += rowlengths[i]; scols += rowlengths[i];
715:     }
716:     PetscFree(vals);
717:     PetscFree(cols);
718:     PetscFree(rowlengths);

720:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
721:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
722:   }
723:   return(0);
724: }

726:  #include petscsys.h

730: static int MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
731: {
732:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
733:   int               ierr,i,j;
734:   char              *name;
735:   PetscScalar       *v;
736:   PetscViewerFormat format;

739:   PetscObjectGetName((PetscObject)A,&name);
740:   PetscViewerGetFormat(viewer,&format);
741:   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
742:     return(0);  /* do nothing for now */
743:   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
744:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
745:     for (i=0; i<A->m; i++) {
746:       v = a->v + i;
747:       PetscViewerASCIIPrintf(viewer,"row %d:",i);
748:       for (j=0; j<A->n; j++) {
749: #if defined(PETSC_USE_COMPLEX)
750:         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
751:           PetscViewerASCIIPrintf(viewer," (%d, %g + %g i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
752:         } else if (PetscRealPart(*v)) {
753:           PetscViewerASCIIPrintf(viewer," (%d, %g) ",j,PetscRealPart(*v));
754:         }
755: #else
756:         if (*v) {
757:           PetscViewerASCIIPrintf(viewer," (%d, %g) ",j,*v);
758:         }
759: #endif
760:         v += a->lda;
761:       }
762:       PetscViewerASCIIPrintf(viewer,"\n");
763:     }
764:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
765:   } else {
766:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
767: #if defined(PETSC_USE_COMPLEX)
768:     PetscTruth allreal = PETSC_TRUE;
769:     /* determine if matrix has all real values */
770:     v = a->v;
771:     for (i=0; i<A->m*A->n; i++) {
772:         if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
773:     }
774: #endif
775:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
776:       PetscObjectGetName((PetscObject)A,&name);
777:       PetscViewerASCIIPrintf(viewer,"%% Size = %d %d \n",A->m,A->n);
778:       PetscViewerASCIIPrintf(viewer,"%s = zeros(%d,%d);\n",name,A->m,A->n);
779:       PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
780:     }

782:     for (i=0; i<A->m; i++) {
783:       v = a->v + i;
784:       for (j=0; j<A->n; j++) {
785: #if defined(PETSC_USE_COMPLEX)
786:         if (allreal) {
787:           PetscViewerASCIIPrintf(viewer,"%6.4e ",PetscRealPart(*v));
788:         } else {
789:           PetscViewerASCIIPrintf(viewer,"%6.4e + %6.4e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
790:         }
791: #else
792:         PetscViewerASCIIPrintf(viewer,"%6.4e ",*v);
793: #endif
794:         v += a->lda;
795:       }
796:       PetscViewerASCIIPrintf(viewer,"\n");
797:     }
798:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
799:       PetscViewerASCIIPrintf(viewer,"];\n");
800:     }
801:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
802:   }
803:   PetscViewerFlush(viewer);
804:   return(0);
805: }

809: static int MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
810: {
811:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
812:   int               ict,j,n = A->n,m = A->m,i,fd,*col_lens,ierr,nz = m*n;
813:   PetscScalar       *v,*anonz,*vals;
814:   PetscViewerFormat format;
815: 
817:   PetscViewerBinaryGetDescriptor(viewer,&fd);

819:   PetscViewerGetFormat(viewer,&format);
820:   if (format == PETSC_VIEWER_BINARY_NATIVE) {
821:     /* store the matrix as a dense matrix */
822:     PetscMalloc(4*sizeof(int),&col_lens);
823:     col_lens[0] = MAT_FILE_COOKIE;
824:     col_lens[1] = m;
825:     col_lens[2] = n;
826:     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
827:     PetscBinaryWrite(fd,col_lens,4,PETSC_INT,1);
828:     PetscFree(col_lens);

830:     /* write out matrix, by rows */
831:     PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
832:     v    = a->v;
833:     for (i=0; i<m; i++) {
834:       for (j=0; j<n; j++) {
835:         vals[i + j*m] = *v++;
836:       }
837:     }
838:     PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,0);
839:     PetscFree(vals);
840:   } else {
841:     PetscMalloc((4+nz)*sizeof(int),&col_lens);
842:     col_lens[0] = MAT_FILE_COOKIE;
843:     col_lens[1] = m;
844:     col_lens[2] = n;
845:     col_lens[3] = nz;

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

851:     /* Possibly should write in smaller increments, not whole matrix at once? */
852:     /* store column indices (zero start index) */
853:     ict = 0;
854:     for (i=0; i<m; i++) {
855:       for (j=0; j<n; j++) col_lens[ict++] = j;
856:     }
857:     PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,0);
858:     PetscFree(col_lens);

860:     /* store nonzero values */
861:     PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
862:     ict  = 0;
863:     for (i=0; i<m; i++) {
864:       v = a->v + i;
865:       for (j=0; j<n; j++) {
866:         anonz[ict++] = *v; v += a->lda;
867:       }
868:     }
869:     PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,0);
870:     PetscFree(anonz);
871:   }
872:   return(0);
873: }

877: int MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
878: {
879:   Mat               A = (Mat) Aa;
880:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
881:   int               m = A->m,n = A->n,color,i,j,ierr;
882:   PetscScalar       *v = a->v;
883:   PetscViewer       viewer;
884:   PetscDraw         popup;
885:   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
886:   PetscViewerFormat format;


890:   PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
891:   PetscViewerGetFormat(viewer,&format);
892:   PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);

894:   /* Loop over matrix elements drawing boxes */
895:   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
896:     /* Blue for negative and Red for positive */
897:     color = PETSC_DRAW_BLUE;
898:     for(j = 0; j < n; j++) {
899:       x_l = j;
900:       x_r = x_l + 1.0;
901:       for(i = 0; i < m; i++) {
902:         y_l = m - i - 1.0;
903:         y_r = y_l + 1.0;
904: #if defined(PETSC_USE_COMPLEX)
905:         if (PetscRealPart(v[j*m+i]) >  0.) {
906:           color = PETSC_DRAW_RED;
907:         } else if (PetscRealPart(v[j*m+i]) <  0.) {
908:           color = PETSC_DRAW_BLUE;
909:         } else {
910:           continue;
911:         }
912: #else
913:         if (v[j*m+i] >  0.) {
914:           color = PETSC_DRAW_RED;
915:         } else if (v[j*m+i] <  0.) {
916:           color = PETSC_DRAW_BLUE;
917:         } else {
918:           continue;
919:         }
920: #endif
921:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
922:       }
923:     }
924:   } else {
925:     /* use contour shading to indicate magnitude of values */
926:     /* first determine max of all nonzero values */
927:     for(i = 0; i < m*n; i++) {
928:       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
929:     }
930:     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
931:     PetscDrawGetPopup(draw,&popup);
932:     if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
933:     for(j = 0; j < n; j++) {
934:       x_l = j;
935:       x_r = x_l + 1.0;
936:       for(i = 0; i < m; i++) {
937:         y_l   = m - i - 1.0;
938:         y_r   = y_l + 1.0;
939:         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
940:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
941:       }
942:     }
943:   }
944:   return(0);
945: }

949: int MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
950: {
951:   PetscDraw  draw;
952:   PetscTruth isnull;
953:   PetscReal  xr,yr,xl,yl,h,w;
954:   int        ierr;

957:   PetscViewerDrawGetDraw(viewer,0,&draw);
958:   PetscDrawIsNull(draw,&isnull);
959:   if (isnull == PETSC_TRUE) return(0);

961:   PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
962:   xr  = A->n; yr = A->m; h = yr/10.0; w = xr/10.0;
963:   xr += w;    yr += h;  xl = -w;     yl = -h;
964:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
965:   PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
966:   PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
967:   return(0);
968: }

972: int MatView_SeqDense(Mat A,PetscViewer viewer)
973: {
974:   Mat_SeqDense *a = (Mat_SeqDense*)A->data;
975:   int          ierr;
976:   PetscTruth   issocket,isascii,isbinary,isdraw;

979:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
980:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
981:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
982:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);

984:   if (issocket) {
985:     if (a->lda>A->m) SETERRQ(1,"Case can not handle LDA");
986:     PetscViewerSocketPutScalar(viewer,A->m,A->n,a->v);
987:   } else if (isascii) {
988:     MatView_SeqDense_ASCII(A,viewer);
989:   } else if (isbinary) {
990:     MatView_SeqDense_Binary(A,viewer);
991:   } else if (isdraw) {
992:     MatView_SeqDense_Draw(A,viewer);
993:   } else {
994:     SETERRQ1(1,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
995:   }
996:   return(0);
997: }

1001: int MatDestroy_SeqDense(Mat mat)
1002: {
1003:   Mat_SeqDense *l = (Mat_SeqDense*)mat->data;
1004:   int          ierr;

1007: #if defined(PETSC_USE_LOG)
1008:   PetscLogObjectState((PetscObject)mat,"Rows %d Cols %d",mat->m,mat->n);
1009: #endif
1010:   if (l->pivots) {PetscFree(l->pivots);}
1011:   if (!l->user_alloc) {PetscFree(l->v);}
1012:   PetscFree(l);
1013:   return(0);
1014: }

1018: int MatTranspose_SeqDense(Mat A,Mat *matout)
1019: {
1020:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1021:   int          k,j,m,n,M,ierr;
1022:   PetscScalar  *v,tmp;

1025:   v = mat->v; m = A->m; M = mat->lda; n = A->n;
1026:   if (!matout) { /* in place transpose */
1027:     if (m != n) {
1028:       SETERRQ(1,"Can not transpose non-square matrix in place");
1029:     } else {
1030:       for (j=0; j<m; j++) {
1031:         for (k=0; k<j; k++) {
1032:           tmp = v[j + k*M];
1033:           v[j + k*M] = v[k + j*M];
1034:           v[k + j*M] = tmp;
1035:         }
1036:       }
1037:     }
1038:   } else { /* out-of-place transpose */
1039:     Mat          tmat;
1040:     Mat_SeqDense *tmatd;
1041:     PetscScalar  *v2;

1043:     MatCreate(A->comm,A->n,A->m,A->n,A->m,&tmat);
1044:     MatSetType(tmat,A->type_name);
1045:     MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1046:     tmatd = (Mat_SeqDense*)tmat->data;
1047:     v = mat->v; v2 = tmatd->v;
1048:     for (j=0; j<n; j++) {
1049:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1050:     }
1051:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1052:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1053:     *matout = tmat;
1054:   }
1055:   return(0);
1056: }

1060: int MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1061: {
1062:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1063:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1064:   int          i,j;
1065:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1068:   if (A1->m != A2->m) {*flg = PETSC_FALSE; return(0);}
1069:   if (A1->n != A2->n) {*flg = PETSC_FALSE; return(0);}
1070:   for (i=0; i<A1->m; i++) {
1071:     v1 = mat1->v+i; v2 = mat2->v+i;
1072:     for (j=0; j<A1->n; j++) {
1073:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1074:       v1 += mat1->lda; v2 += mat2->lda;
1075:     }
1076:   }
1077:   *flg = PETSC_TRUE;
1078:   return(0);
1079: }

1083: int MatGetDiagonal_SeqDense(Mat A,Vec v)
1084: {
1085:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1086:   int          ierr,i,n,len;
1087:   PetscScalar  *x,zero = 0.0;

1090:   VecSet(&zero,v);
1091:   VecGetSize(v,&n);
1092:   VecGetArray(v,&x);
1093:   len = PetscMin(A->m,A->n);
1094:   if (n != A->m) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1095:   for (i=0; i<len; i++) {
1096:     x[i] = mat->v[i*mat->lda + i];
1097:   }
1098:   VecRestoreArray(v,&x);
1099:   return(0);
1100: }

1104: int MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1105: {
1106:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1107:   PetscScalar  *l,*r,x,*v;
1108:   int          ierr,i,j,m = A->m,n = A->n;

1111:   if (ll) {
1112:     VecGetSize(ll,&m);
1113:     VecGetArray(ll,&l);
1114:     if (m != A->m) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1115:     for (i=0; i<m; i++) {
1116:       x = l[i];
1117:       v = mat->v + i;
1118:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1119:     }
1120:     VecRestoreArray(ll,&l);
1121:     PetscLogFlops(n*m);
1122:   }
1123:   if (rr) {
1124:     VecGetSize(rr,&n);
1125:     VecGetArray(rr,&r);
1126:     if (n != A->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1127:     for (i=0; i<n; i++) {
1128:       x = r[i];
1129:       v = mat->v + i*m;
1130:       for (j=0; j<m; j++) { (*v++) *= x;}
1131:     }
1132:     VecRestoreArray(rr,&r);
1133:     PetscLogFlops(n*m);
1134:   }
1135:   return(0);
1136: }

1140: int MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1141: {
1142:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1143:   PetscScalar  *v = mat->v;
1144:   PetscReal    sum = 0.0;
1145:   int          lda=mat->lda,m=A->m,i,j;

1148:   if (type == NORM_FROBENIUS) {
1149:     if (lda>m) {
1150:       for (j=0; j<A->n; j++) {
1151:         v = mat->v+j*lda;
1152:         for (i=0; i<m; i++) {
1153: #if defined(PETSC_USE_COMPLEX)
1154:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1155: #else
1156:           sum += (*v)*(*v); v++;
1157: #endif
1158:         }
1159:       }
1160:     } else {
1161:       for (i=0; i<A->n*A->m; i++) {
1162: #if defined(PETSC_USE_COMPLEX)
1163:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1164: #else
1165:         sum += (*v)*(*v); v++;
1166: #endif
1167:       }
1168:     }
1169:     *nrm = sqrt(sum);
1170:     PetscLogFlops(2*A->n*A->m);
1171:   } else if (type == NORM_1) {
1172:     *nrm = 0.0;
1173:     for (j=0; j<A->n; j++) {
1174:       v = mat->v + j*mat->lda;
1175:       sum = 0.0;
1176:       for (i=0; i<A->m; i++) {
1177:         sum += PetscAbsScalar(*v);  v++;
1178:       }
1179:       if (sum > *nrm) *nrm = sum;
1180:     }
1181:     PetscLogFlops(A->n*A->m);
1182:   } else if (type == NORM_INFINITY) {
1183:     *nrm = 0.0;
1184:     for (j=0; j<A->m; j++) {
1185:       v = mat->v + j;
1186:       sum = 0.0;
1187:       for (i=0; i<A->n; i++) {
1188:         sum += PetscAbsScalar(*v); v += mat->lda;
1189:       }
1190:       if (sum > *nrm) *nrm = sum;
1191:     }
1192:     PetscLogFlops(A->n*A->m);
1193:   } else {
1194:     SETERRQ(PETSC_ERR_SUP,"No two norm");
1195:   }
1196:   return(0);
1197: }

1201: int MatSetOption_SeqDense(Mat A,MatOption op)
1202: {
1203:   Mat_SeqDense *aij = (Mat_SeqDense*)A->data;
1204: 
1206:   switch (op) {
1207:   case MAT_ROW_ORIENTED:
1208:     aij->roworiented = PETSC_TRUE;
1209:     break;
1210:   case MAT_COLUMN_ORIENTED:
1211:     aij->roworiented = PETSC_FALSE;
1212:     break;
1213:   case MAT_ROWS_SORTED:
1214:   case MAT_ROWS_UNSORTED:
1215:   case MAT_COLUMNS_SORTED:
1216:   case MAT_COLUMNS_UNSORTED:
1217:   case MAT_NO_NEW_NONZERO_LOCATIONS:
1218:   case MAT_YES_NEW_NONZERO_LOCATIONS:
1219:   case MAT_NEW_NONZERO_LOCATION_ERR:
1220:   case MAT_NO_NEW_DIAGONALS:
1221:   case MAT_YES_NEW_DIAGONALS:
1222:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1223:   case MAT_USE_HASH_TABLE:
1224:     PetscLogInfo(A,"MatSetOption_SeqDense:Option ignored\n");
1225:     break;
1226:   case MAT_SYMMETRIC:
1227:   case MAT_STRUCTURALLY_SYMMETRIC:
1228:   case MAT_NOT_SYMMETRIC:
1229:   case MAT_NOT_STRUCTURALLY_SYMMETRIC:
1230:   case MAT_HERMITIAN:
1231:   case MAT_NOT_HERMITIAN:
1232:   case MAT_SYMMETRY_ETERNAL:
1233:   case MAT_NOT_SYMMETRY_ETERNAL:
1234:     break;
1235:   default:
1236:     SETERRQ(PETSC_ERR_SUP,"unknown option");
1237:   }
1238:   return(0);
1239: }

1243: int MatZeroEntries_SeqDense(Mat A)
1244: {
1245:   Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1246:   int          lda=l->lda,m=A->m,j, ierr;

1249:   if (lda>m) {
1250:     for (j=0; j<A->n; j++) {
1251:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1252:     }
1253:   } else {
1254:     PetscMemzero(l->v,A->m*A->n*sizeof(PetscScalar));
1255:   }
1256:   return(0);
1257: }

1261: int MatGetBlockSize_SeqDense(Mat A,int *bs)
1262: {
1264:   *bs = 1;
1265:   return(0);
1266: }

1270: int MatZeroRows_SeqDense(Mat A,IS is,const PetscScalar *diag)
1271: {
1272:   Mat_SeqDense *l = (Mat_SeqDense*)A->data;
1273:   int          n = A->n,i,j,ierr,N,*rows;
1274:   PetscScalar  *slot;

1277:   ISGetLocalSize(is,&N);
1278:   ISGetIndices(is,&rows);
1279:   for (i=0; i<N; i++) {
1280:     slot = l->v + rows[i];
1281:     for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1282:   }
1283:   if (diag) {
1284:     for (i=0; i<N; i++) {
1285:       slot = l->v + (n+1)*rows[i];
1286:       *slot = *diag;
1287:     }
1288:   }
1289:   ISRestoreIndices(is,&rows);
1290:   return(0);
1291: }

1295: int MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1296: {
1297:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

1300:   *array = mat->v;
1301:   return(0);
1302: }

1306: int MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1307: {
1309:   *array = 0; /* user cannot accidently use the array later */
1310:   return(0);
1311: }

1315: static int MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,int cs,MatReuse scall,Mat *B)
1316: {
1317:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1318:   int          i,j,ierr,m = A->m,*irow,*icol,nrows,ncols;
1319:   PetscScalar  *av,*bv,*v = mat->v;
1320:   Mat          newmat;

1323:   ISGetIndices(isrow,&irow);
1324:   ISGetIndices(iscol,&icol);
1325:   ISGetLocalSize(isrow,&nrows);
1326:   ISGetLocalSize(iscol,&ncols);
1327: 
1328:   /* Check submatrixcall */
1329:   if (scall == MAT_REUSE_MATRIX) {
1330:     int n_cols,n_rows;
1331:     MatGetSize(*B,&n_rows,&n_cols);
1332:     if (n_rows != nrows || n_cols != ncols) SETERRQ(PETSC_ERR_ARG_SIZ,"Reused submatrix wrong size");
1333:     newmat = *B;
1334:   } else {
1335:     /* Create and fill new matrix */
1336:     MatCreate(A->comm,nrows,ncols,nrows,ncols,&newmat);
1337:     MatSetType(newmat,A->type_name);
1338:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1339:   }

1341:   /* Now extract the data pointers and do the copy,column at a time */
1342:   bv = ((Mat_SeqDense*)newmat->data)->v;
1343: 
1344:   for (i=0; i<ncols; i++) {
1345:     av = v + m*icol[i];
1346:     for (j=0; j<nrows; j++) {
1347:       *bv++ = av[irow[j]];
1348:     }
1349:   }

1351:   /* Assemble the matrices so that the correct flags are set */
1352:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1353:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1355:   /* Free work space */
1356:   ISRestoreIndices(isrow,&irow);
1357:   ISRestoreIndices(iscol,&icol);
1358:   *B = newmat;
1359:   return(0);
1360: }

1364: int MatGetSubMatrices_SeqDense(Mat A,int n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1365: {
1366:   int ierr,i;

1369:   if (scall == MAT_INITIAL_MATRIX) {
1370:     PetscMalloc((n+1)*sizeof(Mat),B);
1371:   }

1373:   for (i=0; i<n; i++) {
1374:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1375:   }
1376:   return(0);
1377: }

1381: int MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1382: {
1383:   Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1384:   int          lda1=a->lda,lda2=b->lda, m=A->m,n=A->n, j,ierr;

1387:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1388:   if (A->ops->copy != B->ops->copy) {
1389:     MatCopy_Basic(A,B,str);
1390:     return(0);
1391:   }
1392:   if (m != B->m || n != B->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1393:   if (lda1>m || lda2>m) {
1394:     for (j=0; j<n; j++) {
1395:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1396:     }
1397:   } else {
1398:     PetscMemcpy(b->v,a->v,A->m*A->n*sizeof(PetscScalar));
1399:   }
1400:   return(0);
1401: }

1405: int MatSetUpPreallocation_SeqDense(Mat A)
1406: {
1407:   int        ierr;

1410:    MatSeqDenseSetPreallocation(A,0);
1411:   return(0);
1412: }

1414: /* -------------------------------------------------------------------*/
1415: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1416:        MatGetRow_SeqDense,
1417:        MatRestoreRow_SeqDense,
1418:        MatMult_SeqDense,
1419: /* 4*/ MatMultAdd_SeqDense,
1420:        MatMultTranspose_SeqDense,
1421:        MatMultTransposeAdd_SeqDense,
1422:        MatSolve_SeqDense,
1423:        MatSolveAdd_SeqDense,
1424:        MatSolveTranspose_SeqDense,
1425: /*10*/ MatSolveTransposeAdd_SeqDense,
1426:        MatLUFactor_SeqDense,
1427:        MatCholeskyFactor_SeqDense,
1428:        MatRelax_SeqDense,
1429:        MatTranspose_SeqDense,
1430: /*15*/ MatGetInfo_SeqDense,
1431:        MatEqual_SeqDense,
1432:        MatGetDiagonal_SeqDense,
1433:        MatDiagonalScale_SeqDense,
1434:        MatNorm_SeqDense,
1435: /*20*/ 0,
1436:        0,
1437:        0,
1438:        MatSetOption_SeqDense,
1439:        MatZeroEntries_SeqDense,
1440: /*25*/ MatZeroRows_SeqDense,
1441:        MatLUFactorSymbolic_SeqDense,
1442:        MatLUFactorNumeric_SeqDense,
1443:        MatCholeskyFactorSymbolic_SeqDense,
1444:        MatCholeskyFactorNumeric_SeqDense,
1445: /*30*/ MatSetUpPreallocation_SeqDense,
1446:        0,
1447:        0,
1448:        MatGetArray_SeqDense,
1449:        MatRestoreArray_SeqDense,
1450: /*35*/ MatDuplicate_SeqDense,
1451:        0,
1452:        0,
1453:        0,
1454:        0,
1455: /*40*/ MatAXPY_SeqDense,
1456:        MatGetSubMatrices_SeqDense,
1457:        0,
1458:        MatGetValues_SeqDense,
1459:        MatCopy_SeqDense,
1460: /*45*/ 0,
1461:        MatScale_SeqDense,
1462:        0,
1463:        0,
1464:        0,
1465: /*50*/ MatGetBlockSize_SeqDense,
1466:        0,
1467:        0,
1468:        0,
1469:        0,
1470: /*55*/ 0,
1471:        0,
1472:        0,
1473:        0,
1474:        0,
1475: /*60*/ 0,
1476:        MatDestroy_SeqDense,
1477:        MatView_SeqDense,
1478:        MatGetPetscMaps_Petsc,
1479:        0,
1480: /*65*/ 0,
1481:        0,
1482:        0,
1483:        0,
1484:        0,
1485: /*70*/ 0,
1486:        0,
1487:        0,
1488:        0,
1489:        0,
1490: /*75*/ 0,
1491:        0,
1492:        0,
1493:        0,
1494:        0,
1495: /*80*/ 0,
1496:        0,
1497:        0,
1498:        0,
1499: /*85*/ MatLoad_SeqDense};

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

1508:    Collective on MPI_Comm

1510:    Input Parameters:
1511: +  comm - MPI communicator, set to PETSC_COMM_SELF
1512: .  m - number of rows
1513: .  n - number of columns
1514: -  data - optional location of matrix data.  Set data=PETSC_NULL for PETSc
1515:    to control all matrix memory allocation.

1517:    Output Parameter:
1518: .  A - the matrix

1520:    Notes:
1521:    The data input variable is intended primarily for Fortran programmers
1522:    who wish to allocate their own matrix memory space.  Most users should
1523:    set data=PETSC_NULL.

1525:    Level: intermediate

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

1529: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1530: @*/
1531: int MatCreateSeqDense(MPI_Comm comm,int m,int n,PetscScalar *data,Mat *A)
1532: {

1536:   MatCreate(comm,m,n,m,n,A);
1537:   MatSetType(*A,MATSEQDENSE);
1538:   MatSeqDenseSetPreallocation(*A,data);
1539:   return(0);
1540: }

1544: /*@C
1545:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

1547:    Collective on MPI_Comm

1549:    Input Parameters:
1550: +  A - the matrix
1551: -  data - the array (or PETSC_NULL)

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

1558:    Level: intermediate

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

1562: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1563: @*/
1564: int MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1565: {
1566:   int ierr,(*f)(Mat,PetscScalar[]);

1569:   PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1570:   if (f) {
1571:     (*f)(B,data);
1572:   }
1573:   return(0);
1574: }

1576: EXTERN_C_BEGIN
1579: int MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1580: {
1581:   Mat_SeqDense *b;
1582:   int          ierr;

1585:   B->preallocated = PETSC_TRUE;
1586:   b               = (Mat_SeqDense*)B->data;
1587:   if (!data) {
1588:     PetscMalloc((B->m*B->n+1)*sizeof(PetscScalar),&b->v);
1589:     PetscMemzero(b->v,B->m*B->n*sizeof(PetscScalar));
1590:     b->user_alloc = PETSC_FALSE;
1591:     PetscLogObjectMemory(B,B->n*B->m*sizeof(PetscScalar));
1592:   } else { /* user-allocated storage */
1593:     b->v          = data;
1594:     b->user_alloc = PETSC_TRUE;
1595:   }
1596:   return(0);
1597: }
1598: EXTERN_C_END

1602: /*@C
1603:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

1605:   Input parameter:
1606: + A - the matrix
1607: - lda - the leading dimension

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

1614:   Level: intermediate

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

1618: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation()
1619: @*/
1620: int MatSeqDenseSetLDA(Mat B,int lda)
1621: {
1622:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;
1624:   if (lda<B->m) SETERRQ(1,"LDA must be at least matrix i dimension");
1625:   b->lda = lda;
1626:   return(0);
1627: }

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

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

1635:   Level: beginner

1637: .seealso: MatCreateSeqDense
1638: M*/

1640: EXTERN_C_BEGIN
1643: int MatCreate_SeqDense(Mat B)
1644: {
1645:   Mat_SeqDense *b;
1646:   int          ierr,size;

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

1652:   B->m = B->M = PetscMax(B->m,B->M);
1653:   B->n = B->N = PetscMax(B->n,B->N);

1655:   PetscNew(Mat_SeqDense,&b);
1656:   PetscMemzero(b,sizeof(Mat_SeqDense));
1657:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
1658:   B->factor       = 0;
1659:   B->mapping      = 0;
1660:   PetscLogObjectMemory(B,sizeof(struct _p_Mat));
1661:   B->data         = (void*)b;

1663:   PetscMapCreateMPI(B->comm,B->m,B->m,&B->rmap);
1664:   PetscMapCreateMPI(B->comm,B->n,B->n,&B->cmap);

1666:   b->pivots       = 0;
1667:   b->roworiented  = PETSC_TRUE;
1668:   b->v            = 0;
1669:   b->lda          = B->m;

1671:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
1672:                                     "MatSeqDenseSetPreallocation_SeqDense",
1673:                                      MatSeqDenseSetPreallocation_SeqDense);
1674:   return(0);
1675: }
1676: EXTERN_C_END