Actual source code: bdiag.c

  1: #define PETSCMAT_DLL

  3: /* Block diagonal matrix format */

 5:  #include src/mat/impls/bdiag/seq/bdiag.h
 6:  #include src/inline/ilu.h

 10: PetscErrorCode MatDestroy_SeqBDiag(Mat A)
 11: {
 12:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
 14:   PetscInt       i,bs = A->rmap.bs;

 17: #if defined(PETSC_USE_LOG)
 18:   PetscLogObjectState((PetscObject)A,"Rows=%D, Cols=%D, NZ=%D, BSize=%D, NDiag=%D",A->rmap.N,A->cmap.n,a->nz,A->rmap.bs,a->nd);
 19: #endif
 20:   if (!a->user_alloc) { /* Free the actual diagonals */
 21:     for (i=0; i<a->nd; i++) {
 22:       if (a->diag[i] > 0) {
 23:         PetscScalar *dummy = a->diagv[i] + bs*bs*a->diag[i];
 24:         PetscFree(dummy);
 25:       } else {
 26:         PetscFree(a->diagv[i]);
 27:       }
 28:     }
 29:   }
 30:   PetscFree(a->pivot);
 31:   PetscFree(a->diagv);
 32:   PetscFree(a->diag);
 33:   PetscFree(a->colloc);
 34:   PetscFree(a->dvalue);
 35:   PetscFree(a->solvework);
 36:   PetscFree(a);
 37:   PetscObjectComposeFunction((PetscObject)A,"MatSeqBDiagSetPreallocation_C","",PETSC_NULL);
 38:   return(0);
 39: }

 43: PetscErrorCode MatAssemblyEnd_SeqBDiag(Mat A,MatAssemblyType mode)
 44: {
 45:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
 46:   PetscInt       i,k,temp,*diag = a->diag,*bdlen = a->bdlen;
 47:   PetscScalar    *dtemp,**dv = a->diagv;

 51:   if (mode == MAT_FLUSH_ASSEMBLY) return(0);

 53:   /* Sort diagonals */
 54:   for (i=0; i<a->nd; i++) {
 55:     for (k=i+1; k<a->nd; k++) {
 56:       if (diag[i] < diag[k]) {
 57:         temp     = diag[i];
 58:         diag[i]  = diag[k];
 59:         diag[k]  = temp;
 60:         temp     = bdlen[i];
 61:         bdlen[i] = bdlen[k];
 62:         bdlen[k] = temp;
 63:         dtemp    = dv[i];
 64:         dv[i]    = dv[k];
 65:         dv[k]    = dtemp;
 66:       }
 67:     }
 68:   }

 70:   /* Set location of main diagonal */
 71:   for (i=0; i<a->nd; i++) {
 72:     if (!a->diag[i]) {a->mainbd = i; break;}
 73:   }
 74:   PetscInfo3(A,"Number diagonals %D,memory used %D, block size %D\n",a->nd,a->maxnz,A->rmap.bs);
 75:   return(0);
 76: }

 80: PetscErrorCode MatSetOption_SeqBDiag(Mat A,MatOption op)
 81: {
 82:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;

 86:   switch (op) {
 87:   case MAT_NO_NEW_NONZERO_LOCATIONS:
 88:     a->nonew       = 1;
 89:     break;
 90:   case MAT_YES_NEW_NONZERO_LOCATIONS:
 91:     a->nonew       = 0;
 92:     break;
 93:   case MAT_NO_NEW_DIAGONALS:
 94:     a->nonew_diag  = 1;
 95:     break;
 96:   case MAT_YES_NEW_DIAGONALS:
 97:     a->nonew_diag  = 0;
 98:     break;
 99:   case MAT_COLUMN_ORIENTED:
100:     a->roworiented = PETSC_FALSE;
101:     break;
102:   case MAT_ROW_ORIENTED:
103:     a->roworiented = PETSC_TRUE;
104:     break;
105:   case MAT_ROWS_SORTED:
106:   case MAT_ROWS_UNSORTED:
107:   case MAT_COLUMNS_SORTED:
108:   case MAT_COLUMNS_UNSORTED:
109:   case MAT_IGNORE_OFF_PROC_ENTRIES:
110:   case MAT_NEW_NONZERO_LOCATION_ERR:
111:   case MAT_NEW_NONZERO_ALLOCATION_ERR:
112:   case MAT_USE_HASH_TABLE:
113:     PetscInfo1(A,"Option %d ignored\n",op);
114:     break;
115:   case MAT_SYMMETRIC:
116:   case MAT_STRUCTURALLY_SYMMETRIC:
117:   case MAT_NOT_SYMMETRIC:
118:   case MAT_NOT_STRUCTURALLY_SYMMETRIC:
119:   case MAT_HERMITIAN:
120:   case MAT_NOT_HERMITIAN:
121:   case MAT_SYMMETRY_ETERNAL:
122:   case MAT_NOT_SYMMETRY_ETERNAL:
123:     break;
124:   default:
125:     SETERRQ1(PETSC_ERR_SUP,"unknown option %d",op);
126:   }
127:   return(0);
128: }

