Actual source code: dense.c

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

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

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

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

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

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

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

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

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

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

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

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

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

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



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

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

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

194: PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X)
195: {
196:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
198:   PetscScalar    *b,*x;
199:   PetscInt       n;
200:   PetscBLASInt   nrhs,info,m=PetscBLASIntCast(A->rmap->n);
201:   PetscBool      flg;

204:   PetscTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
205:   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
206:   PetscTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);
207:   if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");

209:   MatGetSize(B,PETSC_NULL,&n);
210:   nrhs = PetscBLASIntCast(n);
211:   MatGetArray(B,&b);
212:   MatGetArray(X,&x);

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

216:   if (A->factortype == MAT_FACTOR_LU) {
217: #if defined(PETSC_MISSING_LAPACK_GETRS)
218:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
219: #else
220:     LAPACKgetrs_("N",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info);
221:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
222: #endif
223:   } else if (A->factortype == MAT_FACTOR_CHOLESKY){
224: #if defined(PETSC_MISSING_LAPACK_POTRS)
225:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
226: #else
227:     LAPACKpotrs_("L",&m,&nrhs,mat->v,&mat->lda,x,&m,&info);
228:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve");
229: #endif
230:   }
231:   else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve");

233:   MatRestoreArray(B,&b);
234:   MatRestoreArray(X,&x);
235:   PetscLogFlops(nrhs*(2.0*m*m - m));
236:   return(0);
237: }

241: PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy)
242: {
243:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
245:   PetscScalar    *x,*y;
246:   PetscBLASInt   one = 1,info,m = PetscBLASIntCast(A->rmap->n);
247: 
249:   VecGetArray(xx,&x);
250:   VecGetArray(yy,&y);
251:   PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));
252:   /* assume if pivots exist then use LU; else Cholesky */
253:   if (mat->pivots) {
254: #if defined(PETSC_MISSING_LAPACK_GETRS) 
255:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
256: #else
257:     LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info);
258:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
259: #endif
260:   } else {
261: #if defined(PETSC_MISSING_LAPACK_POTRS) 
262:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable.");
263: #else
264:     LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info);
265:     if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve");
266: #endif
267:   }
268:   VecRestoreArray(xx,&x);
269:   VecRestoreArray(yy,&y);
270:   PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);
271:   return(0);
272: }

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

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

370: /* ---------------------------------------------------------------*/
371: /* COMMENT: I have chosen to hide row permutation in the pivots,
372:    rather than put it in the Mat->row slot.*/
375: PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo)
376: {
377: #if defined(PETSC_MISSING_LAPACK_GETRF) 
379:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
380: #else
381:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
383:   PetscBLASInt   n,m,info;

386:   n = PetscBLASIntCast(A->cmap->n);
387:   m = PetscBLASIntCast(A->rmap->n);
388:   if (!mat->pivots) {
389:     PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);
390:     PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));
391:   }
392:   if (!A->rmap->n || !A->cmap->n) return(0);
393:   LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info);
394:   if (info<0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to LU factorization");
395:   if (info>0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
396:   A->ops->solve             = MatSolve_SeqDense;
397:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
398:   A->ops->solveadd          = MatSolveAdd_SeqDense;
399:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
400:   A->factortype             = MAT_FACTOR_LU;

402:   PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);
403: #endif
404:   return(0);
405: }

409: PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo)
410: {
411: #if defined(PETSC_MISSING_LAPACK_POTRF) 
413:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable.");
414: #else
415:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
417:   PetscBLASInt   info,n = PetscBLASIntCast(A->cmap->n);
418: 
420:   PetscFree(mat->pivots);

422:   if (!A->rmap->n || !A->cmap->n) return(0);
423:   LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info);
424:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1);
425:   A->ops->solve             = MatSolve_SeqDense;
426:   A->ops->solvetranspose    = MatSolveTranspose_SeqDense;
427:   A->ops->solveadd          = MatSolveAdd_SeqDense;
428:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense;
429:   A->factortype             = MAT_FACTOR_CHOLESKY;
430:   PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);
431: #endif
432:   return(0);
433: }


438: PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy)
439: {
441:   MatFactorInfo  info;

444:   info.fill = 1.0;
445:   MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);
446:   MatCholeskyFactor_SeqDense(fact,0,&info);
447:   return(0);
448: }

452: PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info)
453: {
455:   fact->assembled                  = PETSC_TRUE;
456:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense;
457:   return(0);
458: }

462: PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
463: {
465:   fact->assembled            = PETSC_TRUE;
466:   fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense;
467:   return(0);
468: }

