Actual source code: dense.c

petsc-3.3-p5 2012-12-01
  2: /*
  3:      Defines the basic matrix operations for sequential dense.
  4: */

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

  9: #include <../src/mat/impls/aij/seq/aij.h>
 10: EXTERN_C_BEGIN
 13: PetscErrorCode  MatConvert_SeqDense_SeqAIJ(Mat A, MatType newtype,MatReuse reuse,Mat *newmat)
 14: {
 15:   Mat            B;
 16:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
 18:   PetscInt       i;
 19:   PetscInt       *rows;
 20:   MatScalar      *aa = a->v;

 23:   MatCreate(((PetscObject)A)->comm,&B);
 24:   MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);
 25:   MatSetType(B,MATSEQAIJ);
 26:   MatSeqAIJSetPreallocation(B,A->cmap->n,PETSC_NULL);

 28:   PetscMalloc(A->rmap->n*sizeof(PetscInt),&rows);
 29:   for (i=0; i<A->rmap->n; i++) rows[i] = i;

 31:   for (i=0; i<A->cmap->n; i++) {
 32:     MatSetValues(B,A->rmap->n,rows,1,&i,aa,INSERT_VALUES);
 33:     aa   += a->lda;
 34:   }
 35:   PetscFree(rows);
 36:   MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
 37:   MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
 38: 
 39:   if (reuse == MAT_REUSE_MATRIX) {
 40:     MatHeaderReplace(A,B);
 41:   } else {
 42:     *newmat = B;
 43:   }
 44:   return(0);
 45: }
 46: EXTERN_C_END

 50: PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str)
 51: {
 52:   Mat_SeqDense   *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data;
 53:   PetscScalar    oalpha = alpha;
 54:   PetscInt       j;
 55:   PetscBLASInt   N,m,ldax,lday,one = 1;

 59:   N    = PetscBLASIntCast(X->rmap->n*X->cmap->n);
 60:   m    = PetscBLASIntCast(X->rmap->n);
 61:   ldax = PetscBLASIntCast(x->lda);
 62:   lday = PetscBLASIntCast(y->lda);
 63:   if (ldax>m || lday>m) {
 64:     for (j=0; j<X->cmap->n; j++) {
 65:       BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one);
 66:     }
 67:   } else {
 68:     BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one);
 69:   }
 70:   PetscLogFlops(PetscMax(2*N-1,0));
 71:   return(0);
 72: }

 76: PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info)
 77: {
 78:   PetscInt     N = A->rmap->n*A->cmap->n;

 81:   info->block_size        = 1.0;
 82:   info->nz_allocated      = (double)N;
 83:   info->nz_used           = (double)N;
 84:   info->nz_unneeded       = (double)0;
 85:   info->assemblies        = (double)A->num_ass;
 86:   info->mallocs           = 0;
 87:   info->memory            = ((PetscObject)A)->mem;
 88:   info->fill_ratio_given  = 0;
 89:   info->fill_ratio_needed = 0;
 90:   info->factor_mallocs    = 0;
 91:   return(0);
 92: }

 96: PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha)
 97: {
 98:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
 99:   PetscScalar    oalpha = alpha;
101:   PetscBLASInt   one = 1,j,nz,lda = PetscBLASIntCast(a->lda);

104:   if (lda>A->rmap->n) {
105:     nz = PetscBLASIntCast(A->rmap->n);
106:     for (j=0; j<A->cmap->n; j++) {
107:       BLASscal_(&nz,&oalpha,a->v+j*lda,&one);
108:     }
109:   } else {
110:     nz = PetscBLASIntCast(A->rmap->n*A->cmap->n);
111:     BLASscal_(&nz,&oalpha,a->v,&one);
112:   }
113:   PetscLogFlops(nz);
114:   return(0);
115: }

119: PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscBool  *fl)
120: {
121:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
122:   PetscInt       i,j,m = A->rmap->n,N;
123:   PetscScalar    *v = a->v;

126:   *fl = PETSC_FALSE;
127:   if (A->rmap->n != A->cmap->n) return(0);
128:   N = a->lda;

130:   for (i=0; i<m; i++) {
131:     for (j=i+1; j<m; j++) {
132:       if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) return(0);
133:     }
134:   }
135:   *fl = PETSC_TRUE;
136:   return(0);
137: }
138: 
141: PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues)
142: {
143:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data,*l;
145:   PetscInt       lda = (PetscInt)mat->lda,j,m;

148:   PetscLayoutReference(A->rmap,&newi->rmap);
149:   PetscLayoutReference(A->cmap,&newi->cmap);
150:   MatSeqDenseSetPreallocation(newi,PETSC_NULL);
151:   if (cpvalues == MAT_COPY_VALUES) {
152:     l = (Mat_SeqDense*)newi->data;
153:     if (lda>A->rmap->n) {
154:       m = A->rmap->n;
155:       for (j=0; j<A->cmap->n; j++) {
156:         PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));
157:       }
158:     } else {
159:       PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
160:     }
161:   }
162:   newi->assembled = PETSC_TRUE;
163:   return(0);
164: }

168: PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat)
169: {

173:   MatCreate(((PetscObject)A)->comm,newmat);
174:   MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
175:   MatSetType(*newmat,((PetscObject)A)->type_name);
176:   MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);
177:   return(0);
178: }


181: extern PetscErrorCode MatLUFactor_SeqDense(Mat,IS,IS,const MatFactorInfo*);

185: PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
186: {
187:   MatFactorInfo  info;

191:   MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
192:   MatLUFactor_SeqDense(fact,0,0,&info);
193:   return(0);
194: }

198: PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy)
199: {
200:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
202:   PetscScalar    *x,*y;
203:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
204: 
206:   VecGetArray(xx,&x);
207:   VecGetArray(yy,&y);
208:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
209:   if (A->factortype == MAT_FACTOR_LU) {
210: #if defined(PETSC_MISSING_LAPACK_GETRS) 
211:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
212: #else
213:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
214:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
215: #endif
216:   } else if (A->factortype == MAT_FACTOR_CHOLESKY){
217: #if defined(PETSC_MISSING_LAPACK_POTRS) 
218:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
219: #else
220:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
221:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
222: #endif
223:   }
224:   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");
225:   VecRestoreArray(xx,&x);
226:   VecRestoreArray(yy,&y);
227:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
228:   return(0);
229: }

233: PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X)
234: {
235:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
237:   PetscScalar    *b,*x;
238:   PetscInt       n;
239:   PetscBLASInt   nrhs,info,m=PetscBLASIntCast(A->rmap->n);
240:   PetscBool      flg;

243:   PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
244:   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
245:   PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
246:   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");

248:   MatGetSize(B,PETSC_NULL,&n);
249:   nrhs = PetscBLASIntCast(n);
250:   MatGetArray(B,&b);
251:   MatGetArray(X,&x);

253:   PetscMemcpy(x,b,m*nrhs*sizeof(PetscScalar));

255:   if (A->factortype == MAT_FACTOR_LU) {
256: #if defined(PETSC_MISSING_LAPACK_GETRS)
257:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
258: #else
259:     LAPACKgetrs_("N",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info);
260:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
261: #endif
262:   } else if (A->factortype == MAT_FACTOR_CHOLESKY){
263: #if defined(PETSC_MISSING_LAPACK_POTRS)
264:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
265: #else
266:     LAPACKpotrs_("L",&m,&nrhs,mat->v,&mat->lda,x,&m,&info);
267:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
268: #endif
269:   }
270:   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");

272:   MatRestoreArray(B,&b);
273:   MatRestoreArray(X,&x);
274:   PetscLogFlops(nrhs*(2.0*m*m - m));
275:   return(0);
276: }