132: static PetscErrorCode MatGetDiagonal_SeqBDiag_N(Mat A,Vec v)
133: {
134:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
136:   PetscInt       i,j,n,len,ibase,bs = A->rmap.bs,iloc;
137:   PetscScalar    *x,*dd,zero = 0.0;

140:   if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
141:   VecSet(v,zero);
142:   VecGetLocalSize(v,&n);
143:   if (n != A->rmap.N) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
144:   if (a->mainbd == -1) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Main diagonal not set");
145:   len = PetscMin(a->mblock,a->nblock);
146:   dd = a->diagv[a->mainbd];
147:   VecGetArray(v,&x);
148:   for (i=0; i<len; i++) {
149:     ibase = i*bs*bs;  iloc = i*bs;
150:     for (j=0; j<bs; j++) x[j + iloc] = dd[ibase + j*(bs+1)];
151:   }
152:   VecRestoreArray(v,&x);
153:   return(0);
154: }

158: static PetscErrorCode MatGetDiagonal_SeqBDiag_1(Mat A,Vec v)
159: {
160:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
162:   PetscInt       i,n,len;
163:   PetscScalar    *x,*dd,zero = 0.0;

166:   VecSet(v,zero);
167:   VecGetLocalSize(v,&n);
168:   if (n != A->rmap.N) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
169:   if (a->mainbd == -1) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Main diagonal not set");
170:   dd = a->diagv[a->mainbd];
171:   len = PetscMin(A->rmap.n,A->cmap.n);
172:   VecGetArray(v,&x);
173:   for (i=0; i<len; i++) x[i] = dd[i];
174:   VecRestoreArray(v,&x);
175:   return(0);
176: }

180: PetscErrorCode MatZeroEntries_SeqBDiag(Mat A)
181: {
182:   Mat_SeqBDiag *a = (Mat_SeqBDiag*)A->data;
183:   PetscInt     d,i,len,bs = A->rmap.bs;
184:   PetscScalar  *dv;

187:   for (d=0; d<a->nd; d++) {
188:     dv  = a->diagv[d];
189:     if (a->diag[d] > 0) {
190:       dv += bs*bs*a->diag[d];
191:     }
192:     len = a->bdlen[d]*bs*bs;
193:     for (i=0; i<len; i++) dv[i] = 0.0;
194:   }
195:   return(0);
196: }