473: PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact)
474: {

478:   MatCreate(((PetscObject)A)->comm,fact);
479:   MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);
480:   MatSetType(*fact,((PetscObject)A)->type_name);
481:   if (ftype == MAT_FACTOR_LU){
482:     (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense;
483:   } else {
484:     (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense;
485:   }
486:   (*fact)->factortype = ftype;
487:   return(0);
488: }

491: /* ------------------------------------------------------------------*/
494: PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx)
495: {
496:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
497:   PetscScalar    *x,*b,*v = mat->v,zero = 0.0,xt;
499:   PetscInt       m = A->rmap->n,i;
500: #if !defined(PETSC_USE_COMPLEX)
501:   PetscBLASInt   o = 1,bm = PetscBLASIntCast(m);
502: #endif

505:   if (flag & SOR_ZERO_INITIAL_GUESS) {
506:     /* this is a hack fix, should have another version without the second BLASdot */
507:     VecSet(xx,zero);
508:   }
509:   VecGetArray(xx,&x);
510:   VecGetArray(bb,&b);
511:   its  = its*lits;
512:   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
513:   while (its--) {
514:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){
515:       for (i=0; i<m; i++) {
516: #if defined(PETSC_USE_COMPLEX)
517:         /* cannot use BLAS dot for complex because compiler/linker is 
518:            not happy about returning a double complex */
519:         PetscInt    _i;
520:         PetscScalar sum = b[i];
521:         for (_i=0; _i<m; _i++) {
522:           sum -= PetscConj(v[i+_i*m])*x[_i];
523:         }
524:         xt = sum;
525: #else
526:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
527: #endif
528:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
529:       }
530:     }
531:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){
532:       for (i=m-1; i>=0; i--) {
533: #if defined(PETSC_USE_COMPLEX)
534:         /* cannot use BLAS dot for complex because compiler/linker is 
535:            not happy about returning a double complex */
536:         PetscInt    _i;
537:         PetscScalar sum = b[i];
538:         for (_i=0; _i<m; _i++) {
539:           sum -= PetscConj(v[i+_i*m])*x[_i];
540:         }
541:         xt = sum;
542: #else
543:         xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o);
544: #endif
545:         x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift);
546:       }
547:     }
548:   }
549:   VecRestoreArray(bb,&b);
550:   VecRestoreArray(xx,&x);
551:   return(0);
552: }

554: /* -----------------------------------------------------------------*/
557: PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy)
558: {
559:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
560:   PetscScalar    *v = mat->v,*x,*y;
562:   PetscBLASInt   m, n,_One=1;
563:   PetscScalar    _DOne=1.0,_DZero=0.0;

566:   m = PetscBLASIntCast(A->rmap->n);
567:   n = PetscBLASIntCast(A->cmap->n);
568:   if (!A->rmap->n || !A->cmap->n) return(0);
569:   VecGetArray(xx,&x);
570:   VecGetArray(yy,&y);
571:   BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One);
572:   VecRestoreArray(xx,&x);
573:   VecRestoreArray(yy,&y);
574:   PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);
575:   return(0);
576: }

580: PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy)
581: {
582:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
583:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0;
585:   PetscBLASInt   m, n, _One=1;

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

602: PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
603: {
604:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
605:   PetscScalar    *v = mat->v,*x,*y,_DOne=1.0;
607:   PetscBLASInt   m, n, _One=1;

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

625: PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy)
626: {
627:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
628:   PetscScalar    *v = mat->v,*x,*y;
630:   PetscBLASInt   m, n, _One=1;
631:   PetscScalar    _DOne=1.0;

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

647: /* -----------------------------------------------------------------*/
650: PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
651: {
652:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
653:   PetscScalar    *v;
655:   PetscInt       i;
656: 
658:   *ncols = A->cmap->n;
659:   if (cols) {
660:     PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);
661:     for (i=0; i<A->cmap->n; i++) (*cols)[i] = i;
662:   }
663:   if (vals) {
664:     PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);
665:     v    = mat->v + row;
666:     for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;}
667:   }
668:   return(0);
669: }

673: PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals)
674: {
677:   if (cols) {PetscFree(*cols);}
678:   if (vals) {PetscFree(*vals); }
679:   return(0);
680: }
681: /* ----------------------------------------------------------------*/
684: PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv)
685: {
686:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
687:   PetscInt     i,j,idx=0;
688: 
691:   if (!mat->roworiented) {
692:     if (addv == INSERT_VALUES) {
693:       for (j=0; j<n; j++) {
694:         if (indexn[j] < 0) {idx += m; continue;}
695: #if defined(PETSC_USE_DEBUG)  
696:         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);
697: #endif
698:         for (i=0; i<m; i++) {
699:           if (indexm[i] < 0) {idx++; continue;}
700: #if defined(PETSC_USE_DEBUG)  
701:           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);
702: #endif
703:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
704:         }
705:       }
706:     } else {
707:       for (j=0; j<n; j++) {
708:         if (indexn[j] < 0) {idx += m; continue;}
709: #if defined(PETSC_USE_DEBUG)  
710:         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);
711: #endif
712:         for (i=0; i<m; i++) {
713:           if (indexm[i] < 0) {idx++; continue;}
714: #if defined(PETSC_USE_DEBUG)  
715:           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);
716: #endif
717:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
718:         }
719:       }
720:     }
721:   } else {
722:     if (addv == INSERT_VALUES) {
723:       for (i=0; i<m; i++) {
724:         if (indexm[i] < 0) { idx += n; continue;}
725: #if defined(PETSC_USE_DEBUG)  
726:         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);
727: #endif
728:         for (j=0; j<n; j++) {
729:           if (indexn[j] < 0) { idx++; continue;}
730: #if defined(PETSC_USE_DEBUG)  
731:           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);
732: #endif
733:           mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++];
734:         }
735:       }
736:     } else {
737:       for (i=0; i<m; i++) {
738:         if (indexm[i] < 0) { idx += n; continue;}
739: #if defined(PETSC_USE_DEBUG)  
740:         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);
741: #endif
742:         for (j=0; j<n; j++) {
743:           if (indexn[j] < 0) { idx++; continue;}
744: #if defined(PETSC_USE_DEBUG)  
745:           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);
746: #endif
747:           mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++];
748:         }
749:       }
750:     }
751:   }
752:   return(0);
753: }