280: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
281: {
282:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
284:   PetscScalar    *x,*y;
285:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
286: 
288:   VecGetArray(xx,&x);
289:   VecGetArray(yy,&y);
290:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
291:   /* assume if pivots exist then use LU; else Cholesky */
292:   if (mat->pivots) {
293: #if defined(PETSC_MISSING_LAPACK_GETRS) 
294:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
295: #else
296:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
297:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
298: #endif
299:   } else {
300: #if defined(PETSC_MISSING_LAPACK_POTRS) 
301:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
302: #else
303:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
304:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
305: #endif
306:   }
307:   VecRestoreArray(xx,&x);
308:   VecRestoreArray(yy,&y);
309:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
310:   return(0);
311: }

315: PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
316: {
317:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
319:   PetscScalar    *x,*y,sone = 1.0;
320:   Vec            tmp = 0;
321:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
322: 
324:   VecGetArray(xx,&x);
325:   VecGetArray(yy,&y);
326:   if (!A->rmap->n || !A->cmap->n) return(0);
327:   if (yy == zz) {
328:     VecDuplicate(yy,&tmp);
329:     PetscLogObjectParent(A,tmp);
330:     VecCopy(yy,tmp);
331:   }
332:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
333:   /* assume if pivots exist then use LU; else Cholesky */
334:   if (mat->pivots) {
335: #if defined(PETSC_MISSING_LAPACK_GETRS) 
336:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
337: #else
338:     LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
339:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
340: #endif
341:   } else {
342: #if defined(PETSC_MISSING_LAPACK_POTRS) 
343:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
344: #else
345:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
346:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
347: #endif
348:   }
349:   if (tmp) {
350:     VecAXPY(yy,sone,tmp);
351:     VecDestroy(&tmp);
352:   } else {
353:     VecAXPY(yy,sone,zz);
354:   }
355:   VecRestoreArray(xx,&x);
356:   VecRestoreArray(yy,&y);
357:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
358:   return(0);
359: }

363: PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
364: {
365:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
367:   PetscScalar    *x,*y,sone = 1.0;
368:   Vec            tmp;
369:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
370: 
372:   if (!A->rmap->n || !A->cmap->n) return(0);
373:   VecGetArray(xx,&x);
374:   VecGetArray(yy,&y);
375:   if (yy == zz) {
376:     VecDuplicate(yy,&tmp);
377:     PetscLogObjectParent(A,tmp);
378:     VecCopy(yy,tmp);
379:   }
380:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
381:   /* assume if pivots exist then use LU; else Cholesky */
382:   if (mat->pivots) {
383: #if defined(PETSC_MISSING_LAPACK_GETRS) 
384:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
385: #else
386:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
387:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
388: #endif
389:   } else {
390: #if defined(PETSC_MISSING_LAPACK_POTRS) 
391:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
392: #else
393:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
394:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve");
395: #endif
396:   }
397:   if (tmp) {
398:     VecAXPY(yy,sone,tmp);
399:     VecDestroy(&tmp);
400:   } else {
401:     VecAXPY(yy,sone,zz);
402:   }
403:   VecRestoreArray(xx,&x);
404:   VecRestoreArray(yy,&y);
405:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n);
406:   return(0);
407: }

409: /* ---------------------------------------------------------------*/
410: /* COMMENT: I have chosen to hide row permutation in the pivots,
411:    rather than put it in the Mat->row slot.*/
414: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
415: {
416: #if defined(PETSC_MISSING_LAPACK_GETRF) 
418:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
419: #else
420:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
422:   PetscBLASInt   n,m,info;

425:   n = PetscBLASIntCast(A->cmap->n);
426:   m = PetscBLASIntCast(A->rmap->n);
427:   if (!mat->pivots) {
428:     PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
429:     PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
430:   }
431:   if (!A->rmap->n || !A->cmap->n) return(0);
432:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);
433:   LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
434:   PetscFPTrapPop();

436:   if (info<0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to LU factorization");
437:   if (info>0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
438:   A->ops->solve             = MatSolve_SeqDense;
439:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
440:   A->ops->solveadd          = MatSolveAdd_SeqDense;
441:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
442:   A->factortype             = MAT_FACTOR_LU;

444:   PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);
445: #endif
446:   return(0);
447: }

451: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
452: {
453: #if defined(PETSC_MISSING_LAPACK_POTRF) 
455:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
456: #else
457:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
459:   PetscBLASInt   info,n = PetscBLASIntCast(A->cmap->n);
460: 
462:   PetscFree(mat->pivots);

464:   if (!A->rmap->n || !A->cmap->n) return(0);
465:   LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
466:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
467:   A->ops->solve             = MatSolve_SeqDense;
468:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
469:   A->ops->solveadd          = MatSolveAdd_SeqDense;
470:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
471:   A->factortype             = MAT_FACTOR_CHOLESKY;
472:   PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);
473: #endif
474:   return(0);
475: }


480: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
481: {
483:   MatFactorInfo  info;

486:   info.fill = 1.0;
487:   MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
488:   MatCholeskyFactor_SeqDense(fact,0,&info);
489:   return(0);
490: }

494: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
495: {
497:   fact->assembled                  = PETSC_TRUE;
498:   fact->preallocated               = PETSC_TRUE;
499:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
500:   return(0);
501: }

505: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
506: {
508:   fact->preallocated         = PETSC_TRUE;
509:   fact->assembled            = PETSC_TRUE;
510:   fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
511:   return(0);
512: }

514: EXTERN_C_BEGIN
517: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
518: {

522:   MatCreate(((PetscObject)A)->comm,fact);
523:   MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
524:   MatSetType(*fact,((PetscObject)A)->type_name);
525:   if (ftype == MAT_FACTOR_LU){
526:     (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
527:   } else {
528:     (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
529:   }
530:   (*fact)->factortype = ftype;
531:   return(0);
532: }
533: EXTERN_C_END

535: /* ------------------------------------------------------------------*/
538: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
539: {
540:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
541:   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
543:   PetscInt       m = A->rmap->n,i;
544:   PetscBLASInt   o = 1,bm = PetscBLASIntCast(m);

547:   if (flag & SOR_ZERO_INITIAL_GUESS) {
548:     /* this is a hack fix, should have another version without the second BLASdot */
549:     VecSet(xx,zero);
550:   }
551:   VecGetArray(xx,&x);
552:   VecGetArray(bb,&b);
553:   its  = its*lits;
554:   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
555:   while (its--) {
556:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
557:       for (i=0; i<m; i++) {
558:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
559:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
560:       }
561:     }
562:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
563:       for (i=m-1; i>=0; i--) {
564:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
565:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
566:       }
567:     }
568:   }
569:   VecRestoreArray(bb,&b);
570:   VecRestoreArray(xx,&x);
571:   return(0);
572: }