200: PetscErrorCode MatZeroRows_SeqBDiag(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
201: {
202:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
204:   PetscInt       i,m = A->rmap.N - 1,nz;
205:   PetscScalar    *dd;
206:   PetscScalar    *val;

209:   for (i=0; i<N; i++) {
210:     if (rows[i]<0 || rows[i]>m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"row out of range");
211:     MatGetRow_SeqBDiag(A,rows[i],&nz,PETSC_NULL,&val);
212:     PetscMemzero((void*)val,nz*sizeof(PetscScalar));
213:     MatRestoreRow_SeqBDiag(A,rows[i],&nz,PETSC_NULL,&val);
214:   }
215:   if (diag != 0.0) {
216:     if (a->mainbd == -1) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Main diagonal does not exist");
217:     dd = a->diagv[a->mainbd];
218:     for (i=0; i<N; i++) dd[rows[i]] = diag;
219:   }
220:   MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
221:   MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
222:   return(0);
223: }

227: PetscErrorCode MatGetSubMatrix_SeqBDiag(Mat A,IS isrow,IS iscol,MatReuse scall,Mat *submat)
228: {
230:   PetscInt       nznew,*smap,i,j,oldcols = A->cmap.n;
231:   PetscInt       *irow,*icol,newr,newc,*cwork,nz,bs;
232:   PetscInt       *col;
233:   PetscScalar    *vwork;
234:   PetscScalar    *val;
235:   Mat            newmat;

238:   if (scall == MAT_REUSE_MATRIX) { /* no support for reuse so simply destroy all */
239:     MatDestroy(*submat);
240:   }

242:   ISGetIndices(isrow,&irow);
243:   ISGetIndices(iscol,&icol);
244:   ISGetLocalSize(isrow,&newr);
245:   ISGetLocalSize(iscol,&newc);

247:   PetscMalloc((oldcols+1)*sizeof(PetscInt),&smap);
248:   PetscMalloc((newc+1)*sizeof(PetscInt),&cwork);
249:   PetscMalloc((newc+1)*sizeof(PetscScalar),&vwork);
250:   PetscMemzero((char*)smap,oldcols*sizeof(PetscInt));
251:   for (i=0; i<newc; i++) smap[icol[i]] = i+1;

253:   /* Determine diagonals; then create submatrix */
254:   bs = A->rmap.bs; /* Default block size remains the same */
255:   MatCreate(A->comm,&newmat);
256:   MatSetSizes(newmat,newr,newc,newr,newc);
257:   MatSetType(newmat,A->type_name);
258:   MatSeqBDiagSetPreallocation(newmat,0,bs,PETSC_NULL,PETSC_NULL);

260:   /* Fill new matrix */
261:   for (i=0; i<newr; i++) {
262:     MatGetRow_SeqBDiag(A,irow[i],&nz,&col,&val);
263:     nznew = 0;
264:     for (j=0; j<nz; j++) {
265:       if (smap[col[j]]) {
266:         cwork[nznew]   = smap[col[j]] - 1;
267:         vwork[nznew++] = val[j];
268:       }
269:     }
270:     MatSetValues(newmat,1,&i,nznew,cwork,vwork,INSERT_VALUES);
271:     MatRestoreRow_SeqBDiag(A,i,&nz,&col,&val);
272:   }
273:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
274:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);

276:   /* Free work space */
277:   PetscFree(smap);
278:   PetscFree(cwork);
279:   PetscFree(vwork);
280:   ISRestoreIndices(isrow,&irow);
281:   ISRestoreIndices(iscol,&icol);
282:   *submat = newmat;
283:   return(0);
284: }

288: PetscErrorCode MatGetSubMatrices_SeqBDiag(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[])
289: {
291:   PetscInt       i;

294:   if (scall == MAT_INITIAL_MATRIX) {
295:     PetscMalloc((n+1)*sizeof(Mat),B);
296:   }

298:   for (i=0; i<n; i++) {
299:     MatGetSubMatrix_SeqBDiag(A,irow[i],icol[i],scall,&(*B)[i]);
300:   }
301:   return(0);
302: }

306: PetscErrorCode MatScale_SeqBDiag(Mat inA,PetscScalar alpha)
307: {
308:   Mat_SeqBDiag *a = (Mat_SeqBDiag*)inA->data;
309:   PetscInt          i,bs = inA->rmap.bs;
310:   PetscScalar  oalpha = alpha;
311:   PetscBLASInt one = 1,len;

315:   for (i=0; i<a->nd; i++) {
316:     len = (PetscBLASInt)bs*bs*a->bdlen[i];
317:     if (a->diag[i] > 0) {
318:       BLASscal_(&len,&oalpha,a->diagv[i] + bs*bs*a->diag[i],&one);
319:     } else {
320:       BLASscal_(&len,&oalpha,a->diagv[i],&one);
321:     }
322:   }
323:   PetscLogFlops(a->nz);
324:   return(0);
325: }

