Actual source code: dense.c

  1: #define PETSCMAT_DLL

  3: /*
  4:      Defines the basic matrix operations for sequential dense.
  5: */

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

 12: PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str)
 13: {
 14:   Mat_SeqDense   *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
 15:   PetscScalar    oalpha = alpha;
 16:   PetscInt       j;
 17:   PetscBLASInt   N,m,ldax,lday,one = 1;

 21:   N    = PetscBLASIntCast(X->rmap->n*X->cmap->n);
 22:   m    = PetscBLASIntCast(X->rmap->n);
 23:   ldax = PetscBLASIntCast(x->lda);
 24:   lday = PetscBLASIntCast(y->lda);
 25:   if (ldax>m || lday>m) {
 26:     for (j=0; j<X->cmap->n; j++) {
 27:       BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
 28:     }
 29:   } else {
 30:     BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
 31:   }
 32:   PetscLogFlops(PetscMax(2*N-1,0));
 33:   return(0);
 34: }

 38: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
 39: {
 40:   PetscInt     N = A->rmap->n*A->cmap->n;

 43:   info->block_size        = 1.0;
 44:   info->nz_allocated      = (double)N;
 45:   info->nz_used           = (double)N;
 46:   info->nz_unneeded       = (double)0;
 47:   info->assemblies        = (double)A->num_ass;
 48:   info->mallocs           = 0;
 49:   info->memory            = ((PetscObject)A)->mem;
 50:   info->fill_ratio_given  = 0;
 51:   info->fill_ratio_needed = 0;
 52:   info->factor_mallocs    = 0;
 53:   return(0);
 54: }

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

 66:   if (lda>A->rmap->n) {
 67:     nz = PetscBLASIntCast(A->rmap->n);
 68:     for (j=0; j<A->cmap->n; j++) {
 69:       BLASscal_(&nz,&oalpha,a->v+j*lda,&one);
 70:     }
 71:   } else {
 72:     nz = PetscBLASIntCast(A->rmap->n*A->cmap->n);
 73:     BLASscal_(&nz,&oalpha,a->v,&one);
 74:   }
 75:   PetscLogFlops(nz);
 76:   return(0);
 77: }

 81: PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscTruth *fl)
 82: {
 83:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
 84:   PetscInt       i,j,m = A->rmap->n,N;
 85:   PetscScalar    *v = a->v;

 88:   *fl = PETSC_FALSE;
 89:   if (A->rmap->n != A->cmap->n) return(0);
 90:   N = a->lda;

 92:   for (i=0; i<m; i++) {
 93:     for (j=i+1; j<m; j++) {
 94:       if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) return(0);
 95:     }
 96:   }
 97:   *fl = PETSC_TRUE;
 98:   return(0);
 99: }
100: 
103: PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
104: {
105:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l;
107:   PetscInt       lda = (PetscInt)mat->lda,j,m;

110:   MatSeqDenseSetPreallocation(newi,PETSC_NULL);
111:   if (cpvalues == MAT_COPY_VALUES) {
112:     l = (Mat_SeqDense*)newi->data;
113:     if (lda>A->rmap->n) {
114:       m = A->rmap->n;
115:       for (j=0; j<A->cmap->n; j++) {
116:         PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
117:       }
118:     } else {
119:       PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
120:     }
121:   }
122:   newi->assembled = PETSC_TRUE;
123:   return(0);
124: }

128: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
129: {

133:   MatCreate(((PetscObject)A)->comm,newmat);
134:   MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
135:   MatSetType(*newmat,((PetscObject)A)->type_name);
136:   MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);
137:   return(0);
138: }



145: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
146: {
147:   MatFactorInfo  info;

151:   MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
152:   MatLUFactor_SeqDense(fact,0,0,&info);
153:   return(0);
154: }

158: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
159: {
160:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
162:   PetscScalar    *x,*y;
163:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
164: 
166:   VecGetArray(xx,&x);
167:   VecGetArray(yy,&y);
168:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
169:   if (A->factor == MAT_FACTOR_LU) {
170: #if defined(PETSC_MISSING_LAPACK_GETRS) 
171:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
172: #else
173:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
174:     if (info) SETERRQ(PETSC_ERR_LIB,"GETRS - Bad solve");
175: #endif
176:   } else if (A->factor == MAT_FACTOR_CHOLESKY){
177: #if defined(PETSC_MISSING_LAPACK_POTRS) 
178:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
179: #else
180:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
181:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS Bad solve");
182: #endif
183:   }
184:   else SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
185:   VecRestoreArray(xx,&x);
186:   VecRestoreArray(yy,&y);
187:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
188:   return(0);
189: }

193: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
194: {
195:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
197:   PetscScalar    *x,*y;
198:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
199: 
201:   VecGetArray(xx,&x);
202:   VecGetArray(yy,&y);
203:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
204:   /* assume if pivots exist then use LU; else Cholesky */
205:   if (mat->pivots) {
206: #if defined(PETSC_MISSING_LAPACK_GETRS) 
207:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
208: #else
209:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
210:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
211: #endif
212:   } else {
213: #if defined(PETSC_MISSING_LAPACK_POTRS) 
214:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
215: #else
216:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
217:     if (info) SETERRQ(PETSC_ERR_LIB,"POTRS - Bad solve");
218: #endif
219:   }
220:   VecRestoreArray(xx,&x);
221:   VecRestoreArray(yy,&y);
222:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
223:   return(0);
224: }

228: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
229: {
230:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
232:   PetscScalar    *x,*y,sone = 1.0;
233:   Vec            tmp = 0;
234:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
235: 
237:   VecGetArray(xx,&x);
238:   VecGetArray(yy,&y);
239:   if (!A->rmap->n || !A->cmap->n) return(0);
240:   if (yy == zz) {
241:     VecDuplicate(yy,&tmp);
242:     PetscLogObjectParent(A,tmp);
243:     VecCopy(yy,tmp);
244:   }
245:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
246:   /* assume if pivots exist then use LU; else Cholesky */
247:   if (mat->pivots) {
248: #if defined(PETSC_MISSING_LAPACK_GETRS) 
249:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
250: #else
251:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
252:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
253: #endif
254:   } else {
255: #if defined(PETSC_MISSING_LAPACK_POTRS) 
256:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
257: #else
258:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
259:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
260: #endif
261:   }
262:   if (tmp) {VecAXPY(yy,sone,tmp); VecDestroy(tmp);}
263:   else     {VecAXPY(yy,sone,zz);}
264:   VecRestoreArray(xx,&x);
265:   VecRestoreArray(yy,&y);
266:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
267:   return(0);
268: }