574: /* -----------------------------------------------------------------*/
577: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
578: {
579:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
580:   PetscScalar    *v = mat->v,*x,*y;
582:   PetscBLASInt   m, n,_One=1;
583:   PetscScalar    _DOne=1.0,_DZero=0.0;

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

600: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
601: {
602:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
603:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
605:   PetscBLASInt   m, n, _One=1;

608:   m = PetscBLASIntCast(A->rmap->n);
609:   n = PetscBLASIntCast(A->cmap->n);
610:   if (!A->rmap->n || !A->cmap->n) return(0);
611:   VecGetArray(xx,&x);
612:   VecGetArray(yy,&y);
613:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One);
614:   VecRestoreArray(xx,&x);
615:   VecRestoreArray(yy,&y);
616:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);
617:   return(0);
618: }

622: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
623: {
624:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
625:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
627:   PetscBLASInt   m, n, _One=1;

630:   m = PetscBLASIntCast(A->rmap->n);
631:   n = PetscBLASIntCast(A->cmap->n);
632:   if (!A->rmap->n || !A->cmap->n) return(0);
633:   if (zz != yy) {VecCopy(zz,yy);}
634:   VecGetArray(xx,&x);
635:   VecGetArray(yy,&y);
636:   BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
637:   VecRestoreArray(xx,&x);
638:   VecRestoreArray(yy,&y);
639:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
640:   return(0);
641: }

645: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
646: {
647:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
648:   PetscScalar    *v = mat->v,*x,*y;
650:   PetscBLASInt   m, n, _One=1;
651:   PetscScalar    _DOne=1.0;

654:   m = PetscBLASIntCast(A->rmap->n);
655:   n = PetscBLASIntCast(A->cmap->n);
656:   if (!A->rmap->n || !A->cmap->n) return(0);
657:   if (zz != yy) {VecCopy(zz,yy);}
658:   VecGetArray(xx,&x);
659:   VecGetArray(yy,&y);
660:   BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One);
661:   VecRestoreArray(xx,&x);
662:   VecRestoreArray(yy,&y);
663:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n);
664:   return(0);
665: }

667: /* -----------------------------------------------------------------*/
670: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
671: {
672:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
673:   PetscScalar    *v;
675:   PetscInt       i;
676: 
678:   *ncols = A->cmap->n;
679:   if (cols) {
680:     PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
681:     for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
682:   }
683:   if (vals) {
684:     PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
685:     v    = mat->v + row;
686:     for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
687:   }
688:   return(0);
689: }

693: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
694: {
697:   if (cols) {PetscFree(*cols);}
698:   if (vals) {PetscFree(*vals); }
699:   return(0);
700: }
701: /* ----------------------------------------------------------------*/
704: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
705: {
706:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
707:   PetscInt     i,j,idx=0;
708: 
711:   if (!mat->roworiented) {
712:     if (addv == INSERT_VALUES) {
713:       for (j=0; j<n; j++) {
714:         if (indexn[j] < 0) {idx += m; continue;}
715: #if defined(PETSC_USE_DEBUG)  
716:         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
717: #endif
718:         for (i=0; i<m; i++) {
719:           if (indexm[i] < 0) {idx++; continue;}
720: #if defined(PETSC_USE_DEBUG)  
721:           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
722: #endif
723:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
724:         }
725:       }
726:     } else {
727:       for (j=0; j<n; j++) {
728:         if (indexn[j] < 0) {idx += m; continue;}
729: #if defined(PETSC_USE_DEBUG)  
730:         if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
731: #endif
732:         for (i=0; i<m; i++) {
733:           if (indexm[i] < 0) {idx++; continue;}
734: #if defined(PETSC_USE_DEBUG)  
735:           if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
736: #endif
737:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
738:         }
739:       }
740:     }
741:   } else {
742:     if (addv == INSERT_VALUES) {
743:       for (i=0; i<m; i++) {
744:         if (indexm[i] < 0) { idx += n; continue;}
745: #if defined(PETSC_USE_DEBUG)  
746:         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
747: #endif
748:         for (j=0; j<n; j++) {
749:           if (indexn[j] < 0) { idx++; continue;}
750: #if defined(PETSC_USE_DEBUG)  
751:           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
752: #endif
753:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
754:         }
755:       }
756:     } else {
757:       for (i=0; i<m; i++) {
758:         if (indexm[i] < 0) { idx += n; continue;}
759: #if defined(PETSC_USE_DEBUG)  
760:         if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1);
761: #endif
762:         for (j=0; j<n; j++) {
763:           if (indexn[j] < 0) { idx++; continue;}
764: #if defined(PETSC_USE_DEBUG)  
765:           if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1);
766: #endif
767:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
768:         }
769:       }
770:     }
771:   }
772:   return(0);
773: }

777: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
778: {
779:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
780:   PetscInt     i,j;

783:   /* row-oriented output */
784:   for (i=0; i<m; i++) {
785:     if (indexm[i] < 0) {v += n;continue;}
786:     if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n);
787:     for (j=0; j<n; j++) {
788:       if (indexn[j] < 0) {v++; continue;}
789:       if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n);
790:       *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
791:     }
792:   }
793:   return(0);
794: }

796: /* -----------------------------------------------------------------*/

800: PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
801: {
802:   Mat_SeqDense   *a;
804:   PetscInt       *scols,i,j,nz,header[4];
805:   int            fd;
806:   PetscMPIInt    size;
807:   PetscInt       *rowlengths = 0,M,N,*cols,grows,gcols;
808:   PetscScalar    *vals,*svals,*v,*w;
809:   MPI_Comm       comm = ((PetscObject)viewer)->comm;

812:   MPI_Comm_size(comm,&size);
813:   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
814:   PetscViewerBinaryGetDescriptor(viewer,&fd);
815:   PetscBinaryRead(fd,header,4,PETSC_INT);
816:   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
817:   M = header[1]; N = header[2]; nz = header[3];

819:   /* set global size if not set already*/
820:   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
821:     MatSetSizes(newmat,M,N,M,N);
822:   } else {
823:     /* if sizes and type are already set, check if the vector global sizes are correct */
824:     MatGetSize(newmat,&grows,&gcols);
825:     if (M != grows ||  N != gcols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,grows,gcols);
826:   }
827:   MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
828: 
829:   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
830:     a    = (Mat_SeqDense*)newmat->data;
831:     v    = a->v;
832:     /* Allocate some temp space to read in the values and then flip them
833:        from row major to column major */
834:     PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
835:     /* read in nonzero values */
836:     PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
837:     /* now flip the values and store them in the matrix*/
838:     for (j=0; j<N; j++) {
839:       for (i=0; i<M; i++) {
840:         *v++ =w[i*N+j];
841:       }
842:     }
843:     PetscFree(w);
844:   } else {
845:     /* read row lengths */
846:     PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
847:     PetscBinaryRead(fd,rowlengths,M,PETSC_INT);

849:     a = (Mat_SeqDense*)newmat->data;
850:     v = a->v;

852:     /* read column indices and nonzeros */
853:     PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
854:     cols = scols;
855:     PetscBinaryRead(fd,cols,nz,PETSC_INT);
856:     PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
857:     vals = svals;
858:     PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);