329: PetscErrorCode MatDiagonalScale_SeqBDiag(Mat A,Vec ll,Vec rr)
330: {
331:   Mat_SeqBDiag   *a = (Mat_SeqBDiag*)A->data;
332:   PetscScalar    *l,*r,*dv;
334:   PetscInt       d,j,len;
335:   PetscInt       nd = a->nd,bs = A->rmap.bs,diag,m,n;

338:   if (ll) {
339:     VecGetSize(ll,&m);
340:     if (m != A->rmap.N) SETERRQ(PETSC_ERR_ARG_SIZ,"Left scaling vector wrong length");
341:     if (bs == 1) {
342:       VecGetArray(ll,&l);
343:       for (d=0; d<nd; d++) {
344:         dv   = a->diagv[d];
345:         diag = a->diag[d];
346:         len  = a->bdlen[d];
347:         if (diag > 0) for (j=0; j<len; j++) dv[j+diag] *= l[j+diag];
348:         else          for (j=0; j<len; j++) dv[j]      *= l[j];
349:       }
350:       VecRestoreArray(ll,&l);
351:       PetscLogFlops(a->nz);
352:     } else SETERRQ(PETSC_ERR_SUP,"Not yet done for bs>1");
353:   }
354:   if (rr) {
355:     VecGetSize(rr,&n);
356:     if (n != A->cmap.n) SETERRQ(PETSC_ERR_ARG_SIZ,"Right scaling vector wrong length");
357:     if (bs == 1) {
358:       VecGetArray(rr,&r);
359:       for (d=0; d<nd; d++) {
360:         dv   = a->diagv[d];
361:         diag = a->diag[d];
362:         len  = a->bdlen[d];
363:         if (diag > 0) for (j=0; j<len; j++) dv[j+diag] *= r[j];
364:         else          for (j=0; j<len; j++) dv[j]      *= r[j-diag];
365:       }
366:       VecRestoreArray(rr,&r);
367:       PetscLogFlops(a->nz);
368:     } else SETERRQ(PETSC_ERR_SUP,"Not yet done for bs>1");
369:   }
370:   return(0);
371: }

373: static PetscErrorCode MatDuplicate_SeqBDiag(Mat,MatDuplicateOption,Mat *);

377: PetscErrorCode MatSetUpPreallocation_SeqBDiag(Mat A)
378: {

382:    MatSeqBDiagSetPreallocation(A,PETSC_DEFAULT,PETSC_DEFAULT,0,0);
383:   return(0);
384: }

386: /* -------------------------------------------------------------------*/
387: static struct _MatOps MatOps_Values = {MatSetValues_SeqBDiag_N,
388:        MatGetRow_SeqBDiag,
389:        MatRestoreRow_SeqBDiag,
390:        MatMult_SeqBDiag_N,
391: /* 4*/ MatMultAdd_SeqBDiag_N,
392:        MatMultTranspose_SeqBDiag_N,
393:        MatMultTransposeAdd_SeqBDiag_N,
394:        MatSolve_SeqBDiag_N,
395:        0,
396:        0,
397: /*10*/ 0,
398:        0,
399:        0,
400:        MatRelax_SeqBDiag_N,
401:        MatTranspose_SeqBDiag,
402: /*15*/ MatGetInfo_SeqBDiag,
403:        0,
404:        MatGetDiagonal_SeqBDiag_N,
405:        MatDiagonalScale_SeqBDiag,
406:        MatNorm_SeqBDiag,
407: /*20*/ 0,
408:        MatAssemblyEnd_SeqBDiag,
409:        0,
410:        MatSetOption_SeqBDiag,
411:        MatZeroEntries_SeqBDiag,
412: /*25*/ MatZeroRows_SeqBDiag,
413:        0,
414:        MatLUFactorNumeric_SeqBDiag_N,
415:        0,
416:        0,
417: /*30*/ MatSetUpPreallocation_SeqBDiag,
418:        MatILUFactorSymbolic_SeqBDiag,
419:        0,
420:        0,
421:        0,
422: /*35*/ MatDuplicate_SeqBDiag,
423:        0,
424:        0,
425:        MatILUFactor_SeqBDiag,
426:        0,
427: /*40*/ 0,
428:        MatGetSubMatrices_SeqBDiag,
429:        0,
430:        MatGetValues_SeqBDiag_N,
431:        0,
432: /*45*/ 0,
433:        MatScale_SeqBDiag,
434:        0,
435:        0,
436:        0,
437: /*50*/ 0,
438:        0,
439:        0,
440:        0,
441:        0,
442: /*55*/ 0,
443:        0,
444:        0,
445:        0,
446:        0,
447: /*60*/ 0,
448:        MatDestroy_SeqBDiag,
449:        MatView_SeqBDiag,
450:        0,
451:        0,
452: /*65*/ 0,
453:        0,
454:        0,
455:        0,
456:        0,
457: /*70*/ 0,
458:        0,
459:        0,
460:        0,
461:        0,
462: /*75*/ 0,
463:        0,
464:        0,
465:        0,
466:        0,
467: /*80*/ 0,
468:        0,
469:        0,
470:        0,
471:        MatLoad_SeqBDiag,
472: /*85*/ 0,
473:        0,
474:        0,
475:        0,
476:        0,
477: /*90*/ 0,
478:        0,
479:        0,
480:        0,
481:        0,
482: /*95*/ 0,
483:        0,
484:        0,
485:        0};