272: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
273: {
274:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
276:   PetscScalar    *x,*y,sone = 1.0;
277:   Vec            tmp;
278:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
279: 
281:   if (!A->rmap->n || !A->cmap->n) return(0);
282:   VecGetArray(xx,&x);
283:   VecGetArray(yy,&y);
284:   if (yy == zz) {
285:     VecDuplicate(yy,&tmp);
286:     PetscLogObjectParent(A,tmp);
287:     VecCopy(yy,tmp);
288:   }
289:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
290:   /* assume if pivots exist then use LU; else Cholesky */
291:   if (mat->pivots) {
292: #if defined(PETSC_MISSING_LAPACK_GETRS) 
293:     SETERRQ(PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
294: #else
295:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
296:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
297: #endif
298:   } else {
299: #if defined(PETSC_MISSING_LAPACK_POTRS) 
300:     SETERRQ(PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
301: #else
302:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
303:     if (info) SETERRQ(PETSC_ERR_LIB,"Bad solve");
304: #endif
305:   }
306:   if (tmp) {
307:     VecAXPY(yy,sone,tmp);
308:     VecDestroy(tmp);
309:   } else {
310:     VecAXPY(yy,sone,zz);
311:   }
312:   VecRestoreArray(xx,&x);
313:   VecRestoreArray(yy,&y);
314:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
315:   return(0);
316: }

318: /* ---------------------------------------------------------------*/
319: /* COMMENT: I have chosen to hide row permutation in the pivots,
320:    rather than put it in the Mat->row slot.*/
323: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
324: {
325: #if defined(PETSC_MISSING_LAPACK_GETRF) 
327:   SETERRQ(PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
328: #else
329:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
331:   PetscBLASInt   n,m,info;

334:   n = PetscBLASIntCast(A->cmap->n);
335:   m = PetscBLASIntCast(A->rmap->n);
336:   if (!mat->pivots) {
337:     PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
338:     PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
339:   }
340:   if (!A->rmap->n || !A->cmap->n) return(0);
341:   LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
342:   if (info<0) SETERRQ(PETSC_ERR_LIB,"Bad argument to LU factorization");
343:   if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
344:   A->ops->solve             = MatSolve_SeqDense;
345:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
346:   A->ops->solveadd          = MatSolveAdd_SeqDense;
347:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
348:   A->factor = MAT_FACTOR_LU;

350:   PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);
351: #endif
352:   return(0);
353: }

357: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
358: {
359: #if defined(PETSC_MISSING_LAPACK_POTRF) 
361:   SETERRQ(PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
362: #else
363:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
365:   PetscBLASInt   info,n = PetscBLASIntCast(A->cmap->n);
366: 
368:   PetscFree(mat->pivots);
369:   mat->pivots = 0;

371:   if (!A->rmap->n || !A->cmap->n) return(0);
372:   LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
373:   if (info) SETERRQ1(PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
374:   A->ops->solve             = MatSolve_SeqDense;
375:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
376:   A->ops->solveadd          = MatSolveAdd_SeqDense;
377:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
378:   A->factor = MAT_FACTOR_CHOLESKY;
379:   PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);
380: #endif
381:   return(0);
382: }


387: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
388: {
390:   MatFactorInfo  info;

393:   info.fill = 1.0;
394:   MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
395:   MatCholeskyFactor_SeqDense(fact,0,&info);
396:   return(0);
397: }

401: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
402: {
404:   fact->assembled                  = PETSC_TRUE;
405:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
406:   return(0);
407: }

411: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
412: {
414:   fact->assembled            = PETSC_TRUE;
415:   fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
416:   return(0);
417: }

422: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
423: {

427:   MatCreate(((PetscObject)A)->comm,fact);
428:   MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
429:   MatSetType(*fact,((PetscObject)A)->type_name);
430:   if (ftype == MAT_FACTOR_LU){
431:     (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
432:   } else {
433:     (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
434:   }
435:   (*fact)->factor = ftype;
436:   return(0);
437: }

440: /* ------------------------------------------------------------------*/
443: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
444: {
445:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
446:   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
448:   PetscInt       m = A->rmap->n,i;
449: #if !defined(PETSC_USE_COMPLEX)
450:   PetscBLASInt   o = 1,bm = PetscBLASIntCast(m);
451: #endif

454:   if (flag & SOR_ZERO_INITIAL_GUESS) {
455:     /* this is a hack fix, should have another version without the second BLASdot */
456:     VecSet(xx,zero);
457:   }
458:   VecGetArray(xx,&x);
459:   VecGetArray(bb,&b);
460:   its  = its*lits;
461:   if (its <= 0) SETERRQ2(PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
462:   while (its--) {
463:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
464:       for (i=0; i<m; i++) {
465: #if defined(PETSC_USE_COMPLEX)
466:         /* cannot use BLAS dot for complex because compiler/linker is 
467:            not happy about returning a double complex */
468:         PetscInt    _i;
469:         PetscScalar sum = b[i];
470:         for (_i=0; _i<m; _i++) {
471:           sum -= PetscConj(v[i+_i*m])*x[_i];
472:         }
473:         xt = sum;
474: #else
475:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
476: #endif
477:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
478:       }
479:     }
480:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
481:       for (i=m-1; i>=0; i--) {
482: #if defined(PETSC_USE_COMPLEX)
483:         /* cannot use BLAS dot for complex because compiler/linker is 
484:            not happy about returning a double complex */
485:         PetscInt    _i;
486:         PetscScalar sum = b[i];
487:         for (_i=0; _i<m; _i++) {
488:           sum -= PetscConj(v[i+_i*m])*x[_i];
489:         }
490:         xt = sum;
491: #else
492:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
493: #endif
494:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
495:       }
496:     }
497:   }
498:   VecRestoreArray(bb,&b);
499:   VecRestoreArray(xx,&x);
500:   return(0);
501: }

503: /* -----------------------------------------------------------------*/
506: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
507: {
508:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
509:   PetscScalar    *v = mat->v,*x,*y;
511:   PetscBLASInt   m, n,_One=1;
512:   PetscScalar    _DOne=1.0,_DZero=0.0;

515:   m = PetscBLASIntCast(A->rmap->n);
516:   n = PetscBLASIntCast(A->cmap->n);
517:   if (!A->rmap->n || !A->cmap->n) return(0);
518:   VecGetArray(xx,&x);
519:   VecGetArray(yy,&y);
520:   BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
521:   VecRestoreArray(xx,&x);
522:   VecRestoreArray(yy,&y);
523:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);
524:   return(0);
525: }

529: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
530: {
531:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
532:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
534:   PetscBLASInt   m, n, _One=1;

537:   m = PetscBLASIntCast(A->rmap->n);
538:   n = PetscBLASIntCast(A->cmap->n);
539:   if (!A->rmap->n || !A->cmap->n) return(0);
540:   VecGetArray(xx,&x);
541:   VecGetArray(yy,&y);
542:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
543:   VecRestoreArray(xx,&x);
544:   VecRestoreArray(yy,&y);
545:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);
546:   return(0);
547: }

551: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
552: {
553:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
554:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
556:   PetscBLASInt   m, n, _One=1;

559:   m = PetscBLASIntCast(A->rmap->n);
560:   n = PetscBLASIntCast(A->cmap->n);
561:   if (!A->rmap->n || !A->cmap->n) return(0);
562:   if (zz != yy) {VecCopy(zz,yy);}
563:   VecGetArray(xx,&x);
564:   VecGetArray(yy,&y);
565:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
566:   VecRestoreArray(xx,&x);
567:   VecRestoreArray(yy,&y);
568:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
569:   return(0);
570: }

574: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
575: {
576:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
577:   PetscScalar    *v = mat->v,*x,*y;
579:   PetscBLASInt   m, n, _One=1;
580:   PetscScalar    _DOne=1.0;

583:   m = PetscBLASIntCast(A->rmap->n);
584:   n = PetscBLASIntCast(A->cmap->n);
585:   if (!A->rmap->n || !A->cmap->n) return(0);
586:   if (zz != yy) {VecCopy(zz,yy);}
587:   VecGetArray(xx,&x);
588:   VecGetArray(yy,&y);
589:   BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
590:   VecRestoreArray(xx,&x);
591:   VecRestoreArray(yy,&y);
592:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
593:   return(0);
594: }

596: /* -----------------------------------------------------------------*/
599: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
600: {
601:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
602:   PetscScalar    *v;
604:   PetscInt       i;
605: 
607:   *ncols = A->cmap->n;
608:   if (cols) {
609:     PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
610:     for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
611:   }
612:   if (vals) {
613:     PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
614:     v    = mat->v + row;
615:     for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
616:   }
617:   return(0);
618: }

622: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
623: {
626:   if (cols) {PetscFree(*cols);}
627:   if (vals) {PetscFree(*vals); }
628:   return(0);
629: }
630: /* ----------------------------------------------------------------*/
633: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
634: {
635:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
636:   PetscInt     i,j,idx=0;
637: 
640:   if (!mat->roworiented) {
641:     if (addv == INSERT_VALUES) {
642:       for (j=0; j<n; j++) {
643:         if (indexn[j] < 0) {idx += m; continue;}
644: #if defined(PETSC_USE_DEBUG)  
645:         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
646: #endif
647:         for (i=0; i<m; i++) {
648:           if (indexm[i] < 0) {idx++; continue;}
649: #if defined(PETSC_USE_DEBUG)  
650:           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
651: #endif
652:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
653:         }
654:       }
655:     } else {
656:       for (j=0; j<n; j++) {
657:         if (indexn[j] < 0) {idx += m; continue;}
658: #if defined(PETSC_USE_DEBUG)  
659:         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
660: #endif
661:         for (i=0; i<m; i++) {
662:           if (indexm[i] < 0) {idx++; continue;}
663: #if defined(PETSC_USE_DEBUG)  
664:           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
665: #endif
666:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
667:         }
668:       }
669:     }
670:   } else {
671:     if (addv == INSERT_VALUES) {
672:       for (i=0; i<m; i++) {
673:         if (indexm[i] < 0) { idx += n; continue;}
674: #if defined(PETSC_USE_DEBUG)  
675:         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
676: #endif
677:         for (j=0; j<n; j++) {
678:           if (indexn[j] < 0) { idx++; continue;}
679: #if defined(PETSC_USE_DEBUG)  
680:           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
681: #endif
682:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
683:         }
684:       }
685:     } else {
686:       for (i=0; i<m; i++) {
687:         if (indexm[i] < 0) { idx += n; continue;}
688: #if defined(PETSC_USE_DEBUG)  
689:         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
690: #endif
691:         for (j=0; j<n; j++) {
692:           if (indexn[j] < 0) { idx++; continue;}
693: #if defined(PETSC_USE_DEBUG)  
694:           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
695: #endif
696:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
697:         }
698:       }
699:     }
700:   }
701:   return(0);
702: }

706: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
707: {
708:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
709:   PetscInt     i,j;

712:   /* row-oriented output */
713:   for (i=0; i<m; i++) {
714:     if (indexm[i] < 0) {v += n;continue;}
715:     if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
716:     for (j=0; j<n; j++) {
717:       if (indexn[j] < 0) {v++; continue;}
718:       if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
719:       *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
720:     }
721:   }
722:   return(0);
723: }

725: /* -----------------------------------------------------------------*/

729: PetscErrorCode MatLoad_SeqDense(PetscViewer viewer, const MatType type,Mat *A)
730: {
731:   Mat_SeqDense   *a;
732:   Mat            B;
734:   PetscInt       *scols,i,j,nz,header[4];
735:   int            fd;
736:   PetscMPIInt    size;
737:   PetscInt       *rowlengths = 0,M,N,*cols;
738:   PetscScalar    *vals,*svals,*v,*w;
739:   MPI_Comm       comm = ((PetscObject)viewer)->comm;

742:   MPI_Comm_size(comm,&size);
743:   if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,"view must have one processor");
744:   PetscViewerBinaryGetDescriptor(viewer,&fd);
745:   PetscBinaryRead(fd,header,4,PETSC_INT);
746:   if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
747:   M = header[1]; N = header[2]; nz = header[3];

749:   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
750:     MatCreate(comm,A);
751:     MatSetSizes(*A,M,N,M,N);
752:     MatSetType(*A,type);
753:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
754:     B    = *A;
755:     a    = (Mat_SeqDense*)B->data;
756:     v    = a->v;
757:     /* Allocate some temp space to read in the values and then flip them
758:        from row major to column major */
759:     PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
760:     /* read in nonzero values */
761:     PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
762:     /* now flip the values and store them in the matrix*/
763:     for (j=0; j<N; j++) {
764:       for (i=0; i<M; i++) {
765:         *v++ =w[i*N+j];
766:       }
767:     }
768:     PetscFree(w);
769:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
770:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
771:   } else {
772:     /* read row lengths */
773:     PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
774:     PetscBinaryRead(fd,rowlengths,M,PETSC_INT);

776:     /* create our matrix */
777:     MatCreate(comm,A);
778:     MatSetSizes(*A,M,N,M,N);
779:     MatSetType(*A,type);
780:     MatSeqDenseSetPreallocation(*A,PETSC_NULL);
781:     B = *A;
782:     a = (Mat_SeqDense*)B->data;
783:     v = a->v;

785:     /* read column indices and nonzeros */
786:     PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
787:     cols = scols;
788:     PetscBinaryRead(fd,cols,nz,PETSC_INT);
789:     PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
790:     vals = svals;
791:     PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);

793:     /* insert into matrix */
794:     for (i=0; i<M; i++) {
795:       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
796:       svals += rowlengths[i]; scols += rowlengths[i];
797:     }
798:     PetscFree(vals);
799:     PetscFree(cols);
800:     PetscFree(rowlengths);

802:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
803:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
804:   }
805:   return(0);
806: }