860:     /* insert into matrix */
861:     for (i=0; i<M; i++) {
862:       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
863:       svals += rowlengths[i]; scols += rowlengths[i];
864:     }
865:     PetscFree(vals);
866:     PetscFree(cols);
867:     PetscFree(rowlengths);
868:   }
869:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
870:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

872:   return(0);
873: }

877: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
878: {
879:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
880:   PetscErrorCode    ierr;
881:   PetscInt          i,j;
882:   const char        *name;
883:   PetscScalar       *v;
884:   PetscViewerFormat format;
885: #if defined(PETSC_USE_COMPLEX)
886:   PetscBool         allreal = PETSC_TRUE;
887: #endif

890:   PetscViewerGetFormat(viewer,&format);
891:   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
892:     return(0);  /* do nothing for now */
893:   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
894:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
895:     PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
896:     for (i=0; i<A->rmap->n; i++) {
897:       v = a->v + i;
898:       PetscViewerASCIIPrintf(viewer,"row %D:",i);
899:       for (j=0; j<A->cmap->n; j++) {
900: #if defined(PETSC_USE_COMPLEX)
901:         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
902:           PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
903:         } else if (PetscRealPart(*v)) {
904:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
905:         }
906: #else
907:         if (*v) {
908:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
909:         }
910: #endif
911:         v += a->lda;
912:       }
913:       PetscViewerASCIIPrintf(viewer,"\n");
914:     }
915:     PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
916:   } else {
917:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
918: #if defined(PETSC_USE_COMPLEX)
919:     /* determine if matrix has all real values */
920:     v = a->v;
921:     for (i=0; i<A->rmap->n*A->cmap->n; i++) {
922:         if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
923:     }
924: #endif
925:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
926:       PetscObjectGetName((PetscObject)A,&name);
927:       PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
928:       PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
929:       PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
930:     } else {
931:       PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
932:     }

934:     for (i=0; i<A->rmap->n; i++) {
935:       v = a->v + i;
936:       for (j=0; j<A->cmap->n; j++) {
937: #if defined(PETSC_USE_COMPLEX)
938:         if (allreal) {
939:           PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)PetscRealPart(*v));
940:         } else {
941:           PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei ",(double)PetscRealPart(*v),(double)PetscImaginaryPart(*v));
942:         }
943: #else
944:         PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)*v);
945: #endif
946:         v += a->lda;
947:       }
948:       PetscViewerASCIIPrintf(viewer,"\n");
949:     }
950:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
951:       PetscViewerASCIIPrintf(viewer,"];\n");
952:     }
953:     PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
954:   }
955:   PetscViewerFlush(viewer);
956:   return(0);
957: }

961: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
962: {
963:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
964:   PetscErrorCode    ierr;
965:   int               fd;
966:   PetscInt          ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
967:   PetscScalar       *v,*anonz,*vals;
968:   PetscViewerFormat format;
969: 
971:   PetscViewerBinaryGetDescriptor(viewer,&fd);

973:   PetscViewerGetFormat(viewer,&format);
974:   if (format == PETSC_VIEWER_NATIVE) {
975:     /* store the matrix as a dense matrix */
976:     PetscMalloc(4*sizeof(PetscInt),&col_lens);
977:     col_lens[0] = MAT_FILE_CLASSID;
978:     col_lens[1] = m;
979:     col_lens[2] = n;
980:     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
981:     PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
982:     PetscFree(col_lens);

984:     /* write out matrix, by rows */
985:     PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
986:     v    = a->v;
987:     for (j=0; j<n; j++) {
988:       for (i=0; i<m; i++) {
989:         vals[j + i*n] = *v++;
990:       }
991:     }
992:     PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
993:     PetscFree(vals);
994:   } else {
995:     PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
996:     col_lens[0] = MAT_FILE_CLASSID;
997:     col_lens[1] = m;
998:     col_lens[2] = n;
999:     col_lens[3] = nz;

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

1005:     /* Possibly should write in smaller increments, not whole matrix at once? */
1006:     /* store column indices (zero start index) */
1007:     ict = 0;
1008:     for (i=0; i<m; i++) {
1009:       for (j=0; j<n; j++) col_lens[ict++] = j;
1010:     }
1011:     PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
1012:     PetscFree(col_lens);

1014:     /* store nonzero values */
1015:     PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
1016:     ict  = 0;
1017:     for (i=0; i<m; i++) {
1018:       v = a->v + i;
1019:       for (j=0; j<n; j++) {
1020:         anonz[ict++] = *v; v += a->lda;
1021:       }
1022:     }
1023:     PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
1024:     PetscFree(anonz);
1025:   }
1026:   return(0);
1027: }

1031: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1032: {
1033:   Mat               A = (Mat) Aa;
1034:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
1035:   PetscErrorCode    ierr;
1036:   PetscInt          m = A->rmap->n,n = A->cmap->n,color,i,j;
1037:   PetscScalar       *v = a->v;
1038:   PetscViewer       viewer;
1039:   PetscDraw         popup;
1040:   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1041:   PetscViewerFormat format;


1045:   PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
1046:   PetscViewerGetFormat(viewer,&format);
1047:   PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);

1049:   /* Loop over matrix elements drawing boxes */
1050:   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1051:     /* Blue for negative and Red for positive */
1052:     color = PETSC_DRAW_BLUE;
1053:     for(j = 0; j < n; j++) {
1054:       x_l = j;
1055:       x_r = x_l + 1.0;
1056:       for(i = 0; i < m; i++) {
1057:         y_l = m - i - 1.0;
1058:         y_r = y_l + 1.0;
1059: #if defined(PETSC_USE_COMPLEX)
1060:         if (PetscRealPart(v[j*m+i]) >  0.) {
1061:           color = PETSC_DRAW_RED;
1062:         } else if (PetscRealPart(v[j*m+i]) <  0.) {
1063:           color = PETSC_DRAW_BLUE;
1064:         } else {
1065:           continue;
1066:         }
1067: #else
1068:         if (v[j*m+i] >  0.) {
1069:           color = PETSC_DRAW_RED;
1070:         } else if (v[j*m+i] <  0.) {
1071:           color = PETSC_DRAW_BLUE;
1072:         } else {
1073:           continue;
1074:         }
1075: #endif
1076:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1077:       }
1078:     }
1079:   } else {
1080:     /* use contour shading to indicate magnitude of values */
1081:     /* first determine max of all nonzero values */
1082:     for(i = 0; i < m*n; i++) {
1083:       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1084:     }
1085:     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1086:     PetscDrawGetPopup(draw,&popup);
1087:     if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1088:     for(j = 0; j < n; j++) {
1089:       x_l = j;
1090:       x_r = x_l + 1.0;
1091:       for(i = 0; i < m; i++) {
1092:         y_l   = m - i - 1.0;
1093:         y_r   = y_l + 1.0;
1094:         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1095:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1096:       }
1097:     }
1098:   }
1099:   return(0);
1100: }