489: /*@C
490:    MatSeqBDiagSetPreallocation - Sets the nonzero structure and (optionally) arrays.

492:    Collective on MPI_Comm

494:    Input Parameters:
495: +  B - the matrix
496: .  nd - number of block diagonals (optional)
497: .  bs - each element of a diagonal is an bs x bs dense matrix
498: .  diag - optional array of block diagonal numbers (length nd).
499:    For a matrix element A[i,j], where i=row and j=column, the
500:    diagonal number is
501: $     diag = i/bs - j/bs  (integer division)
502:    Set diag=PETSC_NULL on input for PETSc to dynamically allocate memory as 
503:    needed (expensive).
504: -  diagv - pointer to actual diagonals (in same order as diag array), 
505:    if allocated by user.  Otherwise, set diagv=PETSC_NULL on input for PETSc
506:    to control memory allocation.

508:    Options Database Keys:
509: .  -mat_block_size <bs> - Sets blocksize
510: .  -mat_bdiag_diags <s1,s2,s3,...> - Sets diagonal numbers

512:    Notes:
513:    See the users manual for further details regarding this storage format.

515:    Fortran Note:
516:    Fortran programmers cannot set diagv; this value is ignored.

518:    Level: intermediate

520: .keywords: matrix, block, diagonal, sparse

522: .seealso: MatCreate(), MatCreateMPIBDiag(), MatSetValues()
523: @*/
524: PetscErrorCode  MatSeqBDiagSetPreallocation(Mat B,PetscInt nd,PetscInt bs,const PetscInt diag[],PetscScalar *diagv[])
525: {
526:   PetscErrorCode ierr,(*f)(Mat,PetscInt,PetscInt,const PetscInt[],PetscScalar*[]);

529:   PetscObjectQueryFunction((PetscObject)B,"MatSeqBDiagSetPreallocation_C",(void (**)(void))&f);
530:   if (f) {
531:     (*f)(B,nd,bs,diag,diagv);
532:   }
533:   return(0);
534: }