810: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
811: {
812:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
813:   PetscErrorCode    ierr;
814:   PetscInt          i,j;
815:   const char        *name;
816:   PetscScalar       *v;
817:   PetscViewerFormat format;
818: #if defined(PETSC_USE_COMPLEX)
819:   PetscTruth        allreal = PETSC_TRUE;
820: #endif

823:   PetscObjectGetName((PetscObject)A,&name);
824:   PetscViewerGetFormat(viewer,&format);
825:   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
826:     return(0);  /* do nothing for now */
827:   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
828:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
829:     for (i=0; i<A->rmap->n; i++) {
830:       v = a->v + i;
831:       PetscViewerASCIIPrintf(viewer,"row %D:",i);
832:       for (j=0; j<A->cmap->n; j++) {
833: #if defined(PETSC_USE_COMPLEX)
834:         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
835:           PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
836:         } else if (PetscRealPart(*v)) {
837:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
838:         }
839: #else
840:         if (*v) {
841:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
842:         }
843: #endif
844:         v += a->lda;
845:       }
846:       PetscViewerASCIIPrintf(viewer,"\n");
847:     }
848:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
849:   } else {
850:     PetscViewerASCIIUseTabs(viewer,PETSC_NO);
851: #if defined(PETSC_USE_COMPLEX)
852:     /* determine if matrix has all real values */
853:     v = a->v;
854:     for (i=0; i<A->rmap->n*A->cmap->n; i++) {
855:         if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
856:     }
857: #endif
858:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
859:       PetscObjectGetName((PetscObject)A,&name);
860:       PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
861:       PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
862:       PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
863:     }