1104: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1105: {
1106:   PetscDraw      draw;
1107:   PetscBool      isnull;
1108:   PetscReal      xr,yr,xl,yl,h,w;

1112:   PetscViewerDrawGetDraw(viewer,0,&draw);
1113:   PetscDrawIsNull(draw,&isnull);
1114:   if (isnull) return(0);

1116:   PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1117:   xr  = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1118:   xr += w;    yr += h;  xl = -w;     yl = -h;
1119:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1120:   PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1121:   PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1122:   return(0);
1123: }

1127: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1128: {
1130:   PetscBool      iascii,isbinary,isdraw;

1133:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
1134:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
1135:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);

1137:   if (iascii) {
1138:     MatView_SeqDense_ASCII(A,viewer);
1139:   } else if (isbinary) {
1140:     MatView_SeqDense_Binary(A,viewer);
1141:   } else if (isdraw) {
1142:     MatView_SeqDense_Draw(A,viewer);
1143:   } else {
1144:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1145:   }
1146:   return(0);
1147: }

1151: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1152: {
1153:   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;

1157: #if defined(PETSC_USE_LOG)
1158:   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1159: #endif
1160:   PetscFree(l->pivots);
1161:   if (!l->user_alloc) {PetscFree(l->v);}
1162:   PetscFree(mat->data);

1164:   PetscObjectChangeTypeName((PetscObject)mat,0);
1165:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1166:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1167:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1168:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1169:   return(0);
1170: }

1174: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1175: {
1176:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1178:   PetscInt       k,j,m,n,M;
1179:   PetscScalar    *v,tmp;

1182:   v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1183:   if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1184:     if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1185:     else {
1186:       for (j=0; j<m; j++) {
1187:         for (k=0; k<j; k++) {
1188:           tmp = v[j + k*M];
1189:           v[j + k*M] = v[k + j*M];
1190:           v[k + j*M] = tmp;
1191:         }
1192:       }
1193:     }
1194:   } else { /* out-of-place transpose */
1195:     Mat          tmat;
1196:     Mat_SeqDense *tmatd;
1197:     PetscScalar  *v2;

1199:     if (reuse == MAT_INITIAL_MATRIX) {
1200:       MatCreate(((PetscObject)A)->comm,&tmat);
1201:       MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1202:       MatSetType(tmat,((PetscObject)A)->type_name);
1203:       MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1204:     } else {
1205:       tmat = *matout;
1206:     }
1207:     tmatd = (Mat_SeqDense*)tmat->data;
1208:     v = mat->v; v2 = tmatd->v;
1209:     for (j=0; j<n; j++) {
1210:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1211:     }
1212:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1213:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1214:     *matout = tmat;
1215:   }
1216:   return(0);
1217: }

1221: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool  *flg)
1222: {
1223:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1224:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1225:   PetscInt     i,j;
1226:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1229:   if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1230:   if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1231:   for (i=0; i<A1->rmap->n; i++) {
1232:     v1 = mat1->v+i; v2 = mat2->v+i;
1233:     for (j=0; j<A1->cmap->n; j++) {
1234:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1235:       v1 += mat1->lda; v2 += mat2->lda;
1236:     }
1237:   }
1238:   *flg = PETSC_TRUE;
1239:   return(0);
1240: }

1244: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1245: {
1246:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1248:   PetscInt       i,n,len;
1249:   PetscScalar    *x,zero = 0.0;

1252:   VecSet(v,zero);
1253:   VecGetSize(v,&n);
1254:   VecGetArray(v,&x);
1255:   len = PetscMin(A->rmap->n,A->cmap->n);
1256:   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1257:   for (i=0; i<len; i++) {
1258:     x[i] = mat->v[i*mat->lda + i];
1259:   }
1260:   VecRestoreArray(v,&x);
1261:   return(0);
1262: }

1266: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1267: {
1268:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1269:   PetscScalar    *l,*r,x,*v;
1271:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n;

1274:   if (ll) {
1275:     VecGetSize(ll,&m);
1276:     VecGetArray(ll,&l);
1277:     if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1278:     for (i=0; i<m; i++) {
1279:       x = l[i];
1280:       v = mat->v + i;
1281:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1282:     }
1283:     VecRestoreArray(ll,&l);
1284:     PetscLogFlops(n*m);
1285:   }
1286:   if (rr) {
1287:     VecGetSize(rr,&n);
1288:     VecGetArray(rr,&r);
1289:     if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1290:     for (i=0; i<n; i++) {
1291:       x = r[i];
1292:       v = mat->v + i*m;
1293:       for (j=0; j<m; j++) { (*v++) *= x;}
1294:     }
1295:     VecRestoreArray(rr,&r);
1296:     PetscLogFlops(n*m);
1297:   }
1298:   return(0);
1299: }

1303: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1304: {
1305:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1306:   PetscScalar  *v = mat->v;
1307:   PetscReal    sum = 0.0;
1308:   PetscInt     lda=mat->lda,m=A->rmap->n,i,j;

1312:   if (type == NORM_FROBENIUS) {
1313:     if (lda>m) {
1314:       for (j=0; j<A->cmap->n; j++) {
1315:         v = mat->v+j*lda;
1316:         for (i=0; i<m; i++) {
1317: #if defined(PETSC_USE_COMPLEX)
1318:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1319: #else
1320:           sum += (*v)*(*v); v++;
1321: #endif
1322:         }
1323:       }
1324:     } else {
1325:       for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1326: #if defined(PETSC_USE_COMPLEX)
1327:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1328: #else
1329:         sum += (*v)*(*v); v++;
1330: #endif
1331:       }
1332:     }
1333:     *nrm = PetscSqrtReal(sum);
1334:     PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1335:   } else if (type == NORM_1) {
1336:     *nrm = 0.0;
1337:     for (j=0; j<A->cmap->n; j++) {
1338:       v = mat->v + j*mat->lda;
1339:       sum = 0.0;
1340:       for (i=0; i<A->rmap->n; i++) {
1341:         sum += PetscAbsScalar(*v);  v++;
1342:       }
1343:       if (sum > *nrm) *nrm = sum;
1344:     }
1345:     PetscLogFlops(A->cmap->n*A->rmap->n);
1346:   } else if (type == NORM_INFINITY) {
1347:     *nrm = 0.0;
1348:     for (j=0; j<A->rmap->n; j++) {
1349:       v = mat->v + j;
1350:       sum = 0.0;
1351:       for (i=0; i<A->cmap->n; i++) {
1352:         sum += PetscAbsScalar(*v); v += mat->lda;
1353:       }
1354:       if (sum > *nrm) *nrm = sum;
1355:     }
1356:     PetscLogFlops(A->cmap->n*A->rmap->n);
1357:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1358:   return(0);
1359: }