539: PetscErrorCode  MatSeqBDiagSetPreallocation_SeqBDiag(Mat B,PetscInt nd,PetscInt bs,PetscInt *diag,PetscScalar **diagv)
540: {
541:   Mat_SeqBDiag   *b;
543:   PetscInt       i,nda,sizetot, nd2 = 128,idiag[128];
544:   PetscTruth     flg1;


548:   B->preallocated = PETSC_TRUE;
549:   if (bs == PETSC_DEFAULT) bs = 1;
550:   if (!bs) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Blocksize cannot be zero");
551:   if (nd == PETSC_DEFAULT) nd = 0;
552:   PetscOptionsGetInt(PETSC_NULL,"-mat_block_size",&bs,PETSC_NULL);
553:   PetscOptionsGetIntArray(PETSC_NULL,"-mat_bdiag_diags",idiag,&nd2,&flg1);
554:   if (flg1) {
555:     diag = idiag;
556:     nd   = nd2;
557:   }

559:   B->rmap.bs = B->cmap.bs = bs;
560:   PetscMapInitialize(B->comm,&B->rmap);
561:   PetscMapInitialize(B->comm,&B->cmap);

563:   if ((B->cmap.n%bs) || (B->rmap.N%bs)) SETERRQ(PETSC_ERR_ARG_SIZ,"Invalid block size");
564:   if (!nd) nda = nd + 1;
565:   else     nda = nd;
566:   b            = (Mat_SeqBDiag*)B->data;

568:   PetscOptionsHasName(PETSC_NULL,"-mat_no_unroll",&flg1);
569:   if (!flg1) {
570:     switch (bs) {
571:       case 1:
572:         B->ops->setvalues       = MatSetValues_SeqBDiag_1;
573:         B->ops->getvalues       = MatGetValues_SeqBDiag_1;
574:         B->ops->getdiagonal     = MatGetDiagonal_SeqBDiag_1;
575:         B->ops->mult            = MatMult_SeqBDiag_1;
576:         B->ops->multadd         = MatMultAdd_SeqBDiag_1;
577:         B->ops->multtranspose   = MatMultTranspose_SeqBDiag_1;
578:         B->ops->multtransposeadd= MatMultTransposeAdd_SeqBDiag_1;
579:         B->ops->relax           = MatRelax_SeqBDiag_1;
580:         B->ops->solve           = MatSolve_SeqBDiag_1;
581:         B->ops->lufactornumeric = MatLUFactorNumeric_SeqBDiag_1;
582:         break;
583:       case 2:
584:         B->ops->mult            = MatMult_SeqBDiag_2;
585:         B->ops->multadd         = MatMultAdd_SeqBDiag_2;
586:         B->ops->solve           = MatSolve_SeqBDiag_2;
587:         break;
588:       case 3:
589:         B->ops->mult            = MatMult_SeqBDiag_3;
590:         B->ops->multadd         = MatMultAdd_SeqBDiag_3;
591:         B->ops->solve           = MatSolve_SeqBDiag_3;
592:         break;
593:       case 4:
594:         B->ops->mult            = MatMult_SeqBDiag_4;
595:         B->ops->multadd         = MatMultAdd_SeqBDiag_4;
596:         B->ops->solve           = MatSolve_SeqBDiag_4;
597:         break;
598:       case 5:
599:         B->ops->mult            = MatMult_SeqBDiag_5;
600:         B->ops->multadd         = MatMultAdd_SeqBDiag_5;
601:         B->ops->solve           = MatSolve_SeqBDiag_5;
602:         break;
603:    }
604:   }

606:   b->mblock = B->rmap.N/bs;
607:   b->nblock = B->cmap.n/bs;
608:   b->nd     = nd;
609:   B->rmap.bs     = bs;
610:   b->ndim   = 0;
611:   b->mainbd = -1;
612:   b->pivot  = 0;

614:   PetscMalloc(2*nda*sizeof(PetscInt),&b->diag);
615:   b->bdlen  = b->diag + nda;
616:   PetscMalloc((B->cmap.n+1)*sizeof(PetscInt),&b->colloc);
617:   PetscMalloc(nda*sizeof(PetscScalar*),&b->diagv);
618:   sizetot   = 0;

620:   if (diagv) { /* user allocated space */
621:     b->user_alloc = PETSC_TRUE;
622:     for (i=0; i<nd; i++) b->diagv[i] = diagv[i];
623:   } else b->user_alloc = PETSC_FALSE;

625:   for (i=0; i<nd; i++) {
626:     b->diag[i] = diag[i];
627:     if (diag[i] > 0) { /* lower triangular */
628:       b->bdlen[i] = PetscMin(b->nblock,b->mblock - diag[i]);
629:     } else {           /* upper triangular */
630:       b->bdlen[i] = PetscMin(b->mblock,b->nblock + diag[i]);
631:     }
632:     sizetot += b->bdlen[i];
633:   }
634:   sizetot   *= bs*bs;
635:   b->maxnz  =  sizetot;
636:   PetscMalloc((B->cmap.n+1)*sizeof(PetscScalar),&b->dvalue);
637:   PetscLogObjectMemory(B,(nda*(bs+2))*sizeof(PetscInt) + bs*nda*sizeof(PetscScalar)
638:                     + nda*sizeof(PetscScalar*) + sizeof(Mat_SeqBDiag)
639:                     + sizeof(struct _p_Mat) + sizetot*sizeof(PetscScalar));

641:   if (!b->user_alloc) {
642:     for (i=0; i<nd; i++) {
643:       PetscMalloc(bs*bs*b->bdlen[i]*sizeof(PetscScalar),&b->diagv[i]);
644:       PetscMemzero(b->diagv[i],bs*bs*b->bdlen[i]*sizeof(PetscScalar));
645:     }
646:     b->nonew = 0; b->nonew_diag = 0;
647:   } else { /* diagonals are set on input; don't allow dynamic allocation */
648:     b->nonew = 1; b->nonew_diag = 1;
649:   }

651:   /* adjust diagv so one may access rows with diagv[diag][row] for all rows */
652:   for (i=0; i<nd; i++) {
653:     if (diag[i] > 0) {
654:       b->diagv[i] -= bs*bs*diag[i];
655:     }
656:   }

658:   b->nz          = b->maxnz; /* Currently not keeping track of exact count */
659:   b->roworiented = PETSC_TRUE;
660:   B->info.nz_unneeded = (double)b->maxnz;
661:   return(0);
662: }