757: PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[])
758: {
759:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
760:   PetscInt     i,j;

763:   /* row-oriented output */
764:   for (i=0; i<m; i++) {
765:     if (indexm[i] < 0) {v += n;continue;}
766:     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);
767:     for (j=0; j<n; j++) {
768:       if (indexn[j] < 0) {v++; continue;}
769:       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);
770:       *v++ = mat->v[indexn[j]*mat->lda + indexm[i]];
771:     }
772:   }
773:   return(0);
774: }

776: /* -----------------------------------------------------------------*/

780: PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer)
781: {
782:   Mat_SeqDense   *a;
784:   PetscInt       *scols,i,j,nz,header[4];
785:   int            fd;
786:   PetscMPIInt    size;
787:   PetscInt       *rowlengths = 0,M,N,*cols,grows,gcols;
788:   PetscScalar    *vals,*svals,*v,*w;
789:   MPI_Comm       comm = ((PetscObject)viewer)->comm;

792:   MPI_Comm_size(comm,&size);
793:   if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor");
794:   PetscViewerBinaryGetDescriptor(viewer,&fd);
795:   PetscBinaryRead(fd,header,4,PETSC_INT);
796:   if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
797:   M = header[1]; N = header[2]; nz = header[3];

799:   /* set global size if not set already*/
800:   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
801:     MatSetSizes(newmat,M,N,M,N);
802:   } else {
803:     /* if sizes and type are already set, check if the vector global sizes are correct */
804:     MatGetSize(newmat,&grows,&gcols);
805:     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);
806:   }
807:   MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
808: 
809:   if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */
810:     a    = (Mat_SeqDense*)newmat->data;
811:     v    = a->v;
812:     /* Allocate some temp space to read in the values and then flip them
813:        from row major to column major */
814:     PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);
815:     /* read in nonzero values */
816:     PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);
817:     /* now flip the values and store them in the matrix*/
818:     for (j=0; j<N; j++) {
819:       for (i=0; i<M; i++) {
820:         *v++ =w[i*N+j];
821:       }
822:     }
823:     PetscFree(w);
824:   } else {
825:     /* read row lengths */
826:     PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);
827:     PetscBinaryRead(fd,rowlengths,M,PETSC_INT);

829:     a = (Mat_SeqDense*)newmat->data;
830:     v = a->v;

832:     /* read column indices and nonzeros */
833:     PetscMalloc((nz+1)*sizeof(PetscInt),&scols);
834:     cols = scols;
835:     PetscBinaryRead(fd,cols,nz,PETSC_INT);
836:     PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);
837:     vals = svals;
838:     PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);

840:     /* insert into matrix */
841:     for (i=0; i<M; i++) {
842:       for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j];
843:       svals += rowlengths[i]; scols += rowlengths[i];
844:     }
845:     PetscFree(vals);
846:     PetscFree(cols);
847:     PetscFree(rowlengths);
848:   }
849:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
850:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

852:   return(0);
853: }

857: static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer)
858: {
859:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
860:   PetscErrorCode    ierr;
861:   PetscInt          i,j;
862:   const char        *name;
863:   PetscScalar       *v;
864:   PetscViewerFormat format;
865: #if defined(PETSC_USE_COMPLEX)
866:   PetscBool         allreal = PETSC_TRUE;
867: #endif

870:   PetscViewerGetFormat(viewer,&format);
871:   if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
872:     return(0);  /* do nothing for now */
873:   } else if (format == PETSC_VIEWER_ASCII_COMMON) {
874:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
875:     PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
876:     for (i=0; i<A->rmap->n; i++) {
877:       v = a->v + i;
878:       PetscViewerASCIIPrintf(viewer,"row %D:",i);
879:       for (j=0; j<A->cmap->n; j++) {
880: #if defined(PETSC_USE_COMPLEX)
881:         if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) {
882:           PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));
883:         } else if (PetscRealPart(*v)) {
884:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));
885:         }
886: #else
887:         if (*v) {
888:           PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);
889:         }
890: #endif
891:         v += a->lda;
892:       }
893:       PetscViewerASCIIPrintf(viewer,"\n");
894:     }
895:     PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
896:   } else {
897:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
898: #if defined(PETSC_USE_COMPLEX)
899:     /* determine if matrix has all real values */
900:     v = a->v;
901:     for (i=0; i<A->rmap->n*A->cmap->n; i++) {
902:         if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;}
903:     }
904: #endif
905:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
906:       PetscObjectGetName((PetscObject)A,&name);
907:       PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);
908:       PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);
909:       PetscViewerASCIIPrintf(viewer,"%s = [\n",name);
910:     } else {
911:       PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");
912:     }

914:     for (i=0; i<A->rmap->n; i++) {
915:       v = a->v + i;
916:       for (j=0; j<A->cmap->n; j++) {
917: #if defined(PETSC_USE_COMPLEX)
918:         if (allreal) {
919:           PetscViewerASCIIPrintf(viewer,"%18.16e ",PetscRealPart(*v));
920:         } else {
921:           PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16e i ",PetscRealPart(*v),PetscImaginaryPart(*v));
922:         }
923: #else
924:         PetscViewerASCIIPrintf(viewer,"%18.16e ",*v);
925: #endif
926:         v += a->lda;
927:       }
928:       PetscViewerASCIIPrintf(viewer,"\n");
929:     }
930:     if (format == PETSC_VIEWER_ASCII_MATLAB) {
931:       PetscViewerASCIIPrintf(viewer,"];\n");
932:     }
933:     PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
934:   }
935:   PetscViewerFlush(viewer);
936:   return(0);
937: }