865:     for (i=0; i<A->rmap->n; i++) {
866:       v = a->v + i;
867:       for (j=0; j<A->cmap->n; j++) {
868: #if defined(PETSC_USE_COMPLEX)
869:         if (allreal) {
870:           PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
871:         } else {
872:           PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
873:         }
874: #else
875:         PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
876: #endif
877:         v += a->lda;
878:       }
879:       PetscViewerASCIIPrintf(viewer,"\n");
880:     }
881:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
882:       PetscViewerASCIIPrintf(viewer,"];\n");
883:     }
884:     PetscViewerASCIIUseTabs(viewer,PETSC_YES);
885:   }
886:   PetscViewerFlush(viewer);
887:   return(0);
888: }

892: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
893: {
894:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
895:   PetscErrorCode    ierr;
896:   int               fd;
897:   PetscInt          ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
898:   PetscScalar       *v,*anonz,*vals;
899:   PetscViewerFormat format;
900: 
902:   PetscViewerBinaryGetDescriptor(viewer,&fd);

904:   PetscViewerGetFormat(viewer,&format);
905:   if (format == PETSC_VIEWER_NATIVE) {
906:     /* store the matrix as a dense matrix */
907:     PetscMalloc(4*sizeof(PetscInt),&col_lens);
908:     col_lens[0] = MAT_FILE_COOKIE;
909:     col_lens[1] = m;
910:     col_lens[2] = n;
911:     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
912:     PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
913:     PetscFree(col_lens);

915:     /* write out matrix, by rows */
916:     PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
917:     v    = a->v;
918:     for (j=0; j<n; j++) {
919:       for (i=0; i<m; i++) {
920:         vals[j + i*n] = *v++;
921:       }
922:     }
923:     PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
924:     PetscFree(vals);
925:   } else {
926:     PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
927:     col_lens[0] = MAT_FILE_COOKIE;
928:     col_lens[1] = m;
929:     col_lens[2] = n;
930:     col_lens[3] = nz;

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

936:     /* Possibly should write in smaller increments, not whole matrix at once? */
937:     /* store column indices (zero start index) */
938:     ict = 0;
939:     for (i=0; i<m; i++) {
940:       for (j=0; j<n; j++) col_lens[ict++] = j;
941:     }
942:     PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
943:     PetscFree(col_lens);

945:     /* store nonzero values */
946:     PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
947:     ict  = 0;
948:     for (i=0; i<m; i++) {
949:       v = a->v + i;
950:       for (j=0; j<n; j++) {
951:         anonz[ict++] = *v; v += a->lda;
952:       }
953:     }
954:     PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
955:     PetscFree(anonz);
956:   }
957:   return(0);
958: }

962: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
963: {
964:   Mat               A = (Mat) Aa;
965:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
966:   PetscErrorCode    ierr;
967:   PetscInt          m = A->rmap->n,n = A->cmap->n,color,i,j;
968:   PetscScalar       *v = a->v;
969:   PetscViewer       viewer;
970:   PetscDraw         popup;
971:   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
972:   PetscViewerFormat format;


976:   PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
977:   PetscViewerGetFormat(viewer,&format);
978:   PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);

980:   /* Loop over matrix elements drawing boxes */
981:   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
982:     /* Blue for negative and Red for positive */
983:     color = PETSC_DRAW_BLUE;
984:     for(j = 0; j < n; j++) {
985:       x_l = j;
986:       x_r = x_l + 1.0;
987:       for(i = 0; i < m; i++) {
988:         y_l = m - i - 1.0;
989:         y_r = y_l + 1.0;
990: #if defined(PETSC_USE_COMPLEX)
991:         if (PetscRealPart(v[j*m+i]) >  0.) {
992:           color = PETSC_DRAW_RED;
993:         } else if (PetscRealPart(v[j*m+i]) <  0.) {
994:           color = PETSC_DRAW_BLUE;
995:         } else {
996:           continue;
997:         }
998: #else
999:         if (v[j*m+i] >  0.) {
1000:           color = PETSC_DRAW_RED;
1001:         } else if (v[j*m+i] <  0.) {
1002:           color = PETSC_DRAW_BLUE;
1003:         } else {
1004:           continue;
1005:         }
1006: #endif
1007:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1008:       }
1009:     }
1010:   } else {
1011:     /* use contour shading to indicate magnitude of values */
1012:     /* first determine max of all nonzero values */
1013:     for(i = 0; i < m*n; i++) {
1014:       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1015:     }
1016:     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1017:     PetscDrawGetPopup(draw,&popup);
1018:     if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1019:     for(j = 0; j < n; j++) {
1020:       x_l = j;
1021:       x_r = x_l + 1.0;
1022:       for(i = 0; i < m; i++) {
1023:         y_l   = m - i - 1.0;
1024:         y_r   = y_l + 1.0;
1025:         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1026:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1027:       }
1028:     }
1029:   }
1030:   return(0);
1031: }