1363: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool  flg)
1364: {
1365:   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1367: 
1369:   switch (op) {
1370:   case MAT_ROW_ORIENTED:
1371:     aij->roworiented = flg;
1372:     break;
1373:   case MAT_NEW_NONZERO_LOCATIONS:
1374:   case MAT_NEW_NONZERO_LOCATION_ERR:
1375:   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1376:   case MAT_NEW_DIAGONALS:
1377:   case MAT_KEEP_NONZERO_PATTERN:
1378:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1379:   case MAT_USE_HASH_TABLE:
1380:   case MAT_SYMMETRIC:
1381:   case MAT_STRUCTURALLY_SYMMETRIC:
1382:   case MAT_HERMITIAN:
1383:   case MAT_SYMMETRY_ETERNAL:
1384:   case MAT_IGNORE_LOWER_TRIANGULAR:
1385:     PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1386:     break;
1387:   default:
1388:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1389:   }
1390:   return(0);
1391: }

1395: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1396: {
1397:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1399:   PetscInt       lda=l->lda,m=A->rmap->n,j;

1402:   if (lda>m) {
1403:     for (j=0; j<A->cmap->n; j++) {
1404:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1405:     }
1406:   } else {
1407:     PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1408:   }
1409:   return(0);
1410: }

1414: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1415: {
1416:   PetscErrorCode    ierr;
1417:   Mat_SeqDense      *l = (Mat_SeqDense*)A->data;
1418:   PetscInt          m = l->lda, n = A->cmap->n, i,j;
1419:   PetscScalar       *slot,*bb;
1420:   const PetscScalar *xx;

1423: #if defined(PETSC_USE_DEBUG)  
1424:   for (i=0; i<N; i++) {
1425:     if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1426:     if (rows[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested to be zeroed greater than or equal number of rows %D",rows[i],A->rmap->n);
1427:   }
1428: #endif

1430:   /* fix right hand side if needed */
1431:   if (x && b) {
1432:     VecGetArrayRead(x,&xx);
1433:     VecGetArray(b,&bb);
1434:     for (i=0; i<N; i++) {
1435:       bb[rows[i]] = diag*xx[rows[i]];
1436:     }
1437:     VecRestoreArrayRead(x,&xx);
1438:     VecRestoreArray(b,&bb);
1439:   }

1441:   for (i=0; i<N; i++) {
1442:     slot = l->v + rows[i];
1443:     for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1444:   }
1445:   if (diag != 0.0) {
1446:     if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1447:     for (i=0; i<N; i++) {
1448:       slot = l->v + (m+1)*rows[i];
1449:       *slot = diag;
1450:     }
1451:   }
1452:   return(0);
1453: }

1457: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1458: {
1459:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

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

1469: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1470: {
1472:   *array = 0; /* user cannot accidently use the array later */
1473:   return(0);
1474: }

1478: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1479: {
1480:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1482:   PetscInt       i,j,nrows,ncols;
1483:   const PetscInt *irow,*icol;
1484:   PetscScalar    *av,*bv,*v = mat->v;
1485:   Mat            newmat;

1488:   ISGetIndices(isrow,&irow);
1489:   ISGetIndices(iscol,&icol);
1490:   ISGetLocalSize(isrow,&nrows);
1491:   ISGetLocalSize(iscol,&ncols);
1492: 
1493:   /* Check submatrixcall */
1494:   if (scall == MAT_REUSE_MATRIX) {
1495:     PetscInt n_cols,n_rows;
1496:     MatGetSize(*B,&n_rows,&n_cols);
1497:     if (n_rows != nrows || n_cols != ncols) {
1498:       /* resize the result matrix to match number of requested rows/columns */
1499:       MatSetSizes(*B,nrows,ncols,nrows,ncols);
1500:     }
1501:     newmat = *B;
1502:   } else {
1503:     /* Create and fill new matrix */
1504:     MatCreate(((PetscObject)A)->comm,&newmat);
1505:     MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1506:     MatSetType(newmat,((PetscObject)A)->type_name);
1507:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1508:   }

1510:   /* Now extract the data pointers and do the copy,column at a time */
1511:   bv = ((Mat_SeqDense*)newmat->data)->v;
1512: 
1513:   for (i=0; i<ncols; i++) {
1514:     av = v + mat->lda*icol[i];
1515:     for (j=0; j<nrows; j++) {
1516:       *bv++ = av[irow[j]];
1517:     }
1518:   }

1520:   /* Assemble the matrices so that the correct flags are set */
1521:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1522:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1524:   /* Free work space */
1525:   ISRestoreIndices(isrow,&irow);
1526:   ISRestoreIndices(iscol,&icol);
1527:   *B = newmat;
1528:   return(0);
1529: }

1533: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1534: {
1536:   PetscInt       i;

1539:   if (scall == MAT_INITIAL_MATRIX) {
1540:     PetscMalloc((n+1)*sizeof(Mat),B);
1541:   }

1543:   for (i=0; i<n; i++) {
1544:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1545:   }
1546:   return(0);
1547: }

1551: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1552: {
1554:   return(0);
1555: }

1559: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1560: {
1562:   return(0);
1563: }

1567: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1568: {
1569:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1571:   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;

1574:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1575:   if (A->ops->copy != B->ops->copy) {
1576:     MatCopy_Basic(A,B,str);
1577:     return(0);
1578:   }
1579:   if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1580:   if (lda1>m || lda2>m) {
1581:     for (j=0; j<n; j++) {
1582:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1583:     }
1584:   } else {
1585:     PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1586:   }
1587:   return(0);
1588: }

1592: PetscErrorCode MatSetUp_SeqDense(Mat A)
1593: {

1597:    MatSeqDenseSetPreallocation(A,0);
1598:   return(0);
1599: }

1603: static PetscErrorCode MatConjugate_SeqDense(Mat A)
1604: {
1605:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1606:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1607:   PetscScalar    *aa = a->v;

1610:   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1611:   return(0);
1612: }

1616: static PetscErrorCode MatRealPart_SeqDense(Mat A)
1617: {
1618:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1619:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1620:   PetscScalar    *aa = a->v;

1623:   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1624:   return(0);
1625: }

1629: static PetscErrorCode MatImaginaryPart_SeqDense(Mat A)
1630: {
1631:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1632:   PetscInt       i,nz = A->rmap->n*A->cmap->n;
1633:   PetscScalar    *aa = a->v;

1636:   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1637:   return(0);
1638: }

1640: /* ----------------------------------------------------------------*/
1643: PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1644: {

1648:   if (scall == MAT_INITIAL_MATRIX){
1649:     MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1650:   }
1651:   MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1652:   return(0);
1653: }

1657: PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1658: {
1660:   PetscInt       m=A->rmap->n,n=B->cmap->n;
1661:   Mat            Cmat;

1664:   if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n);
1665:   MatCreate(PETSC_COMM_SELF,&Cmat);
1666:   MatSetSizes(Cmat,m,n,m,n);
1667:   MatSetType(Cmat,MATSEQDENSE);
1668:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1669:   Cmat->assembled    = PETSC_TRUE;
1670:   Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense;
1671:   *C = Cmat;
1672:   return(0);
1673: }

1677: PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1678: {
1679:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1680:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1681:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1682:   PetscBLASInt   m,n,k;
1683:   PetscScalar    _DOne=1.0,_DZero=0.0;

1686:   m = PetscBLASIntCast(A->rmap->n);
1687:   n = PetscBLASIntCast(B->cmap->n);
1688:   k = PetscBLASIntCast(A->cmap->n);
1689:   BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1690:   return(0);
1691: }

1695: PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
1696: {

1700:   if (scall == MAT_INITIAL_MATRIX){
1701:     MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1702:   }
1703:   MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1704:   return(0);
1705: }

1709: PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1710: {
1712:   PetscInt       m=A->cmap->n,n=B->cmap->n;
1713:   Mat            Cmat;

1716:   if (A->rmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->rmap->n %d != B->rmap->n %d\n",A->rmap->n,B->rmap->n);
1717:   MatCreate(PETSC_COMM_SELF,&Cmat);
1718:   MatSetSizes(Cmat,m,n,m,n);
1719:   MatSetType(Cmat,MATSEQDENSE);
1720:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1721:   Cmat->assembled = PETSC_TRUE;
1722:   *C = Cmat;
1723:   return(0);
1724: }

1728: PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1729: {
1730:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1731:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1732:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1733:   PetscBLASInt   m,n,k;
1734:   PetscScalar    _DOne=1.0,_DZero=0.0;

1737:   m = PetscBLASIntCast(A->cmap->n);
1738:   n = PetscBLASIntCast(B->cmap->n);
1739:   k = PetscBLASIntCast(A->rmap->n);
1740:   /*
1741:      Note the m and n arguments below are the number rows and columns of A', not A!
1742:   */
1743:   BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda);
1744:   return(0);
1745: }

1749: PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[])
1750: {
1751:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1753:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1754:   PetscScalar    *x;
1755:   MatScalar      *aa = a->v;

1758:   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1760:   VecSet(v,0.0);
1761:   VecGetArray(v,&x);
1762:   VecGetLocalSize(v,&p);
1763:   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1764:   for (i=0; i<m; i++) {
1765:     x[i] = aa[i]; if (idx) idx[i] = 0;
1766:     for (j=1; j<n; j++){
1767:       if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1768:     }
1769:   }
1770:   VecRestoreArray(v,&x);
1771:   return(0);
1772: }

1776: PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[])
1777: {
1778:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1780:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1781:   PetscScalar    *x;
1782:   PetscReal      atmp;
1783:   MatScalar      *aa = a->v;

1786:   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1788:   VecSet(v,0.0);
1789:   VecGetArray(v,&x);
1790:   VecGetLocalSize(v,&p);
1791:   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1792:   for (i=0; i<m; i++) {
1793:     x[i] = PetscAbsScalar(aa[i]);
1794:     for (j=1; j<n; j++){
1795:       atmp = PetscAbsScalar(aa[i+m*j]);
1796:       if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;}
1797:     }
1798:   }
1799:   VecRestoreArray(v,&x);
1800:   return(0);
1801: }