941: static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer)
942: {
943:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
944:   PetscErrorCode    ierr;
945:   int               fd;
946:   PetscInt          ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n;
947:   PetscScalar       *v,*anonz,*vals;
948:   PetscViewerFormat format;
949: 
951:   PetscViewerBinaryGetDescriptor(viewer,&fd);

953:   PetscViewerGetFormat(viewer,&format);
954:   if (format == PETSC_VIEWER_NATIVE) {
955:     /* store the matrix as a dense matrix */
956:     PetscMalloc(4*sizeof(PetscInt),&col_lens);
957:     col_lens[0] = MAT_FILE_CLASSID;
958:     col_lens[1] = m;
959:     col_lens[2] = n;
960:     col_lens[3] = MATRIX_BINARY_FORMAT_DENSE;
961:     PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);
962:     PetscFree(col_lens);

964:     /* write out matrix, by rows */
965:     PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);
966:     v    = a->v;
967:     for (j=0; j<n; j++) {
968:       for (i=0; i<m; i++) {
969:         vals[j + i*n] = *v++;
970:       }
971:     }
972:     PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);
973:     PetscFree(vals);
974:   } else {
975:     PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);
976:     col_lens[0] = MAT_FILE_CLASSID;
977:     col_lens[1] = m;
978:     col_lens[2] = n;
979:     col_lens[3] = nz;

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

985:     /* Possibly should write in smaller increments, not whole matrix at once? */
986:     /* store column indices (zero start index) */
987:     ict = 0;
988:     for (i=0; i<m; i++) {
989:       for (j=0; j<n; j++) col_lens[ict++] = j;
990:     }
991:     PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);
992:     PetscFree(col_lens);

994:     /* store nonzero values */
995:     PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);
996:     ict  = 0;
997:     for (i=0; i<m; i++) {
998:       v = a->v + i;
999:       for (j=0; j<n; j++) {
1000:         anonz[ict++] = *v; v += a->lda;
1001:       }
1002:     }
1003:     PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);
1004:     PetscFree(anonz);
1005:   }
1006:   return(0);
1007: }

1011: PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa)
1012: {
1013:   Mat               A = (Mat) Aa;
1014:   Mat_SeqDense      *a = (Mat_SeqDense*)A->data;
1015:   PetscErrorCode    ierr;
1016:   PetscInt          m = A->rmap->n,n = A->cmap->n,color,i,j;
1017:   PetscScalar       *v = a->v;
1018:   PetscViewer       viewer;
1019:   PetscDraw         popup;
1020:   PetscReal         xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0;
1021:   PetscViewerFormat format;


1025:   PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);
1026:   PetscViewerGetFormat(viewer,&format);
1027:   PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);

1029:   /* Loop over matrix elements drawing boxes */
1030:   if (format != PETSC_VIEWER_DRAW_CONTOUR) {
1031:     /* Blue for negative and Red for positive */
1032:     color = PETSC_DRAW_BLUE;
1033:     for(j = 0; j < n; j++) {
1034:       x_l = j;
1035:       x_r = x_l + 1.0;
1036:       for(i = 0; i < m; i++) {
1037:         y_l = m - i - 1.0;
1038:         y_r = y_l + 1.0;
1039: #if defined(PETSC_USE_COMPLEX)
1040:         if (PetscRealPart(v[j*m+i]) >  0.) {
1041:           color = PETSC_DRAW_RED;
1042:         } else if (PetscRealPart(v[j*m+i]) <  0.) {
1043:           color = PETSC_DRAW_BLUE;
1044:         } else {
1045:           continue;
1046:         }
1047: #else
1048:         if (v[j*m+i] >  0.) {
1049:           color = PETSC_DRAW_RED;
1050:         } else if (v[j*m+i] <  0.) {
1051:           color = PETSC_DRAW_BLUE;
1052:         } else {
1053:           continue;
1054:         }
1055: #endif
1056:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1057:       }
1058:     }
1059:   } else {
1060:     /* use contour shading to indicate magnitude of values */
1061:     /* first determine max of all nonzero values */
1062:     for(i = 0; i < m*n; i++) {
1063:       if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]);
1064:     }
1065:     scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv;
1066:     PetscDrawGetPopup(draw,&popup);
1067:     if (popup) {PetscDrawScalePopup(popup,0.0,maxv);}
1068:     for(j = 0; j < n; j++) {
1069:       x_l = j;
1070:       x_r = x_l + 1.0;
1071:       for(i = 0; i < m; i++) {
1072:         y_l   = m - i - 1.0;
1073:         y_r   = y_l + 1.0;
1074:         color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i]));
1075:         PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);
1076:       }
1077:     }
1078:   }
1079:   return(0);
1080: }

1084: PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer)
1085: {
1086:   PetscDraw      draw;
1087:   PetscBool      isnull;
1088:   PetscReal      xr,yr,xl,yl,h,w;

1092:   PetscViewerDrawGetDraw(viewer,0,&draw);
1093:   PetscDrawIsNull(draw,&isnull);
1094:   if (isnull) return(0);

1096:   PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);
1097:   xr  = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0;
1098:   xr += w;    yr += h;  xl = -w;     yl = -h;
1099:   PetscDrawSetCoordinates(draw,xl,yl,xr,yr);
1100:   PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);
1101:   PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);
1102:   return(0);
1103: }