1035: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1036: {
1037:   PetscDraw      draw;
1038:   PetscTruth     isnull;
1039:   PetscReal      xr,yr,xl,yl,h,w;

1043:   PetscViewerDrawGetDraw(viewer,0,&draw);
1044:   PetscDrawIsNull(draw,&isnull);
1045:   if (isnull) return(0);

1047:   PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1048:   xr  = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1049:   xr += w;    yr += h;  xl = -w;     yl = -h;
1050:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1051:   PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1052:   PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1053:   return(0);
1054: }

1058: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1059: {
1061:   PetscTruth     iascii,isbinary,isdraw;

1064:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
1065:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
1066:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);

1068:   if (iascii) {
1069:     MatView_SeqDense_ASCII(A,viewer);
1070:   } else if (isbinary) {
1071:     MatView_SeqDense_Binary(A,viewer);
1072:   } else if (isdraw) {
1073:     MatView_SeqDense_Draw(A,viewer);
1074:   } else {
1075:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1076:   }
1077:   return(0);
1078: }

1082: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1083: {
1084:   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;

1088: #if defined(PETSC_USE_LOG)
1089:   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1090: #endif
1091:   PetscFree(l->pivots);
1092:   if (!l->user_alloc) {PetscFree(l->v);}
1093:   PetscFree(l);

1095:   PetscObjectChangeTypeName((PetscObject)mat,0);
1096:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1097:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1098:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1099:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1100:   return(0);
1101: }

1105: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1106: {
1107:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1109:   PetscInt       k,j,m,n,M;
1110:   PetscScalar    *v,tmp;

1113:   v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1114:   if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1115:     if (m != n) {
1116:       SETERRQ(PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1117:     } else {
1118:       for (j=0; j<m; j++) {
1119:         for (k=0; k<j; k++) {
1120:           tmp = v[j + k*M];
1121:           v[j + k*M] = v[k + j*M];
1122:           v[k + j*M] = tmp;
1123:         }
1124:       }
1125:     }
1126:   } else { /* out-of-place transpose */
1127:     Mat          tmat;
1128:     Mat_SeqDense *tmatd;
1129:     PetscScalar  *v2;

1131:     if (reuse == MAT_INITIAL_MATRIX) {
1132:       MatCreate(((PetscObject)A)->comm,&tmat);
1133:       MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1134:       MatSetType(tmat,((PetscObject)A)->type_name);
1135:       MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1136:     } else {
1137:       tmat = *matout;
1138:     }
1139:     tmatd = (Mat_SeqDense*)tmat->data;
1140:     v = mat->v; v2 = tmatd->v;
1141:     for (j=0; j<n; j++) {
1142:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1143:     }
1144:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1145:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1146:     *matout = tmat;
1147:   }
1148:   return(0);
1149: }

1153: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscTruth *flg)
1154: {
1155:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1156:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1157:   PetscInt     i,j;
1158:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1161:   if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1162:   if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1163:   for (i=0; i<A1->rmap->n; i++) {
1164:     v1 = mat1->v+i; v2 = mat2->v+i;
1165:     for (j=0; j<A1->cmap->n; j++) {
1166:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1167:       v1 += mat1->lda; v2 += mat2->lda;
1168:     }
1169:   }
1170:   *flg = PETSC_TRUE;
1171:   return(0);
1172: }