667: static PetscErrorCode MatDuplicate_SeqBDiag(Mat A,MatDuplicateOption cpvalues,Mat *matout)
668: {
669:   Mat_SeqBDiag   *newmat,*a = (Mat_SeqBDiag*)A->data;
671:   PetscInt       i,len,diag,bs = A->rmap.bs;
672:   Mat            mat;

675:   MatCreate(A->comm,matout);
676:   MatSetSizes(*matout,A->rmap.N,A->cmap.n,A->rmap.N,A->cmap.n);
677:   MatSetType(*matout,A->type_name);
678:   MatSeqBDiagSetPreallocation(*matout,a->nd,bs,a->diag,PETSC_NULL);

680:   /* Copy contents of diagonals */
681:   mat = *matout;
682:   newmat = (Mat_SeqBDiag*)mat->data;
683:   if (cpvalues == MAT_COPY_VALUES) {
684:     for (i=0; i<a->nd; i++) {
685:       len = a->bdlen[i] * bs * bs * sizeof(PetscScalar);
686:       diag = a->diag[i];
687:       if (diag > 0) {
688:         PetscMemcpy(newmat->diagv[i]+bs*bs*diag,a->diagv[i]+bs*bs*diag,len);
689:       } else {
690:         PetscMemcpy(newmat->diagv[i],a->diagv[i],len);
691:       }
692:     }
693:   }
694:   MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);
695:   MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);
696:   return(0);
697: }

701: PetscErrorCode MatLoad_SeqBDiag(PetscViewer viewer, MatType type,Mat *A)
702: {
703:   Mat            B;
705:   PetscMPIInt    size;
706:   int            fd;
707:   PetscInt       *scols,i,nz,header[4],nd = 128;
708:   PetscInt       bs,*rowlengths = 0,M,N,*cols,extra_rows,*diag = 0;
709:   PetscInt       idiag[128];
710:   PetscScalar    *vals,*svals;
711:   MPI_Comm       comm;
712:   PetscTruth     flg;
713: 
715:   PetscObjectGetComm((PetscObject)viewer,&comm);
716:   MPI_Comm_size(comm,&size);
717:   if (size > 1) SETERRQ(PETSC_ERR_ARG_SIZ,"view must have one processor");
718:   PetscViewerBinaryGetDescriptor(viewer,&fd);
719:   PetscBinaryRead(fd,header,4,PETSC_INT);
720:   if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
721:   M = header[1]; N = header[2]; nz = header[3];
722:   if (M != N) SETERRQ(PETSC_ERR_SUP,"Can only load square matrices");
723:   if (header[3] < 0) {
724:     SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Matrix stored in special format, cannot load as SeqBDiag");
725:   }

727:   /* 
728:      This code adds extra rows to make sure the number of rows is 
729:     divisible by the blocksize
730:   */
731:   bs = 1;
732:   PetscOptionsGetInt(PETSC_NULL,"-matload_block_size",&bs,PETSC_NULL);
733:   extra_rows = bs - M + bs*(M/bs);
734:   if (extra_rows == bs) extra_rows = 0;
735:   if (extra_rows) {
736:     PetscInfo(0,"Padding loaded matrix to match blocksize\n");
737:   }

739:   /* read row lengths */
740:   PetscMalloc((M+extra_rows)*sizeof(PetscInt),&rowlengths);
741:   PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
742:   for (i=0; i<extra_rows; i++) rowlengths[M+i] = 1;

744:   /* load information about diagonals */
745:   PetscOptionsGetIntArray(PETSC_NULL,"-matload_bdiag_diags",idiag,&nd,&flg);
746:   if (flg) {
747:     diag = idiag;
748:   }

750:   /* create our matrix */
751:   MatCreate(comm,A);
752:   MatSetSizes(*A,M+extra_rows,M+extra_rows,M+extra_rows,M+extra_rows);
753:   MatSetType(*A,type);
754:   MatSeqBDiagSetPreallocation(*A,nd,bs,diag,PETSC_NULL);
755:   B = *A;

757:   /* read column indices and nonzeros */
758:   PetscMalloc(nz*sizeof(PetscInt),&scols);
759:   cols = scols;
760:   PetscBinaryRead(fd,cols,nz,PETSC_INT);
761:   PetscMalloc(nz*sizeof(PetscScalar),&svals);
762:   vals = svals;
763:   PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
764:   /* insert into matrix */

766:   for (i=0; i<M; i++) {
767:     MatSetValues(B,1,&i,rowlengths[i],scols,svals,INSERT_VALUES);
768:     scols += rowlengths[i]; svals += rowlengths[i];
769:   }
770:   vals[0] = 1.0;
771:   for (i=M; i<M+extra_rows; i++) {
772:     MatSetValues(B,1,&i,1,&i,vals,INSERT_VALUES);
773:   }

775:   PetscFree(cols);
776:   PetscFree(vals);
777:   PetscFree(rowlengths);

779:   MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
780:   MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
781:   return(0);
782: }