1107: PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer)
1108: {
1110:   PetscBool      iascii,isbinary,isdraw;

1113:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
1114:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
1115:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);

1117:   if (iascii) {
1118:     MatView_SeqDense_ASCII(A,viewer);
1119:   } else if (isbinary) {
1120:     MatView_SeqDense_Binary(A,viewer);
1121:   } else if (isdraw) {
1122:     MatView_SeqDense_Draw(A,viewer);
1123:   } else {
1124:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name);
1125:   }
1126:   return(0);
1127: }

1131: PetscErrorCode MatDestroy_SeqDense(Mat mat)
1132: {
1133:   Mat_SeqDense   *l = (Mat_SeqDense*)mat->data;

1137: #if defined(PETSC_USE_LOG)
1138:   PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n);
1139: #endif
1140:   PetscFree(l->pivots);
1141:   if (!l->user_alloc) {PetscFree(l->v);}
1142:   PetscFree(mat->data);

1144:   PetscObjectChangeTypeName((PetscObject)mat,0);
1145:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);
1146:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);
1147:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);
1148:   PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);
1149:   return(0);
1150: }

1154: PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout)
1155: {
1156:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1158:   PetscInt       k,j,m,n,M;
1159:   PetscScalar    *v,tmp;

1162:   v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n;
1163:   if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */
1164:     if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place");
1165:     else {
1166:       for (j=0; j<m; j++) {
1167:         for (k=0; k<j; k++) {
1168:           tmp = v[j + k*M];
1169:           v[j + k*M] = v[k + j*M];
1170:           v[k + j*M] = tmp;
1171:         }
1172:       }
1173:     }
1174:   } else { /* out-of-place transpose */
1175:     Mat          tmat;
1176:     Mat_SeqDense *tmatd;
1177:     PetscScalar  *v2;

1179:     if (reuse == MAT_INITIAL_MATRIX) {
1180:       MatCreate(((PetscObject)A)->comm,&tmat);
1181:       MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);
1182:       MatSetType(tmat,((PetscObject)A)->type_name);
1183:       MatSeqDenseSetPreallocation(tmat,PETSC_NULL);
1184:     } else {
1185:       tmat = *matout;
1186:     }
1187:     tmatd = (Mat_SeqDense*)tmat->data;
1188:     v = mat->v; v2 = tmatd->v;
1189:     for (j=0; j<n; j++) {
1190:       for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M];
1191:     }
1192:     MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);
1193:     MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);
1194:     *matout = tmat;
1195:   }
1196:   return(0);
1197: }

1201: PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool  *flg)
1202: {
1203:   Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data;
1204:   Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data;
1205:   PetscInt     i,j;
1206:   PetscScalar  *v1 = mat1->v,*v2 = mat2->v;

1209:   if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; return(0);}
1210:   if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; return(0);}
1211:   for (i=0; i<A1->rmap->n; i++) {
1212:     v1 = mat1->v+i; v2 = mat2->v+i;
1213:     for (j=0; j<A1->cmap->n; j++) {
1214:       if (*v1 != *v2) {*flg = PETSC_FALSE; return(0);}
1215:       v1 += mat1->lda; v2 += mat2->lda;
1216:     }
1217:   }
1218:   *flg = PETSC_TRUE;
1219:   return(0);
1220: }

1224: PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v)
1225: {
1226:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1228:   PetscInt       i,n,len;
1229:   PetscScalar    *x,zero = 0.0;

1232:   VecSet(v,zero);
1233:   VecGetSize(v,&n);
1234:   VecGetArray(v,&x);
1235:   len = PetscMin(A->rmap->n,A->cmap->n);
1236:   if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1237:   for (i=0; i<len; i++) {
1238:     x[i] = mat->v[i*mat->lda + i];
1239:   }
1240:   VecRestoreArray(v,&x);
1241:   return(0);
1242: }

1246: PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr)
1247: {
1248:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1249:   PetscScalar    *l,*r,x,*v;
1251:   PetscInt       i,j,m = A->rmap->n,n = A->cmap->n;

1254:   if (ll) {
1255:     VecGetSize(ll,&m);
1256:     VecGetArray(ll,&l);
1257:     if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size");
1258:     for (i=0; i<m; i++) {
1259:       x = l[i];
1260:       v = mat->v + i;
1261:       for (j=0; j<n; j++) { (*v) *= x; v+= m;}
1262:     }
1263:     VecRestoreArray(ll,&l);
1264:     PetscLogFlops(n*m);
1265:   }
1266:   if (rr) {
1267:     VecGetSize(rr,&n);
1268:     VecGetArray(rr,&r);
1269:     if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size");
1270:     for (i=0; i<n; i++) {
1271:       x = r[i];
1272:       v = mat->v + i*m;
1273:       for (j=0; j<m; j++) { (*v++) *= x;}
1274:     }
1275:     VecRestoreArray(rr,&r);
1276:     PetscLogFlops(n*m);
1277:   }
1278:   return(0);
1279: }