1176: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1177: {
1178:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1180:   PetscInt       i,n,len;
1181:   PetscScalar    *x,zero = 0.0;

1184:   VecSet(v,zero);
1185:   VecGetSize(v,&n);
1186:   VecGetArray(v,&x);
1187:   len = PetscMin(A->rmap->n,A->cmap->n);
1188:   if (n != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1189:   for (i=0; i<len; i++) {
1190:     x[i] = mat->v[i*mat->lda + i];
1191:   }
1192:   VecRestoreArray(v,&x);
1193:   return(0);
1194: }

1198: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1199: {
1200:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1201:   PetscScalar    *l,*r,x,*v;
1203:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n;

1206:   if (ll) {
1207:     VecGetSize(ll,&m);
1208:     VecGetArray(ll,&l);
1209:     if (m != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1210:     for (i=0; i<m; i++) {
1211:       x = l[i];
1212:       v = mat->v + i;
1213:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1214:     }
1215:     VecRestoreArray(ll,&l);
1216:     PetscLogFlops(n*m);
1217:   }
1218:   if (rr) {
1219:     VecGetSize(rr,&n);
1220:     VecGetArray(rr,&r);
1221:     if (n != A->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1222:     for (i=0; i<n; i++) {
1223:       x = r[i];
1224:       v = mat->v + i*m;
1225:       for (j=0; j<m; j++) { (*v++) *= x;}
1226:     }
1227:     VecRestoreArray(rr,&r);
1228:     PetscLogFlops(n*m);
1229:   }
1230:   return(0);
1231: }

1235: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1236: {
1237:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1238:   PetscScalar  *v = mat->v;
1239:   PetscReal    sum = 0.0;
1240:   PetscInt     lda=mat->lda,m=A->rmap->n,i,j;

1244:   if (type == NORM_FROBENIUS) {
1245:     if (lda>m) {
1246:       for (j=0; j<A->cmap->n; j++) {
1247:         v = mat->v+j*lda;
1248:         for (i=0; i<m; i++) {
1249: #if defined(PETSC_USE_COMPLEX)
1250:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1251: #else
1252:           sum += (*v)*(*v); v++;
1253: #endif
1254:         }
1255:       }
1256:     } else {
1257:       for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1258: #if defined(PETSC_USE_COMPLEX)
1259:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1260: #else
1261:         sum += (*v)*(*v); v++;
1262: #endif
1263:       }
1264:     }
1265:     *nrm = sqrt(sum);
1266:     PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1267:   } else if (type == NORM_1) {
1268:     *nrm = 0.0;
1269:     for (j=0; j<A->cmap->n; j++) {
1270:       v = mat->v + j*mat->lda;
1271:       sum = 0.0;
1272:       for (i=0; i<A->rmap->n; i++) {
1273:         sum += PetscAbsScalar(*v);  v++;
1274:       }
1275:       if (sum > *nrm) *nrm = sum;
1276:     }
1277:     PetscLogFlops(A->cmap->n*A->rmap->n);
1278:   } else if (type == NORM_INFINITY) {
1279:     *nrm = 0.0;
1280:     for (j=0; j<A->rmap->n; j++) {
1281:       v = mat->v + j;
1282:       sum = 0.0;
1283:       for (i=0; i<A->cmap->n; i++) {
1284:         sum += PetscAbsScalar(*v); v += mat->lda;
1285:       }
1286:       if (sum > *nrm) *nrm = sum;
1287:     }
1288:     PetscLogFlops(A->cmap->n*A->rmap->n);
1289:   } else {
1290:     SETERRQ(PETSC_ERR_SUP,"No two norm");
1291:   }
1292:   return(0);
1293: }

1297: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscTruth flg)
1298: {
1299:   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1301: 
1303:   switch (op) {
1304:   case MAT_ROW_ORIENTED:
1305:     aij->roworiented = flg;
1306:     break;
1307:   case MAT_NEW_NONZERO_LOCATIONS:
1308:   case MAT_NEW_NONZERO_LOCATION_ERR:
1309:   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1310:   case MAT_NEW_DIAGONALS:
1311:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1312:   case MAT_USE_HASH_TABLE:
1313:   case MAT_SYMMETRIC:
1314:   case MAT_STRUCTURALLY_SYMMETRIC:
1315:   case MAT_HERMITIAN:
1316:   case MAT_SYMMETRY_ETERNAL:
1317:   case MAT_IGNORE_LOWER_TRIANGULAR:
1318:     PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1319:     break;
1320:   default:
1321:     SETERRQ1(PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1322:   }
1323:   return(0);
1324: }

1328: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1329: {
1330:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1332:   PetscInt       lda=l->lda,m=A->rmap->n,j;

1335:   if (lda>m) {
1336:     for (j=0; j<A->cmap->n; j++) {
1337:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1338:     }
1339:   } else {
1340:     PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1341:   }
1342:   return(0);
1343: }

1347: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
1348: {
1349:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1350:   PetscInt       n = A->cmap->n,i,j;
1351:   PetscScalar    *slot;

1354:   for (i=0; i<N; i++) {
1355:     slot = l->v + rows[i];
1356:     for (j=0; j<n; j++) { *slot = 0.0; slot += n;}
1357:   }
1358:   if (diag != 0.0) {
1359:     for (i=0; i<N; i++) {
1360:       slot = l->v + (n+1)*rows[i];
1361:       *slot = diag;
1362:     }
1363:   }
1364:   return(0);
1365: }

1369: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1370: {
1371:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

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

1381: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1382: {
1384:   *array = 0; /* user cannot accidently use the array later */
1385:   return(0);
1386: }

1390: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1391: {
1392:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1394:   PetscInt       i,j,nrows,ncols;
1395:   const PetscInt *irow,*icol;
1396:   PetscScalar    *av,*bv,*v = mat->v;
1397:   Mat            newmat;

1400:   ISGetIndices(isrow,&irow);
1401:   ISGetIndices(iscol,&icol);
1402:   ISGetLocalSize(isrow,&nrows);
1403:   ISGetLocalSize(iscol,&ncols);
1404: 
1405:   /* Check submatrixcall */
1406:   if (scall == MAT_REUSE_MATRIX) {
1407:     PetscInt n_cols,n_rows;
1408:     MatGetSize(*B,&n_rows,&n_cols);
1409:     if (n_rows != nrows || n_cols != ncols) {
1410:       /* resize the result result matrix to match number of requested rows/columns */
1411:       MatSetSizes(*B,nrows,ncols,nrows,ncols);
1412:     }
1413:     newmat = *B;
1414:   } else {
1415:     /* Create and fill new matrix */
1416:     MatCreate(((PetscObject)A)->comm,&newmat);
1417:     MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1418:     MatSetType(newmat,((PetscObject)A)->type_name);
1419:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1420:   }

1422:   /* Now extract the data pointers and do the copy,column at a time */
1423:   bv = ((Mat_SeqDense*)newmat->data)->v;
1424: 
1425:   for (i=0; i<ncols; i++) {
1426:     av = v + mat->lda*icol[i];
1427:     for (j=0; j<nrows; j++) {
1428:       *bv++ = av[irow[j]];
1429:     }
1430:   }

1432:   /* Assemble the matrices so that the correct flags are set */
1433:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1434:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1436:   /* Free work space */
1437:   ISRestoreIndices(isrow,&irow);
1438:   ISRestoreIndices(iscol,&icol);
1439:   *B = newmat;
1440:   return(0);
1441: }

1445: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1446: {
1448:   PetscInt       i;

1451:   if (scall == MAT_INITIAL_MATRIX) {
1452:     PetscMalloc((n+1)*sizeof(Mat),B);
1453:   }

1455:   for (i=0; i<n; i++) {
1456:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1457:   }
1458:   return(0);
1459: }

1463: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1464: {
1466:   return(0);
1467: }

1471: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1472: {
1474:   return(0);
1475: }

1479: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1480: {
1481:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1483:   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;

1486:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1487:   if (A->ops->copy != B->ops->copy) {
1488:     MatCopy_Basic(A,B,str);
1489:     return(0);
1490:   }
1491:   if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1492:   if (lda1>m || lda2>m) {
1493:     for (j=0; j<n; j++) {
1494:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1495:     }
1496:   } else {
1497:     PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1498:   }
1499:   return(0);
1500: }

1504: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1505: {

1509:    MatSeqDenseSetPreallocation(A,0);
1510:   return(0);
1511: }

1515: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1516: {
1517:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1519:   /* this will not be called before lda, Mmax,  and Nmax have been set */
1520:   m = PetscMax(m,M);
1521:   n = PetscMax(n,N);
1522:   if (m > a->Mmax) SETERRQ2(PETSC_ERR_SUP,"Cannot yet resize number rows of dense matrix larger then its initial size %d, requested %d",a->lda,(int)m);
1523:   if (n > a->Nmax) SETERRQ2(PETSC_ERR_SUP,"Cannot yet resize number columns of dense matrix larger then its initial size %d, requested %d",a->Nmax,(int)n);
1524:   A->rmap->n = A->rmap->N = m;
1525:   A->cmap->n = A->cmap->N = n;
1526:   if (a->changelda) a->lda = m;
1527:   return(0);
1528: }

1532: static PetscErrorCode MatConjugate_SeqDense(Mat A)
1533: {
1534:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1535:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1536:   PetscScalar    *aa = a->v;

1539:   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1540:   return(0);
1541: }

1545: static PetscErrorCode MatRealPart_SeqDense(Mat A)
1546: {
1547:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1548:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1549:   PetscScalar    *aa = a->v;

1552:   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1553:   return(0);
1554: }

1558: static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1559: {
1560:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1561:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1562:   PetscScalar    *aa = a->v;

1565:   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1566:   return(0);
1567: }

1569: /* ----------------------------------------------------------------*/
1572: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1573: {

1577:   if (scall == MAT_INITIAL_MATRIX){
1578:     MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1579:   }
1580:   MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1581:   return(0);
1582: }

1586: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1587: {
1589:   PetscInt       m=A->rmap->n,n=B->cmap->n;
1590:   Mat            Cmat;

1593:   if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n);
1594:   MatCreate(PETSC_COMM_SELF,&Cmat);
1595:   MatSetSizes(Cmat,m,n,m,n);
1596:   MatSetType(Cmat,MATSEQDENSE);
1597:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1598:   Cmat->assembled = PETSC_TRUE;
1599:   *C = Cmat;
1600:   return(0);
1601: }

1605: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1606: {
1607:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1608:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1609:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1610:   PetscBLASInt   m,n,k;
1611:   PetscScalar    _DOne=1.0,_DZero=0.0;

1614:   m = PetscBLASIntCast(A->rmap->n);
1615:   n = PetscBLASIntCast(B->cmap->n);
1616:   k = PetscBLASIntCast(A->cmap->n);
1617:   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1618:   return(0);
1619: }

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

1628:   if (scall == MAT_INITIAL_MATRIX){
1629:     MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1630:   }
1631:   MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1632:   return(0);
1633: }

1637: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1638: {
1640:   PetscInt       m=A->cmap->n,n=B->cmap->n;
1641:   Mat            Cmat;

1644:   if (A->rmap->n != B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"A->rmap->n %d != B->rmap->n %d\n",A->rmap->n,B->rmap->n);
1645:   MatCreate(PETSC_COMM_SELF,&Cmat);
1646:   MatSetSizes(Cmat,m,n,m,n);
1647:   MatSetType(Cmat,MATSEQDENSE);
1648:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1649:   Cmat->assembled = PETSC_TRUE;
1650:   *C = Cmat;
1651:   return(0);
1652: }

1656: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1657: {
1658:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1659:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1660:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1661:   PetscBLASInt   m,n,k;
1662:   PetscScalar    _DOne=1.0,_DZero=0.0;

1665:   m = PetscBLASIntCast(A->cmap->n);
1666:   n = PetscBLASIntCast(B->cmap->n);
1667:   k = PetscBLASIntCast(A->rmap->n);
1668:   /*
1669:      Note the m and n arguments below are the number rows and columns of A', not A!
1670:   */
1671:   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1672:   return(0);
1673: }

1677: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1678: {
1679:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1681:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1682:   PetscScalar    *x;
1683:   MatScalar      *aa = a->v;

1686:   if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1688:   VecSet(v,0.0);
1689:   VecGetArray(v,&x);
1690:   VecGetLocalSize(v,&p);
1691:   if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1692:   for (i=0; i<m; i++) {
1693:     x[i] = aa[i]; if (idx) idx[i] = 0;
1694:     for (j=1; j<n; j++){
1695:       if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1696:     }
1697:   }
1698:   VecRestoreArray(v,&x);
1699:   return(0);
1700: }

1704: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1705: {
1706:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1708:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1709:   PetscScalar    *x;
1710:   PetscReal      atmp;
1711:   MatScalar      *aa = a->v;

1714:   if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1716:   VecSet(v,0.0);
1717:   VecGetArray(v,&x);
1718:   VecGetLocalSize(v,&p);
1719:   if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1720:   for (i=0; i<m; i++) {
1721:     x[i] = PetscAbsScalar(aa[i]);
1722:     for (j=1; j<n; j++){
1723:       atmp = PetscAbsScalar(aa[i+m*j]);
1724:       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1725:     }
1726:   }
1727:   VecRestoreArray(v,&x);
1728:   return(0);
1729: }

1733: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1734: {
1735:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1737:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1738:   PetscScalar    *x;
1739:   MatScalar      *aa = a->v;

1742:   if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1744:   VecSet(v,0.0);
1745:   VecGetArray(v,&x);
1746:   VecGetLocalSize(v,&p);
1747:   if (p != A->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1748:   for (i=0; i<m; i++) {
1749:     x[i] = aa[i]; if (idx) idx[i] = 0;
1750:     for (j=1; j<n; j++){
1751:       if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1752:     }
1753:   }
1754:   VecRestoreArray(v,&x);
1755:   return(0);
1756: }

1760: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1761: {
1762:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1764:   PetscScalar    *x;

1767:   if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1769:   VecGetArray(v,&x);
1770:   PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1771:   VecRestoreArray(v,&x);
1772:   return(0);
1773: }

1775: /* -------------------------------------------------------------------*/
1776: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1777:        MatGetRow_SeqDense,
1778:        MatRestoreRow_SeqDense,
1779:        MatMult_SeqDense,
1780: /* 4*/ MatMultAdd_SeqDense,
1781:        MatMultTranspose_SeqDense,
1782:        MatMultTransposeAdd_SeqDense,
1783:        0,
1784:        0,
1785:        0,
1786: /*10*/ 0,
1787:        MatLUFactor_SeqDense,
1788:        MatCholeskyFactor_SeqDense,
1789:        MatSOR_SeqDense,
1790:        MatTranspose_SeqDense,
1791: /*15*/ MatGetInfo_SeqDense,
1792:        MatEqual_SeqDense,
1793:        MatGetDiagonal_SeqDense,
1794:        MatDiagonalScale_SeqDense,
1795:        MatNorm_SeqDense,
1796: /*20*/ MatAssemblyBegin_SeqDense,
1797:        MatAssemblyEnd_SeqDense,
1798:        MatSetOption_SeqDense,
1799:        MatZeroEntries_SeqDense,
1800: /*24*/ MatZeroRows_SeqDense,
1801:        0,
1802:        0,
1803:        0,
1804:        0,
1805: /*29*/ MatSetUpPreallocation_SeqDense,
1806:        0,
1807:        0,
1808:        MatGetArray_SeqDense,
1809:        MatRestoreArray_SeqDense,
1810: /*34*/ MatDuplicate_SeqDense,
1811:        0,
1812:        0,
1813:        0,
1814:        0,
1815: /*39*/ MatAXPY_SeqDense,
1816:        MatGetSubMatrices_SeqDense,
1817:        0,
1818:        MatGetValues_SeqDense,
1819:        MatCopy_SeqDense,
1820: /*44*/ MatGetRowMax_SeqDense,
1821:        MatScale_SeqDense,
1822:        0,
1823:        0,
1824:        0,
1825: /*49*/ 0,
1826:        0,
1827:        0,
1828:        0,
1829:        0,
1830: /*54*/ 0,
1831:        0,
1832:        0,
1833:        0,
1834:        0,
1835: /*59*/ 0,
1836:        MatDestroy_SeqDense,
1837:        MatView_SeqDense,
1838:        0,
1839:        0,
1840: /*64*/ 0,
1841:        0,
1842:        0,
1843:        0,
1844:        0,
1845: /*69*/ MatGetRowMaxAbs_SeqDense,
1846:        0,
1847:        0,
1848:        0,
1849:        0,
1850: /*74*/ 0,
1851:        0,
1852:        0,
1853:        0,
1854:        0,
1855: /*79*/ 0,
1856:        0,
1857:        0,
1858:        0,
1859: /*83*/ MatLoad_SeqDense,
1860:        0,
1861:        MatIsHermitian_SeqDense,
1862:        0,
1863:        0,
1864:        0,
1865: /*89*/ MatMatMult_SeqDense_SeqDense,
1866:        MatMatMultSymbolic_SeqDense_SeqDense,
1867:        MatMatMultNumeric_SeqDense_SeqDense,
1868:        0,
1869:        0,
1870: /*94*/ 0,
1871:        MatMatMultTranspose_SeqDense_SeqDense,
1872:        MatMatMultTransposeSymbolic_SeqDense_SeqDense,
1873:        MatMatMultTransposeNumeric_SeqDense_SeqDense,
1874:        0,
1875: /*99*/ 0,
1876:        0,
1877:        0,
1878:        MatConjugate_SeqDense,
1879:        MatSetSizes_SeqDense,
1880: /*104*/0,
1881:        MatRealPart_SeqDense,
1882:        MatImaginaryPart_SeqDense,
1883:        0,
1884:        0,
1885: /*109*/0,
1886:        0,
1887:        MatGetRowMin_SeqDense,
1888:        MatGetColumnVector_SeqDense
1889: };

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

1898:    Collective on MPI_Comm

1900:    Input Parameters:
1901: +  comm - MPI communicator, set to PETSC_COMM_SELF
1902: .  m - number of rows
1903: .  n - number of columns
1904: -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
1905:    to control all matrix memory allocation.

1907:    Output Parameter:
1908: .  A - the matrix

1910:    Notes:
1911:    The data input variable is intended primarily for Fortran programmers
1912:    who wish to allocate their own matrix memory space.  Most users should
1913:    set data=PETSC_NULL.

1915:    Level: intermediate

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

1919: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
1920: @*/
1921: PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
1922: {

1926:   MatCreate(comm,A);
1927:   MatSetSizes(*A,m,n,m,n);
1928:   MatSetType(*A,MATSEQDENSE);
1929:   MatSeqDenseSetPreallocation(*A,data);
1930:   return(0);
1931: }

1935: /*@C
1936:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

1938:    Collective on MPI_Comm

1940:    Input Parameters:
1941: +  A - the matrix
1942: -  data - the array (or PETSC_NULL)

1944:    Notes:
1945:    The data input variable is intended primarily for Fortran programmers
1946:    who wish to allocate their own matrix memory space.  Most users should
1947:    need not call this routine.

1949:    Level: intermediate

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

1953: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues(), MatSeqDenseSetLDA()

1955: @*/
1956: PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
1957: {
1958:   PetscErrorCode ierr,(*f)(Mat,PetscScalar[]);

1961:   PetscObjectQueryFunction((PetscObject)B,"MatSeqDenseSetPreallocation_C",(void (**)(void))&f);
1962:   if (f) {
1963:     (*f)(B,data);
1964:   }
1965:   return(0);
1966: }

1971: PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
1972: {
1973:   Mat_SeqDense   *b;

1977:   B->preallocated = PETSC_TRUE;
1978:   b               = (Mat_SeqDense*)B->data;
1979:   if (b->lda <= 0) b->lda = B->rmap->n;
1980:   if (!data) { /* petsc-allocated storage */
1981:     if (!b->user_alloc) { PetscFree(b->v); }
1982:     PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
1983:     PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
1984:     PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
1985:     b->user_alloc = PETSC_FALSE;
1986:   } else { /* user-allocated storage */
1987:     if (!b->user_alloc) { PetscFree(b->v); }
1988:     b->v          = data;
1989:     b->user_alloc = PETSC_TRUE;
1990:   }
1991:   B->assembled = PETSC_TRUE;
1992:   return(0);
1993: }

1998: /*@C
1999:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

2001:   Input parameter:
2002: + A - the matrix
2003: - lda - the leading dimension

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

2010:   Level: intermediate

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

2014: .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize()

2016: @*/
2017: PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2018: {
2019:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;

2022:   if (lda < B->rmap->n) SETERRQ2(PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n);
2023:   b->lda       = lda;
2024:   b->changelda = PETSC_FALSE;
2025:   b->Mmax      = PetscMax(b->Mmax,lda);
2026:   return(0);
2027: }

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

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

2035:   Level: beginner

2037: .seealso: MatCreateSeqDense()

2039: M*/

2044: PetscErrorCode  MatCreate_SeqDense(Mat B)
2045: {
2046:   Mat_SeqDense   *b;
2048:   PetscMPIInt    size;

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

2054:   PetscLayoutSetBlockSize(B->rmap,1);
2055:   PetscLayoutSetBlockSize(B->cmap,1);
2056:   PetscLayoutSetUp(B->rmap);
2057:   PetscLayoutSetUp(B->cmap);

2059:   PetscNewLog(B,Mat_SeqDense,&b);
2060:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2061:   B->mapping      = 0;
2062:   B->data         = (void*)b;


2065:   b->pivots       = 0;
2066:   b->roworiented  = PETSC_TRUE;
2067:   b->v            = 0;
2068:   b->lda          = B->rmap->n;
2069:   b->changelda    = PETSC_FALSE;
2070:   b->Mmax         = B->rmap->n;
2071:   b->Nmax         = B->cmap->n;


2074:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2075:                                      "MatGetFactor_seqdense_petsc",
2076:                                       MatGetFactor_seqdense_petsc);
2077:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2078:                                     "MatSeqDenseSetPreallocation_SeqDense",
2079:                                      MatSeqDenseSetPreallocation_SeqDense);
2080:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2081:                                      "MatMatMult_SeqAIJ_SeqDense",
2082:                                       MatMatMult_SeqAIJ_SeqDense);
2083:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2084:                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2085:                                       MatMatMultSymbolic_SeqAIJ_SeqDense);
2086:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2087:                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2088:                                       MatMatMultNumeric_SeqAIJ_SeqDense);
2089:   PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2090:   return(0);
2091: }