1805: PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[])
1806: {
1807:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1809:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n,p;
1810:   PetscScalar    *x;
1811:   MatScalar      *aa = a->v;

1814:   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1816:   VecSet(v,0.0);
1817:   VecGetArray(v,&x);
1818:   VecGetLocalSize(v,&p);
1819:   if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector");
1820:   for (i=0; i<m; i++) {
1821:     x[i] = aa[i]; if (idx) idx[i] = 0;
1822:     for (j=1; j<n; j++){
1823:       if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;}
1824:     }
1825:   }
1826:   VecRestoreArray(v,&x);
1827:   return(0);
1828: }

1832: PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col)
1833: {
1834:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1836:   PetscScalar    *x;

1839:   if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");

1841:   VecGetArray(v,&x);
1842:   PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1843:   VecRestoreArray(v,&x);
1844:   return(0);
1845: }


1850: PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1851: {
1853:   PetscInt       i,j,m,n;
1854:   PetscScalar    *a;

1857:   MatGetSize(A,&m,&n);
1858:   PetscMemzero(norms,n*sizeof(PetscReal));
1859:   MatGetArray(A,&a);
1860:   if (type == NORM_2) {
1861:     for (i=0; i<n; i++ ){
1862:       for (j=0; j<m; j++) {
1863:         norms[i] += PetscAbsScalar(a[j]*a[j]);
1864:       }
1865:       a += m;
1866:     }
1867:   } else if (type == NORM_1) {
1868:     for (i=0; i<n; i++ ){
1869:       for (j=0; j<m; j++) {
1870:         norms[i] += PetscAbsScalar(a[j]);
1871:       }
1872:       a += m;
1873:     }
1874:   } else if (type == NORM_INFINITY) {
1875:     for (i=0; i<n; i++ ){
1876:       for (j=0; j<m; j++) {
1877:         norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]);
1878:       }
1879:       a += m;
1880:     }
1881:   } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType");
1882:   if (type == NORM_2) {
1883:     for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]);
1884:   }
1885:   return(0);
1886: }