1283: PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm)
1284: {
1285:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
1286:   PetscScalar  *v = mat->v;
1287:   PetscReal    sum = 0.0;
1288:   PetscInt     lda=mat->lda,m=A->rmap->n,i,j;

1292:   if (type == NORM_FROBENIUS) {
1293:     if (lda>m) {
1294:       for (j=0; j<A->cmap->n; j++) {
1295:         v = mat->v+j*lda;
1296:         for (i=0; i<m; i++) {
1297: #if defined(PETSC_USE_COMPLEX)
1298:           sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1299: #else
1300:           sum += (*v)*(*v); v++;
1301: #endif
1302:         }
1303:       }
1304:     } else {
1305:       for (i=0; i<A->cmap->n*A->rmap->n; i++) {
1306: #if defined(PETSC_USE_COMPLEX)
1307:         sum += PetscRealPart(PetscConj(*v)*(*v)); v++;
1308: #else
1309:         sum += (*v)*(*v); v++;
1310: #endif
1311:       }
1312:     }
1313:     *nrm = PetscSqrtReal(sum);
1314:     PetscLogFlops(2.0*A->cmap->n*A->rmap->n);
1315:   } else if (type == NORM_1) {
1316:     *nrm = 0.0;
1317:     for (j=0; j<A->cmap->n; j++) {
1318:       v = mat->v + j*mat->lda;
1319:       sum = 0.0;
1320:       for (i=0; i<A->rmap->n; i++) {
1321:         sum += PetscAbsScalar(*v);  v++;
1322:       }
1323:       if (sum > *nrm) *nrm = sum;
1324:     }
1325:     PetscLogFlops(A->cmap->n*A->rmap->n);
1326:   } else if (type == NORM_INFINITY) {
1327:     *nrm = 0.0;
1328:     for (j=0; j<A->rmap->n; j++) {
1329:       v = mat->v + j;
1330:       sum = 0.0;
1331:       for (i=0; i<A->cmap->n; i++) {
1332:         sum += PetscAbsScalar(*v); v += mat->lda;
1333:       }
1334:       if (sum > *nrm) *nrm = sum;
1335:     }
1336:     PetscLogFlops(A->cmap->n*A->rmap->n);
1337:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
1338:   return(0);
1339: }

1343: PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool  flg)
1344: {
1345:   Mat_SeqDense   *aij = (Mat_SeqDense*)A->data;
1347: 
1349:   switch (op) {
1350:   case MAT_ROW_ORIENTED:
1351:     aij->roworiented = flg;
1352:     break;
1353:   case MAT_NEW_NONZERO_LOCATIONS:
1354:   case MAT_NEW_NONZERO_LOCATION_ERR:
1355:   case MAT_NEW_NONZERO_ALLOCATION_ERR:
1356:   case MAT_NEW_DIAGONALS:
1357:   case MAT_KEEP_NONZERO_PATTERN:
1358:   case MAT_IGNORE_OFF_PROC_ENTRIES:
1359:   case MAT_USE_HASH_TABLE:
1360:   case MAT_SYMMETRIC:
1361:   case MAT_STRUCTURALLY_SYMMETRIC:
1362:   case MAT_HERMITIAN:
1363:   case MAT_SYMMETRY_ETERNAL:
1364:   case MAT_IGNORE_LOWER_TRIANGULAR:
1365:     PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1366:     break;
1367:   default:
1368:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]);
1369:   }
1370:   return(0);
1371: }

1375: PetscErrorCode MatZeroEntries_SeqDense(Mat A)
1376: {
1377:   Mat_SeqDense   *l = (Mat_SeqDense*)A->data;
1379:   PetscInt       lda=l->lda,m=A->rmap->n,j;

1382:   if (lda>m) {
1383:     for (j=0; j<A->cmap->n; j++) {
1384:       PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));
1385:     }
1386:   } else {
1387:     PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1388:   }
1389:   return(0);
1390: }

1394: PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b)
1395: {
1396:   PetscErrorCode    ierr;
1397:   Mat_SeqDense      *l = (Mat_SeqDense*)A->data;
1398:   PetscInt          m = l->lda, n = A->cmap->n, i,j;
1399:   PetscScalar       *slot,*bb;
1400:   const PetscScalar *xx;

1403: #if defined(PETSC_USE_DEBUG)  
1404:   for (i=0; i<N; i++) {
1405:     if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed");
1406:     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);
1407:   }
1408: #endif

1410:   /* fix right hand side if needed */
1411:   if (x && b) {
1412:     VecGetArrayRead(x,&xx);
1413:     VecGetArray(b,&bb);
1414:     for (i=0; i<N; i++) {
1415:       bb[rows[i]] = diag*xx[rows[i]];
1416:     }
1417:     VecRestoreArrayRead(x,&xx);
1418:     VecRestoreArray(b,&bb);
1419:   }

1421:   for (i=0; i<N; i++) {
1422:     slot = l->v + rows[i];
1423:     for (j=0; j<n; j++) { *slot = 0.0; slot += m;}
1424:   }
1425:   if (diag != 0.0) {
1426:     if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices");
1427:     for (i=0; i<N; i++) {
1428:       slot = l->v + (m+1)*rows[i];
1429:       *slot = diag;
1430:     }
1431:   }
1432:   return(0);
1433: }

1437: PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[])
1438: {
1439:   Mat_SeqDense *mat = (Mat_SeqDense*)A->data;

1442:   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");
1443:   *array = mat->v;
1444:   return(0);
1445: }

1449: PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[])
1450: {
1452:   *array = 0; /* user cannot accidently use the array later */
1453:   return(0);
1454: }