784: /*MC
785:    MATSEQBDIAG - MATSEQBDIAG = "seqbdiag" - A matrix type to be used for sequential block diagonal matrices.

787:    Options Database Keys:
788: . -mat_type seqbdiag - sets the matrix type to "seqbdiag" during a call to MatSetFromOptions()

790:   Level: beginner

792: .seealso: MatCreateSeqBDiag
793: M*/

798: PetscErrorCode  MatCreate_SeqBDiag(Mat B)
799: {
800:   Mat_SeqBDiag   *b;
802:   PetscMPIInt    size;

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


809:   PetscNew(Mat_SeqBDiag,&b);
810:   B->data         = (void*)b;
811:   PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));
812:   B->factor       = 0;
813:   B->mapping      = 0;

815:   b->ndim   = 0;
816:   b->mainbd = -1;
817:   b->pivot  = 0;

819:   b->roworiented = PETSC_TRUE;
820:   PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqBDiagSetPreallocation_C",
821:                                     "MatSeqBDiagSetPreallocation_SeqBDiag",
822:                                      MatSeqBDiagSetPreallocation_SeqBDiag);

824:   PetscObjectChangeTypeName((PetscObject)B,MATSEQBDIAG);
825:   return(0);
826: }

831: /*@C
832:    MatCreateSeqBDiag - Creates a sequential block diagonal matrix.

834:    Collective on MPI_Comm

836:    Input Parameters:
837: +  comm - MPI communicator, set to PETSC_COMM_SELF
838: .  m - number of rows
839: .  n - number of columns
840: .  nd - number of block diagonals (optional)
841: .  bs - each element of a diagonal is an bs x bs dense matrix
842: .  diag - optional array of block diagonal numbers (length nd).
843:    For a matrix element A[i,j], where i=row and j=column, the
844:    diagonal number is
845: $     diag = i/bs - j/bs  (integer division)
846:    Set diag=PETSC_NULL on input for PETSc to dynamically allocate memory as 
847:    needed (expensive).
848: -  diagv - pointer to actual diagonals (in same order as diag array), 
849:    if allocated by user.  Otherwise, set diagv=PETSC_NULL on input for PETSc
850:    to control memory allocation.

852:    Output Parameters:
853: .  A - the matrix

855:    Options Database Keys:
856: .  -mat_block_size <bs> - Sets blocksize
857: .  -mat_bdiag_diags <s1,s2,s3,...> - Sets diagonal numbers

859:    Notes:
860:    See the users manual for further details regarding this storage format.

862:    Fortran Note:
863:    Fortran programmers cannot set diagv; this value is ignored.

865:    Level: intermediate

867: .keywords: matrix, block, diagonal, sparse

869: .seealso: MatCreate(), MatCreateMPIBDiag(), MatSetValues()
870: @*/
871: PetscErrorCode  MatCreateSeqBDiag(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt nd,PetscInt bs,const PetscInt diag[],PetscScalar *diagv[],Mat *A)
872: {

876:   MatCreate(comm,A);
877:   MatSetSizes(*A,m,n,m,n);
878:   MatSetType(*A,MATSEQBDIAG);
879:   MatSeqBDiagSetPreallocation(*A,nd,bs,diag,diagv);
880:   return(0);
881: }