1888: /* -------------------------------------------------------------------*/
1889: static struct _MatOps MatOps_Values = {MatSetValues_SeqDense,
1890:        MatGetRow_SeqDense,
1891:        MatRestoreRow_SeqDense,
1892:        MatMult_SeqDense,
1893: /* 4*/ MatMultAdd_SeqDense,
1894:        MatMultTranspose_SeqDense,
1895:        MatMultTransposeAdd_SeqDense,
1896:        0,
1897:        0,
1898:        0,
1899: /*10*/ 0,
1900:        MatLUFactor_SeqDense,
1901:        MatCholeskyFactor_SeqDense,
1902:        MatSOR_SeqDense,
1903:        MatTranspose_SeqDense,
1904: /*15*/ MatGetInfo_SeqDense,
1905:        MatEqual_SeqDense,
1906:        MatGetDiagonal_SeqDense,
1907:        MatDiagonalScale_SeqDense,
1908:        MatNorm_SeqDense,
1909: /*20*/ MatAssemblyBegin_SeqDense,
1910:        MatAssemblyEnd_SeqDense,
1911:        MatSetOption_SeqDense,
1912:        MatZeroEntries_SeqDense,
1913: /*24*/ MatZeroRows_SeqDense,
1914:        0,
1915:        0,
1916:        0,
1917:        0,
1918: /*29*/ MatSetUp_SeqDense,
1919:        0,
1920:        0,
1921:        MatGetArray_SeqDense,
1922:        MatRestoreArray_SeqDense,
1923: /*34*/ MatDuplicate_SeqDense,
1924:        0,
1925:        0,
1926:        0,
1927:        0,
1928: /*39*/ MatAXPY_SeqDense,
1929:        MatGetSubMatrices_SeqDense,
1930:        0,
1931:        MatGetValues_SeqDense,
1932:        MatCopy_SeqDense,
1933: /*44*/ MatGetRowMax_SeqDense,
1934:        MatScale_SeqDense,
1935:        0,
1936:        0,
1937:        0,
1938: /*49*/ 0,
1939:        0,
1940:        0,
1941:        0,
1942:        0,
1943: /*54*/ 0,
1944:        0,
1945:        0,
1946:        0,
1947:        0,
1948: /*59*/ 0,
1949:        MatDestroy_SeqDense,
1950:        MatView_SeqDense,
1951:        0,
1952:        0,
1953: /*64*/ 0,
1954:        0,
1955:        0,
1956:        0,
1957:        0,
1958: /*69*/ MatGetRowMaxAbs_SeqDense,
1959:        0,
1960:        0,
1961:        0,
1962:        0,
1963: /*74*/ 0,
1964:        0,
1965:        0,
1966:        0,
1967:        0,
1968: /*79*/ 0,
1969:        0,
1970:        0,
1971:        0,
1972: /*83*/ MatLoad_SeqDense,
1973:        0,
1974:        MatIsHermitian_SeqDense,
1975:        0,
1976:        0,
1977:        0,
1978: /*89*/ MatMatMult_SeqDense_SeqDense,
1979:        MatMatMultSymbolic_SeqDense_SeqDense,
1980:        MatMatMultNumeric_SeqDense_SeqDense,
1981:        0,
1982:        0,
1983: /*94*/ 0,
1984:        0,
1985:        0,
1986:        0,
1987:        0,
1988: /*99*/ 0,
1989:        0,
1990:        0,
1991:        MatConjugate_SeqDense,
1992:        0,
1993: /*104*/0,
1994:        MatRealPart_SeqDense,
1995:        MatImaginaryPart_SeqDense,
1996:        0,
1997:        0,
1998: /*109*/MatMatSolve_SeqDense,
1999:        0,
2000:        MatGetRowMin_SeqDense,
2001:        MatGetColumnVector_SeqDense,
2002:        0,
2003: /*114*/0,
2004:        0,
2005:        0,
2006:        0,
2007:        0,
2008: /*119*/0,
2009:        0,
2010:        0,
2011:        0,
2012:        0,
2013: /*124*/0,
2014:        MatGetColumnNorms_SeqDense,
2015:        0,
2016:        0,
2017:        0,
2018: /*129*/0,
2019:        MatTransposeMatMult_SeqDense_SeqDense,
2020:        MatTransposeMatMultSymbolic_SeqDense_SeqDense,
2021:        MatTransposeMatMultNumeric_SeqDense_SeqDense,
2022: };

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

2031:    Collective on MPI_Comm

2033:    Input Parameters:
2034: +  comm - MPI communicator, set to PETSC_COMM_SELF
2035: .  m - number of rows
2036: .  n - number of columns
2037: -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
2038:    to control all matrix memory allocation.

2040:    Output Parameter:
2041: .  A - the matrix

2043:    Notes:
2044:    The data input variable is intended primarily for Fortran programmers
2045:    who wish to allocate their own matrix memory space.  Most users should
2046:    set data=PETSC_NULL.

2048:    Level: intermediate

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

2052: .seealso: MatCreate(), MatCreateDense(), MatSetValues()
2053: @*/
2054: PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2055: {

2059:   MatCreate(comm,A);
2060:   MatSetSizes(*A,m,n,m,n);
2061:   MatSetType(*A,MATSEQDENSE);
2062:   MatSeqDenseSetPreallocation(*A,data);
2063:   return(0);
2064: }

2068: /*@C
2069:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

2071:    Collective on MPI_Comm

2073:    Input Parameters:
2074: +  A - the matrix
2075: -  data - the array (or PETSC_NULL)

2077:    Notes:
2078:    The data input variable is intended primarily for Fortran programmers
2079:    who wish to allocate their own matrix memory space.  Most users should
2080:    need not call this routine.

2082:    Level: intermediate

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

2086: .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA()

2088: @*/
2089: PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2090: {

2094:   PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));
2095:   return(0);
2096: }

2098: EXTERN_C_BEGIN
2101: PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2102: {
2103:   Mat_SeqDense   *b;

2107:   B->preallocated = PETSC_TRUE;

2109:   PetscLayoutSetUp(B->rmap);
2110:   PetscLayoutSetUp(B->cmap);

2112:   b       = (Mat_SeqDense*)B->data;
2113:   b->Mmax = B->rmap->n;
2114:   b->Nmax = B->cmap->n;
2115:   if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;

2117:   if (!data) { /* petsc-allocated storage */
2118:     if (!b->user_alloc) { PetscFree(b->v); }
2119:     PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
2120:     PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
2121:     PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
2122:     b->user_alloc = PETSC_FALSE;
2123:   } else { /* user-allocated storage */
2124:     if (!b->user_alloc) { PetscFree(b->v); }
2125:     b->v          = data;
2126:     b->user_alloc = PETSC_TRUE;
2127:   }
2128:   B->assembled = PETSC_TRUE;
2129:   return(0);
2130: }
2131: EXTERN_C_END

2135: /*@C
2136:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

2138:   Input parameter:
2139: + A - the matrix
2140: - lda - the leading dimension

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

2147:   Level: intermediate

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

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

2153: @*/
2154: PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2155: {
2156:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;

2159:   if (lda < B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n);
2160:   b->lda       = lda;
2161:   b->changelda = PETSC_FALSE;
2162:   b->Mmax      = PetscMax(b->Mmax,lda);
2163:   return(0);
2164: }

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

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

2172:   Level: beginner

2174: .seealso: MatCreateSeqDense()

2176: M*/

2178: EXTERN_C_BEGIN
2181: PetscErrorCode  MatCreate_SeqDense(Mat B)
2182: {
2183:   Mat_SeqDense   *b;
2185:   PetscMPIInt    size;

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

2191:   PetscNewLog(B,Mat_SeqDense,&b);
2192:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2193:   B->data         = (void*)b;

2195:   b->pivots       = 0;
2196:   b->roworiented  = PETSC_TRUE;
2197:   b->v            = 0;
2198:   b->changelda    = PETSC_FALSE;


2201:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);
2202:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2203:                                      "MatGetFactor_seqdense_petsc",
2204:                                       MatGetFactor_seqdense_petsc);
2205:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2206:                                     "MatSeqDenseSetPreallocation_SeqDense",
2207:                                      MatSeqDenseSetPreallocation_SeqDense);

2209:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2210:                                      "MatMatMult_SeqAIJ_SeqDense",
2211:                                       MatMatMult_SeqAIJ_SeqDense);


2214:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2215:                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2216:                                       MatMatMultSymbolic_SeqAIJ_SeqDense);
2217:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2218:                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2219:                                       MatMatMultNumeric_SeqAIJ_SeqDense);
2220:   PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2221:   return(0);
2222: }
2223: EXTERN_C_END