1458: static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B)
1459: {
1460:   Mat_SeqDense   *mat = (Mat_SeqDense*)A->data;
1462:   PetscInt       i,j,nrows,ncols;
1463:   const PetscInt *irow,*icol;
1464:   PetscScalar    *av,*bv,*v = mat->v;
1465:   Mat            newmat;

1468:   ISGetIndices(isrow,&irow);
1469:   ISGetIndices(iscol,&icol);
1470:   ISGetLocalSize(isrow,&nrows);
1471:   ISGetLocalSize(iscol,&ncols);
1472: 
1473:   /* Check submatrixcall */
1474:   if (scall == MAT_REUSE_MATRIX) {
1475:     PetscInt n_cols,n_rows;
1476:     MatGetSize(*B,&n_rows,&n_cols);
1477:     if (n_rows != nrows || n_cols != ncols) {
1478:       /* resize the result matrix to match number of requested rows/columns */
1479:       MatSetSizes(*B,nrows,ncols,nrows,ncols);
1480:     }
1481:     newmat = *B;
1482:   } else {
1483:     /* Create and fill new matrix */
1484:     MatCreate(((PetscObject)A)->comm,&newmat);
1485:     MatSetSizes(newmat,nrows,ncols,nrows,ncols);
1486:     MatSetType(newmat,((PetscObject)A)->type_name);
1487:     MatSeqDenseSetPreallocation(newmat,PETSC_NULL);
1488:   }

1490:   /* Now extract the data pointers and do the copy,column at a time */
1491:   bv = ((Mat_SeqDense*)newmat->data)->v;
1492: 
1493:   for (i=0; i<ncols; i++) {
1494:     av = v + mat->lda*icol[i];
1495:     for (j=0; j<nrows; j++) {
1496:       *bv++ = av[irow[j]];
1497:     }
1498:   }

1500:   /* Assemble the matrices so that the correct flags are set */
1501:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
1502:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

1504:   /* Free work space */
1505:   ISRestoreIndices(isrow,&irow);
1506:   ISRestoreIndices(iscol,&icol);
1507:   *B = newmat;
1508:   return(0);
1509: }

1513: PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
1514: {
1516:   PetscInt       i;

1519:   if (scall == MAT_INITIAL_MATRIX) {
1520:     PetscMalloc((n+1)*sizeof(Mat),B);
1521:   }

1523:   for (i=0; i<n; i++) {
1524:     MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);
1525:   }
1526:   return(0);
1527: }

1531: PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode)
1532: {
1534:   return(0);
1535: }

1539: PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode)
1540: {
1542:   return(0);
1543: }

1547: PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str)
1548: {
1549:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data;
1551:   PetscInt       lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j;

1554:   /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */
1555:   if (A->ops->copy != B->ops->copy) {
1556:     MatCopy_Basic(A,B,str);
1557:     return(0);
1558:   }
1559:   if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)");
1560:   if (lda1>m || lda2>m) {
1561:     for (j=0; j<n; j++) {
1562:       PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));
1563:     }
1564:   } else {
1565:     PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));
1566:   }
1567:   return(0);
1568: }

1572: PetscErrorCode MatSetUpPreallocation_SeqDense(Mat A)
1573: {

1577:    MatSeqDenseSetPreallocation(A,0);
1578:   return(0);
1579: }

1583: PetscErrorCode MatSetSizes_SeqDense(Mat A,PetscInt m,PetscInt n,PetscInt M,PetscInt N)
1584: {
1586:   /* this will not be called before lda, Mmax,  and Nmax have been set */
1587:   m = PetscMax(m,M);
1588:   n = PetscMax(n,N);

1590:   /*  if (m > a->Mmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot yet resize number rows of dense matrix larger then its initial size %d, requested %d",a->lda,(int)m);
1591:     if (n > a->Nmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot yet resize number columns of dense matrix larger then its initial size %d, requested %d",a->Nmax,(int)n);
1592:   */
1593:   A->rmap->n = A->rmap->N = m;
1594:   A->cmap->n = A->cmap->N = n;
1595:   return(0);
1596: }

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

1607:   for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]);
1608:   return(0);
1609: }

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

1620:   for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]);
1621:   return(0);
1622: }

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

1633:   for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]);
1634:   return(0);
1635: }

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

1645:   if (scall == MAT_INITIAL_MATRIX){
1646:     MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);
1647:   }
1648:   MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);
1649:   return(0);
1650: }

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

1661:   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);
1662:   MatCreate(PETSC_COMM_SELF,&Cmat);
1663:   MatSetSizes(Cmat,m,n,m,n);
1664:   MatSetType(Cmat,MATSEQDENSE);
1665:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1666:   Cmat->assembled = PETSC_TRUE;
1667:   *C = Cmat;
1668:   return(0);
1669: }

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

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

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

1696:   if (scall == MAT_INITIAL_MATRIX){
1697:     MatMatMultTransposeSymbolic_SeqDense_SeqDense(A,B,fill,C);
1698:   }
1699:   MatMatMultTransposeNumeric_SeqDense_SeqDense(A,B,*C);
1700:   return(0);
1701: }

1705: PetscErrorCode MatMatMultTransposeSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C)
1706: {
1708:   PetscInt       m=A->cmap->n,n=B->cmap->n;
1709:   Mat            Cmat;

1712:   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);
1713:   MatCreate(PETSC_COMM_SELF,&Cmat);
1714:   MatSetSizes(Cmat,m,n,m,n);
1715:   MatSetType(Cmat,MATSEQDENSE);
1716:   MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);
1717:   Cmat->assembled = PETSC_TRUE;
1718:   *C = Cmat;
1719:   return(0);
1720: }

1724: PetscErrorCode MatMatMultTransposeNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C)
1725: {
1726:   Mat_SeqDense   *a = (Mat_SeqDense*)A->data;
1727:   Mat_SeqDense   *b = (Mat_SeqDense*)B->data;
1728:   Mat_SeqDense   *c = (Mat_SeqDense*)C->data;
1729:   PetscBLASInt   m,n,k;
1730:   PetscScalar    _DOne=1.0,_DZero=0.0;

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

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

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

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

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

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

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

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

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

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

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

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

1837:   VecGetArray(v,&x);
1838:   PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));
1839:   VecRestoreArray(v,&x);
1840:   return(0);
1841: }


1846: PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms)
1847: {
1849:   PetscInt       i,j,m,n;
1850:   PetscScalar    *a;

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

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

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

2020:    Collective on MPI_Comm

2022:    Input Parameters:
2023: +  comm - MPI communicator, set to PETSC_COMM_SELF
2024: .  m - number of rows
2025: .  n - number of columns
2026: -  data - optional location of matrix data in column major order.  Set data=PETSC_NULL for PETSc
2027:    to control all matrix memory allocation.

2029:    Output Parameter:
2030: .  A - the matrix

2032:    Notes:
2033:    The data input variable is intended primarily for Fortran programmers
2034:    who wish to allocate their own matrix memory space.  Most users should
2035:    set data=PETSC_NULL.

2037:    Level: intermediate

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

2041: .seealso: MatCreate(), MatCreateMPIDense(), MatSetValues()
2042: @*/
2043: PetscErrorCode  MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A)
2044: {

2048:   MatCreate(comm,A);
2049:   MatSetSizes(*A,m,n,m,n);
2050:   MatSetType(*A,MATSEQDENSE);
2051:   MatSeqDenseSetPreallocation(*A,data);
2052:   return(0);
2053: }

2057: /*@C
2058:    MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements

2060:    Collective on MPI_Comm

2062:    Input Parameters:
2063: +  A - the matrix
2064: -  data - the array (or PETSC_NULL)

2066:    Notes:
2067:    The data input variable is intended primarily for Fortran programmers
2068:    who wish to allocate their own matrix memory space.  Most users should
2069:    need not call this routine.

2071:    Level: intermediate

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

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

2077: @*/
2078: PetscErrorCode  MatSeqDenseSetPreallocation(Mat B,PetscScalar data[])
2079: {

2083:   PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));
2084:   return(0);
2085: }

2090: PetscErrorCode  MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data)
2091: {
2092:   Mat_SeqDense   *b;

2096:   B->preallocated = PETSC_TRUE;

2098:   PetscLayoutSetBlockSize(B->rmap,1);
2099:   PetscLayoutSetBlockSize(B->cmap,1);
2100:   PetscLayoutSetUp(B->rmap);
2101:   PetscLayoutSetUp(B->cmap);

2103:   b       = (Mat_SeqDense*)B->data;
2104:   b->Mmax = B->rmap->n;
2105:   b->Nmax = B->cmap->n;
2106:   if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n;

2108:   if (!data) { /* petsc-allocated storage */
2109:     if (!b->user_alloc) { PetscFree(b->v); }
2110:     PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);
2111:     PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));
2112:     PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));
2113:     b->user_alloc = PETSC_FALSE;
2114:   } else { /* user-allocated storage */
2115:     if (!b->user_alloc) { PetscFree(b->v); }
2116:     b->v          = data;
2117:     b->user_alloc = PETSC_TRUE;
2118:   }
2119:   B->assembled = PETSC_TRUE;
2120:   return(0);
2121: }

2126: /*@C
2127:   MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array

2129:   Input parameter:
2130: + A - the matrix
2131: - lda - the leading dimension

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

2138:   Level: intermediate

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

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

2144: @*/
2145: PetscErrorCode  MatSeqDenseSetLDA(Mat B,PetscInt lda)
2146: {
2147:   Mat_SeqDense *b = (Mat_SeqDense*)B->data;

2150:   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);
2151:   b->lda       = lda;
2152:   b->changelda = PETSC_FALSE;
2153:   b->Mmax      = PetscMax(b->Mmax,lda);
2154:   return(0);
2155: }

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

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

2163:   Level: beginner

2165: .seealso: MatCreateSeqDense()

2167: M*/

2172: PetscErrorCode  MatCreate_SeqDense(Mat B)
2173: {
2174:   Mat_SeqDense   *b;
2176:   PetscMPIInt    size;

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

2182:   PetscNewLog(B,Mat_SeqDense,&b);
2183:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
2184:   B->data         = (void*)b;

2186:   b->pivots       = 0;
2187:   b->roworiented  = PETSC_TRUE;
2188:   b->v            = 0;
2189:   b->changelda    = PETSC_FALSE;


2192:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C",
2193:                                      "MatGetFactor_seqdense_petsc",
2194:                                       MatGetFactor_seqdense_petsc);
2195:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C",
2196:                                     "MatSeqDenseSetPreallocation_SeqDense",
2197:                                      MatSeqDenseSetPreallocation_SeqDense);
2198:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C",
2199:                                      "MatMatMult_SeqAIJ_SeqDense",
2200:                                       MatMatMult_SeqAIJ_SeqDense);
2201:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C",
2202:                                      "MatMatMultSymbolic_SeqAIJ_SeqDense",
2203:                                       MatMatMultSymbolic_SeqAIJ_SeqDense);
2204:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C",
2205:                                      "MatMatMultNumeric_SeqAIJ_SeqDense",
2206:                                       MatMatMultNumeric_SeqAIJ_SeqDense);
2207:   PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);
2208:   return(0);
2209: }