Date: 2013-07-02T14:43:42+00:00

Actual source code: blockmat.c
petsc-3.4.2 2013-07-02

      2: /*
      3:    This provides a matrix that consists of Mats
      4: */

      6: #include <petsc-private/matimpl.h>              /*I "petscmat.h" I*/
      7: #include <../src/mat/impls/baij/seq/baij.h>    /* use the common AIJ data-structure */

      9: typedef struct {
     10:   SEQAIJHEADER(Mat);
     11:   SEQBAIJHEADER;
     12:   Mat *diags;

     14:   Vec left,right,middle,workb;                 /* dummy vectors to perform local parts of product */
     15: } Mat_BlockMat;

     17: extern PetscErrorCode  MatBlockMatSetPreallocation(Mat,PetscInt,PetscInt,const PetscInt*);

     21: PetscErrorCode MatSOR_BlockMat_Symmetric(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal fshift,PetscInt its,PetscInt lits,Vec xx)
     22: {
     23:   Mat_BlockMat      *a = (Mat_BlockMat*)A->data;
     24:   PetscScalar       *x;
     25:   const Mat         *v;
     26:   const PetscScalar *b;
     27:   PetscErrorCode    ierr;
     28:   PetscInt          n = A->cmap->n,i,mbs = n/A->rmap->bs,j,bs = A->rmap->bs;
     29:   const PetscInt    *idx;
     30:   IS                row,col;
     31:   MatFactorInfo     info;
     32:   Vec               left = a->left,right = a->right, middle = a->middle;
     33:   Mat               *diag;

     36:   its = its*lits;
     37:   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
     38:   if (flag & SOR_EISENSTAT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for Eisenstat");
     39:   if (omega != 1.0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for omega not equal to 1.0");
     40:   if (fshift) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for fshift");
     41:   if ((flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) && !(flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP)) {
     42:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot do backward sweep without forward sweep");
     43:   }

     45:   if (!a->diags) {
     46:     PetscMalloc(mbs*sizeof(Mat),&a->diags);
     47:     MatFactorInfoInitialize(&info);
     48:     for (i=0; i<mbs; i++) {
     49:       MatGetOrdering(a->a[a->diag[i]], MATORDERINGND,&row,&col);
     50:       MatCholeskyFactorSymbolic(a->diags[i],a->a[a->diag[i]],row,&info);
     51:       MatCholeskyFactorNumeric(a->diags[i],a->a[a->diag[i]],&info);
     52:       ISDestroy(&row);
     53:       ISDestroy(&col);
     54:     }
     55:     VecDuplicate(bb,&a->workb);
     56:   }
     57:   diag = a->diags;

     59:   VecSet(xx,0.0);
     60:   VecGetArray(xx,&x);
     61:   /* copy right hand side because it must be modified during iteration */
     62:   VecCopy(bb,a->workb);
     63:   VecGetArrayRead(a->workb,&b);

     65:   /* need to add code for when initial guess is zero, see MatSOR_SeqAIJ */
     66:   while (its--) {
     67:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {

     69:       for (i=0; i<mbs; i++) {
     70:         n   = a->i[i+1] - a->i[i] - 1;
     71:         idx = a->j + a->i[i] + 1;
     72:         v   = a->a + a->i[i] + 1;

     74:         VecSet(left,0.0);
     75:         for (j=0; j<n; j++) {
     76:           VecPlaceArray(right,x + idx[j]*bs);
     77:           MatMultAdd(v[j],right,left,left);
     78:           VecResetArray(right);
     79:         }
     80:         VecPlaceArray(right,b + i*bs);
     81:         VecAYPX(left,-1.0,right);
     82:         VecResetArray(right);

     84:         VecPlaceArray(right,x + i*bs);
     85:         MatSolve(diag[i],left,right);

     87:         /* now adjust right hand side, see MatSOR_SeqSBAIJ */
     88:         for (j=0; j<n; j++) {
     89:           MatMultTranspose(v[j],right,left);
     90:           VecPlaceArray(middle,b + idx[j]*bs);
     91:           VecAXPY(middle,-1.0,left);
     92:           VecResetArray(middle);
     93:         }
     94:         VecResetArray(right);

     96:       }
     97:     }
     98:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {

    100:       for (i=mbs-1; i>=0; i--) {
    101:         n   = a->i[i+1] - a->i[i] - 1;
    102:         idx = a->j + a->i[i] + 1;
    103:         v   = a->a + a->i[i] + 1;

    105:         VecSet(left,0.0);
    106:         for (j=0; j<n; j++) {
    107:           VecPlaceArray(right,x + idx[j]*bs);
    108:           MatMultAdd(v[j],right,left,left);
    109:           VecResetArray(right);
    110:         }
    111:         VecPlaceArray(right,b + i*bs);
    112:         VecAYPX(left,-1.0,right);
    113:         VecResetArray(right);

    115:         VecPlaceArray(right,x + i*bs);
    116:         MatSolve(diag[i],left,right);
    117:         VecResetArray(right);

    119:       }
    120:     }
    121:   }
    122:   VecRestoreArray(xx,&x);
    123:   VecRestoreArrayRead(a->workb,&b);
    124:   return(0);
    125: }

    129: PetscErrorCode MatSOR_BlockMat(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal fshift,PetscInt its,PetscInt lits,Vec xx)
    130: {
    131:   Mat_BlockMat      *a = (Mat_BlockMat*)A->data;
    132:   PetscScalar       *x;
    133:   const Mat         *v;
    134:   const PetscScalar *b;
    135:   PetscErrorCode    ierr;
    136:   PetscInt          n = A->cmap->n,i,mbs = n/A->rmap->bs,j,bs = A->rmap->bs;
    137:   const PetscInt    *idx;
    138:   IS                row,col;
    139:   MatFactorInfo     info;
    140:   Vec               left = a->left,right = a->right;
    141:   Mat               *diag;

    144:   its = its*lits;
    145:   if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
    146:   if (flag & SOR_EISENSTAT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for Eisenstat");
    147:   if (omega != 1.0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for omega not equal to 1.0");
    148:   if (fshift) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for fshift");

    150:   if (!a->diags) {
    151:     PetscMalloc(mbs*sizeof(Mat),&a->diags);
    152:     MatFactorInfoInitialize(&info);
    153:     for (i=0; i<mbs; i++) {
    154:       MatGetOrdering(a->a[a->diag[i]], MATORDERINGND,&row,&col);
    155:       MatLUFactorSymbolic(a->diags[i],a->a[a->diag[i]],row,col,&info);
    156:       MatLUFactorNumeric(a->diags[i],a->a[a->diag[i]],&info);
    157:       ISDestroy(&row);
    158:       ISDestroy(&col);
    159:     }
    160:   }
    161:   diag = a->diags;

    163:   VecSet(xx,0.0);
    164:   VecGetArray(xx,&x);
    165:   VecGetArrayRead(bb,&b);

    167:   /* need to add code for when initial guess is zero, see MatSOR_SeqAIJ */
    168:   while (its--) {
    169:     if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {

    171:       for (i=0; i<mbs; i++) {
    172:         n   = a->i[i+1] - a->i[i];
    173:         idx = a->j + a->i[i];
    174:         v   = a->a + a->i[i];

    176:         VecSet(left,0.0);
    177:         for (j=0; j<n; j++) {
    178:           if (idx[j] != i) {
    179:             VecPlaceArray(right,x + idx[j]*bs);
    180:             MatMultAdd(v[j],right,left,left);
    181:             VecResetArray(right);
    182:           }
    183:         }
    184:         VecPlaceArray(right,b + i*bs);
    185:         VecAYPX(left,-1.0,right);
    186:         VecResetArray(right);

    188:         VecPlaceArray(right,x + i*bs);
    189:         MatSolve(diag[i],left,right);
    190:         VecResetArray(right);
    191:       }
    192:     }
    193:     if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {

    195:       for (i=mbs-1; i>=0; i--) {
    196:         n   = a->i[i+1] - a->i[i];
    197:         idx = a->j + a->i[i];
    198:         v   = a->a + a->i[i];

    200:         VecSet(left,0.0);
    201:         for (j=0; j<n; j++) {
    202:           if (idx[j] != i) {
    203:             VecPlaceArray(right,x + idx[j]*bs);
    204:             MatMultAdd(v[j],right,left,left);
    205:             VecResetArray(right);
    206:           }
    207:         }
    208:         VecPlaceArray(right,b + i*bs);
    209:         VecAYPX(left,-1.0,right);
    210:         VecResetArray(right);

    212:         VecPlaceArray(right,x + i*bs);
    213:         MatSolve(diag[i],left,right);
    214:         VecResetArray(right);

    216:       }
    217:     }
    218:   }
    219:   VecRestoreArray(xx,&x);
    220:   VecRestoreArrayRead(bb,&b);
    221:   return(0);
    222: }

    226: PetscErrorCode MatSetValues_BlockMat(Mat A,PetscInt m,const PetscInt im[],PetscInt n,const PetscInt in[],const PetscScalar v[],InsertMode is)
    227: {
    228:   Mat_BlockMat   *a = (Mat_BlockMat*)A->data;
    229:   PetscInt       *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax,N,lastcol = -1;
    230:   PetscInt       *imax=a->imax,*ai=a->i,*ailen=a->ilen;
    231:   PetscInt       *aj  =a->j,nonew=a->nonew,bs=A->rmap->bs,brow,bcol;
    233:   PetscInt       ridx,cidx;
    234:   PetscBool      roworiented=a->roworiented;
    235:   MatScalar      value;
    236:   Mat            *ap,*aa = a->a;

    240:   for (k=0; k<m; k++) { /* loop over added rows */
    241:     row  = im[k];
    242:     brow = row/bs;
    243:     if (row < 0) continue;
    244: #if defined(PETSC_USE_DEBUG)
    245:     if (row >= A->rmap->N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",row,A->rmap->N-1);
    246: #endif
    247:     rp   = aj + ai[brow];
    248:     ap   = aa + ai[brow];
    249:     rmax = imax[brow];
    250:     nrow = ailen[brow];
    251:     low  = 0;
    252:     high = nrow;
    253:     for (l=0; l<n; l++) { /* loop over added columns */
    254:       if (in[l] < 0) continue;
    255: #if defined(PETSC_USE_DEBUG)
    256:       if (in[l] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",in[l],A->cmap->n-1);
    257: #endif
    258:       col = in[l]; bcol = col/bs;
    259:       if (A->symmetric && brow > bcol) continue;
    260:       ridx = row % bs; cidx = col % bs;
    261:       if (roworiented) value = v[l + k*n];
    262:       else value = v[k + l*m];

    264:       if (col <= lastcol) low = 0;
    265:       else high = nrow;
    266:       lastcol = col;
    267:       while (high-low > 7) {
    268:         t = (low+high)/2;
    269:         if (rp[t] > bcol) high = t;
    270:         else              low  = t;
    271:       }
    272:       for (i=low; i<high; i++) {
    273:         if (rp[i] > bcol) break;
    274:         if (rp[i] == bcol) goto noinsert1;
    275:       }
    276:       if (nonew == 1) goto noinsert1;
    277:       if (nonew == -1) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Inserting a new nonzero (%D, %D) in the matrix", row, col);
    278:       MatSeqXAIJReallocateAIJ(A,a->mbs,1,nrow,brow,bcol,rmax,aa,ai,aj,rp,ap,imax,nonew,Mat);
    279:       N = nrow++ - 1; high++;
    280:       /* shift up all the later entries in this row */
    281:       for (ii=N; ii>=i; ii--) {
    282:         rp[ii+1] = rp[ii];
    283:         ap[ii+1] = ap[ii];
    284:       }
    285:       if (N>=i) ap[i] = 0;
    286:       rp[i] = bcol;
    287:       a->nz++;
    288: noinsert1:;
    289:       if (!*(ap+i)) {
    290:         MatCreateSeqAIJ(PETSC_COMM_SELF,bs,bs,0,0,ap+i);
    291:       }
    292:       MatSetValues(ap[i],1,&ridx,1,&cidx,&value,is);
    293:       low  = i;
    294:     }
    295:     ailen[brow] = nrow;
    296:   }
    297:   A->same_nonzero = PETSC_FALSE;
    298:   return(0);
    299: }

    303: PetscErrorCode MatLoad_BlockMat(Mat newmat, PetscViewer viewer)
    304: {
    305:   PetscErrorCode    ierr;
    306:   Mat               tmpA;
    307:   PetscInt          i,j,m,n,bs = 1,ncols,*lens,currentcol,mbs,**ii,*ilens,nextcol,*llens,cnt = 0;
    308:   const PetscInt    *cols;
    309:   const PetscScalar *values;
    310:   PetscBool         flg = PETSC_FALSE,notdone;
    311:   Mat_SeqAIJ        *a;
    312:   Mat_BlockMat      *amat;

    315:   MatCreate(PETSC_COMM_SELF,&tmpA);
    316:   MatSetType(tmpA,MATSEQAIJ);
    317:   MatLoad_SeqAIJ(tmpA,viewer);

    319:   MatGetLocalSize(tmpA,&m,&n);
    320:   PetscOptionsBegin(PETSC_COMM_SELF,NULL,"Options for loading BlockMat matrix 1","Mat");
    321:   PetscOptionsInt("-matload_block_size","Set the blocksize used to store the matrix","MatLoad",bs,&bs,NULL);
    322:   PetscOptionsBool("-matload_symmetric","Store the matrix as symmetric","MatLoad",flg,&flg,NULL);
    323:   PetscOptionsEnd();

    325:   /* Determine number of nonzero blocks for each block row */
    326:   a    = (Mat_SeqAIJ*) tmpA->data;
    327:   mbs  = m/bs;
    328:   PetscMalloc3(mbs,PetscInt,&lens,bs,PetscInt*,&ii,bs,PetscInt,&ilens);
    329:   PetscMemzero(lens,mbs*sizeof(PetscInt));

    331:   for (i=0; i<mbs; i++) {
    332:     for (j=0; j<bs; j++) {
    333:       ii[j]    = a->j + a->i[i*bs + j];
    334:       ilens[j] = a->i[i*bs + j + 1] - a->i[i*bs + j];
    335:     }

    337:     currentcol = -1;
    338:     notdone    = PETSC_TRUE;
    339:     while (PETSC_TRUE) {
    340:       notdone = PETSC_FALSE;
    341:       nextcol = 1000000000;
    342:       for (j=0; j<bs; j++) {
    343:         while ((ilens[j] > 0 && ii[j][0]/bs <= currentcol)) {
    344:           ii[j]++;
    345:           ilens[j]--;
    346:         }
    347:         if (ilens[j] > 0) {
    348:           notdone = PETSC_TRUE;
    349:           nextcol = PetscMin(nextcol,ii[j][0]/bs);
    350:         }
    351:       }
    352:       if (!notdone) break;
    353:       if (!flg || (nextcol >= i)) lens[i]++;
    354:       currentcol = nextcol;
    355:     }
    356:   }

    358:   if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) {
    359:     MatSetSizes(newmat,m,n,PETSC_DETERMINE,PETSC_DETERMINE);
    360:   }
    361:   MatBlockMatSetPreallocation(newmat,bs,0,lens);
    362:   if (flg) {
    363:     MatSetOption(newmat,MAT_SYMMETRIC,PETSC_TRUE);
    364:   }
    365:   amat = (Mat_BlockMat*)(newmat)->data;

    367:   /* preallocate the submatrices */
    368:   PetscMalloc(bs*sizeof(PetscInt),&llens);
    369:   for (i=0; i<mbs; i++) { /* loops for block rows */
    370:     for (j=0; j<bs; j++) {
    371:       ii[j]    = a->j + a->i[i*bs + j];
    372:       ilens[j] = a->i[i*bs + j + 1] - a->i[i*bs + j];
    373:     }

    375:     currentcol = 1000000000;
    376:     for (j=0; j<bs; j++) { /* loop over rows in block finding first nonzero block */
    377:       if (ilens[j] > 0) {
    378:         currentcol = PetscMin(currentcol,ii[j][0]/bs);
    379:       }
    380:     }

    382:     notdone = PETSC_TRUE;
    383:     while (PETSC_TRUE) {  /* loops over blocks in block row */

    385:       notdone = PETSC_FALSE;
    386:       nextcol = 1000000000;
    387:       PetscMemzero(llens,bs*sizeof(PetscInt));
    388:       for (j=0; j<bs; j++) { /* loop over rows in block */
    389:         while ((ilens[j] > 0 && ii[j][0]/bs <= currentcol)) { /* loop over columns in row */
    390:           ii[j]++;
    391:           ilens[j]--;
    392:           llens[j]++;
    393:         }
    394:         if (ilens[j] > 0) {
    395:           notdone = PETSC_TRUE;
    396:           nextcol = PetscMin(nextcol,ii[j][0]/bs);
    397:         }
    398:       }
    399:       if (cnt >= amat->maxnz) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Number of blocks found greater than expected %D",cnt);
    400:       if (!flg || currentcol >= i) {
    401:         amat->j[cnt] = currentcol;
    402:         MatCreateSeqAIJ(PETSC_COMM_SELF,bs,bs,0,llens,amat->a+cnt++);
    403:       }

    405:       if (!notdone) break;
    406:       currentcol = nextcol;
    407:     }
    408:     amat->ilen[i] = lens[i];
    409:   }

    411:   PetscFree3(lens,ii,ilens);
    412:   PetscFree(llens);

    414:   /* copy over the matrix, one row at a time */
    415:   for (i=0; i<m; i++) {
    416:     MatGetRow(tmpA,i,&ncols,&cols,&values);
    417:     MatSetValues(newmat,1,&i,ncols,cols,values,INSERT_VALUES);
    418:     MatRestoreRow(tmpA,i,&ncols,&cols,&values);
    419:   }
    420:   MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);
    421:   MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);
    422:   return(0);
    423: }

    427: PetscErrorCode MatView_BlockMat(Mat A,PetscViewer viewer)
    428: {
    429:   Mat_BlockMat      *a = (Mat_BlockMat*)A->data;
    430:   PetscErrorCode    ierr;
    431:   const char        *name;
    432:   PetscViewerFormat format;

    435:   PetscObjectGetName((PetscObject)A,&name);
    436:   PetscViewerGetFormat(viewer,&format);
    437:   if (format == PETSC_VIEWER_ASCII_FACTOR_INFO || format == PETSC_VIEWER_ASCII_INFO) {
    438:     PetscViewerASCIIPrintf(viewer,"Nonzero block matrices = %D \n",a->nz);
    439:     if (A->symmetric) {
    440:       PetscViewerASCIIPrintf(viewer,"Only upper triangular part of symmetric matrix is stored\n");
    441:     }
    442:   }
    443:   return(0);
    444: }

    448: PetscErrorCode MatDestroy_BlockMat(Mat mat)
    449: {
    451:   Mat_BlockMat   *bmat = (Mat_BlockMat*)mat->data;
    452:   PetscInt       i;

    455:   VecDestroy(&bmat->right);
    456:   VecDestroy(&bmat->left);
    457:   VecDestroy(&bmat->middle);
    458:   VecDestroy(&bmat->workb);
    459:   if (bmat->diags) {
    460:     for (i=0; i<mat->rmap->n/mat->rmap->bs; i++) {
    461:       MatDestroy(&bmat->diags[i]);
    462:     }
    463:   }
    464:   if (bmat->a) {
    465:     for (i=0; i<bmat->nz; i++) {
    466:       MatDestroy(&bmat->a[i]);
    467:     }
    468:   }
    469:   MatSeqXAIJFreeAIJ(mat,(PetscScalar**)&bmat->a,&bmat->j,&bmat->i);
    470:   PetscFree(mat->data);
    471:   return(0);
    472: }

    476: PetscErrorCode MatMult_BlockMat(Mat A,Vec x,Vec y)
    477: {
    478:   Mat_BlockMat   *bmat = (Mat_BlockMat*)A->data;
    480:   PetscScalar    *xx,*yy;
    481:   PetscInt       *aj,i,*ii,jrow,m = A->rmap->n/A->rmap->bs,bs = A->rmap->bs,n,j;
    482:   Mat            *aa;

    485:   /*
    486:      Standard CSR multiply except each entry is a Mat
    487:   */
    488:   VecGetArray(x,&xx);

    490:   VecSet(y,0.0);
    491:   VecGetArray(y,&yy);
    492:   aj   = bmat->j;
    493:   aa   = bmat->a;
    494:   ii   = bmat->i;
    495:   for (i=0; i<m; i++) {
    496:     jrow = ii[i];
    497:     VecPlaceArray(bmat->left,yy + bs*i);
    498:     n    = ii[i+1] - jrow;
    499:     for (j=0; j<n; j++) {
    500:       VecPlaceArray(bmat->right,xx + bs*aj[jrow]);
    501:       MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);
    502:       VecResetArray(bmat->right);
    503:       jrow++;
    504:     }
    505:     VecResetArray(bmat->left);
    506:   }
    507:   VecRestoreArray(x,&xx);
    508:   VecRestoreArray(y,&yy);
    509:   return(0);
    510: }

    514: PetscErrorCode MatMult_BlockMat_Symmetric(Mat A,Vec x,Vec y)
    515: {
    516:   Mat_BlockMat   *bmat = (Mat_BlockMat*)A->data;
    518:   PetscScalar    *xx,*yy;
    519:   PetscInt       *aj,i,*ii,jrow,m = A->rmap->n/A->rmap->bs,bs = A->rmap->bs,n,j;
    520:   Mat            *aa;

    523:   /*
    524:      Standard CSR multiply except each entry is a Mat
    525:   */
    526:   VecGetArray(x,&xx);

    528:   VecSet(y,0.0);
    529:   VecGetArray(y,&yy);
    530:   aj   = bmat->j;
    531:   aa   = bmat->a;
    532:   ii   = bmat->i;
    533:   for (i=0; i<m; i++) {
    534:     jrow = ii[i];
    535:     n    = ii[i+1] - jrow;
    536:     VecPlaceArray(bmat->left,yy + bs*i);
    537:     VecPlaceArray(bmat->middle,xx + bs*i);
    538:     /* if we ALWAYS required a diagonal entry then could remove this if test */
    539:     if (aj[jrow] == i) {
    540:       VecPlaceArray(bmat->right,xx + bs*aj[jrow]);
    541:       MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);
    542:       VecResetArray(bmat->right);
    543:       jrow++;
    544:       n--;
    545:     }
    546:     for (j=0; j<n; j++) {
    547:       VecPlaceArray(bmat->right,xx + bs*aj[jrow]);            /* upper triangular part */
    548:       MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);
    549:       VecResetArray(bmat->right);

    551:       VecPlaceArray(bmat->right,yy + bs*aj[jrow]);            /* lower triangular part */
    552:       MatMultTransposeAdd(aa[jrow],bmat->middle,bmat->right,bmat->right);
    553:       VecResetArray(bmat->right);
    554:       jrow++;
    555:     }
    556:     VecResetArray(bmat->left);
    557:     VecResetArray(bmat->middle);
    558:   }
    559:   VecRestoreArray(x,&xx);
    560:   VecRestoreArray(y,&yy);
    561:   return(0);
    562: }

    566: PetscErrorCode MatMultAdd_BlockMat(Mat A,Vec x,Vec y,Vec z)
    567: {
    569:   return(0);
    570: }

    574: PetscErrorCode MatMultTranspose_BlockMat(Mat A,Vec x,Vec y)
    575: {
    577:   return(0);
    578: }

    582: PetscErrorCode MatMultTransposeAdd_BlockMat(Mat A,Vec x,Vec y,Vec z)
    583: {
    585:   return(0);
    586: }

    588: /*
    589:      Adds diagonal pointers to sparse matrix structure.
    590: */
    593: PetscErrorCode MatMarkDiagonal_BlockMat(Mat A)
    594: {
    595:   Mat_BlockMat   *a = (Mat_BlockMat*)A->data;
    597:   PetscInt       i,j,mbs = A->rmap->n/A->rmap->bs;

    600:   if (!a->diag) {
    601:     PetscMalloc(mbs*sizeof(PetscInt),&a->diag);
    602:   }
    603:   for (i=0; i<mbs; i++) {
    604:     a->diag[i] = a->i[i+1];
    605:     for (j=a->i[i]; j<a->i[i+1]; j++) {
    606:       if (a->j[j] == i) {
    607:         a->diag[i] = j;
    608:         break;
    609:       }
    610:     }
    611:   }
    612:   return(0);
    613: }

    617: PetscErrorCode MatGetSubMatrix_BlockMat(Mat A,IS isrow,IS iscol,MatReuse scall,Mat *B)
    618: {
    619:   Mat_BlockMat   *a = (Mat_BlockMat*)A->data;
    620:   Mat_SeqAIJ     *c;
    622:   PetscInt       i,k,first,step,lensi,nrows,ncols;
    623:   PetscInt       *j_new,*i_new,*aj = a->j,*ailen = a->ilen;
    624:   PetscScalar    *a_new;
    625:   Mat            C,*aa = a->a;
    626:   PetscBool      stride,equal;

    629:   ISEqual(isrow,iscol,&equal);
    630:   if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only for idential column and row indices");
    631:   PetscObjectTypeCompare((PetscObject)iscol,ISSTRIDE,&stride);
    632:   if (!stride) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only for stride indices");
    633:   ISStrideGetInfo(iscol,&first,&step);
    634:   if (step != A->rmap->bs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can only select one entry from each block");

    636:   ISGetLocalSize(isrow,&nrows);
    637:   ncols = nrows;

    639:   /* create submatrix */
    640:   if (scall == MAT_REUSE_MATRIX) {
    641:     PetscInt n_cols,n_rows;
    642:     C    = *B;
    643:     MatGetSize(C,&n_rows,&n_cols);
    644:     if (n_rows != nrows || n_cols != ncols) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Reused submatrix wrong size");
    645:     MatZeroEntries(C);
    646:   } else {
    647:     MatCreate(PetscObjectComm((PetscObject)A),&C);
    648:     MatSetSizes(C,nrows,ncols,PETSC_DETERMINE,PETSC_DETERMINE);
    649:     if (A->symmetric) {
    650:       MatSetType(C,MATSEQSBAIJ);
    651:     } else {
    652:       MatSetType(C,MATSEQAIJ);
    653:     }
    654:     MatSeqAIJSetPreallocation(C,0,ailen);
    655:     MatSeqSBAIJSetPreallocation(C,1,0,ailen);
    656:   }
    657:   c = (Mat_SeqAIJ*)C->data;

    659:   /* loop over rows inserting into submatrix */
    660:   a_new = c->a;
    661:   j_new = c->j;
    662:   i_new = c->i;

    664:   for (i=0; i<nrows; i++) {
    665:     lensi = ailen[i];
    666:     for (k=0; k<lensi; k++) {
    667:       *j_new++ = *aj++;
    668:       MatGetValue(*aa++,first,first,a_new++);
    669:     }
    670:     i_new[i+1] = i_new[i] + lensi;
    671:     c->ilen[i] = lensi;
    672:   }

    674:   MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);
    675:   MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);
    676:   *B   = C;
    677:   return(0);
    678: }

    682: PetscErrorCode MatAssemblyEnd_BlockMat(Mat A,MatAssemblyType mode)
    683: {
    684:   Mat_BlockMat   *a = (Mat_BlockMat*)A->data;
    686:   PetscInt       fshift = 0,i,j,*ai = a->i,*aj = a->j,*imax = a->imax;
    687:   PetscInt       m      = a->mbs,*ip,N,*ailen = a->ilen,rmax = 0;
    688:   Mat            *aa    = a->a,*ap;

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

    693:   if (m) rmax = ailen[0]; /* determine row with most nonzeros */
    694:   for (i=1; i<m; i++) {
    695:     /* move each row back by the amount of empty slots (fshift) before it*/
    696:     fshift += imax[i-1] - ailen[i-1];
    697:     rmax    = PetscMax(rmax,ailen[i]);
    698:     if (fshift) {
    699:       ip = aj + ai[i];
    700:       ap = aa + ai[i];
    701:       N  = ailen[i];
    702:       for (j=0; j<N; j++) {
    703:         ip[j-fshift] = ip[j];
    704:         ap[j-fshift] = ap[j];
    705:       }
    706:     }
    707:     ai[i] = ai[i-1] + ailen[i-1];
    708:   }
    709:   if (m) {
    710:     fshift += imax[m-1] - ailen[m-1];
    711:     ai[m]   = ai[m-1] + ailen[m-1];
    712:   }
    713:   /* reset ilen and imax for each row */
    714:   for (i=0; i<m; i++) {
    715:     ailen[i] = imax[i] = ai[i+1] - ai[i];
    716:   }
    717:   a->nz = ai[m];
    718:   for (i=0; i<a->nz; i++) {
    719: #if defined(PETSC_USE_DEBUG)
    720:     if (!aa[i]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Null matrix at location %D column %D nz %D",i,aj[i],a->nz);
    721: #endif
    722:     MatAssemblyBegin(aa[i],MAT_FINAL_ASSEMBLY);
    723:     MatAssemblyEnd(aa[i],MAT_FINAL_ASSEMBLY);
    724:   }
    725:   PetscInfo4(A,"Matrix size: %D X %D; storage space: %D unneeded,%D used\n",m,A->cmap->n/A->cmap->bs,fshift,a->nz);
    726:   PetscInfo1(A,"Number of mallocs during MatSetValues() is %D\n",a->reallocs);
    727:   PetscInfo1(A,"Maximum nonzeros in any row is %D\n",rmax);

    729:   A->info.mallocs    += a->reallocs;
    730:   a->reallocs         = 0;
    731:   A->info.nz_unneeded = (double)fshift;
    732:   a->rmax             = rmax;

    734:   A->same_nonzero = PETSC_TRUE;
    735:   MatMarkDiagonal_BlockMat(A);
    736:   return(0);
    737: }

    741: PetscErrorCode MatSetOption_BlockMat(Mat A,MatOption opt,PetscBool flg)
    742: {
    744:   if (opt == MAT_SYMMETRIC && flg) {
    745:     A->ops->sor  = MatSOR_BlockMat_Symmetric;
    746:     A->ops->mult = MatMult_BlockMat_Symmetric;
    747:   } else {
    748:     PetscInfo1(A,"Unused matrix option %s\n",MatOptions[opt]);
    749:   }
    750:   return(0);
    751: }

    754: static struct _MatOps MatOps_Values = {MatSetValues_BlockMat,
    755:                                        0,
    756:                                        0,
    757:                                        MatMult_BlockMat,
    758:                                /*  4*/ MatMultAdd_BlockMat,
    759:                                        MatMultTranspose_BlockMat,
    760:                                        MatMultTransposeAdd_BlockMat,
    761:                                        0,
    762:                                        0,
    763:                                        0,
    764:                                /* 10*/ 0,
    765:                                        0,
    766:                                        0,
    767:                                        MatSOR_BlockMat,
    768:                                        0,
    769:                                /* 15*/ 0,
    770:                                        0,
    771:                                        0,
    772:                                        0,
    773:                                        0,
    774:                                /* 20*/ 0,
    775:                                        MatAssemblyEnd_BlockMat,
    776:                                        MatSetOption_BlockMat,
    777:                                        0,
    778:                                /* 24*/ 0,
    779:                                        0,
    780:                                        0,
    781:                                        0,
    782:                                        0,
    783:                                /* 29*/ 0,
    784:                                        0,
    785:                                        0,
    786:                                        0,
    787:                                        0,
    788:                                /* 34*/ 0,
    789:                                        0,
    790:                                        0,
    791:                                        0,
    792:                                        0,
    793:                                /* 39*/ 0,
    794:                                        0,
    795:                                        0,
    796:                                        0,
    797:                                        0,
    798:                                /* 44*/ 0,
    799:                                        0,
    800:                                        0,
    801:                                        0,
    802:                                        0,
    803:                                /* 49*/ 0,
    804:                                        0,
    805:                                        0,
    806:                                        0,
    807:                                        0,
    808:                                /* 54*/ 0,
    809:                                        0,
    810:                                        0,
    811:                                        0,
    812:                                        0,
    813:                                /* 59*/ MatGetSubMatrix_BlockMat,
    814:                                        MatDestroy_BlockMat,
    815:                                        MatView_BlockMat,
    816:                                        0,
    817:                                        0,
    818:                                /* 64*/ 0,
    819:                                        0,
    820:                                        0,
    821:                                        0,
    822:                                        0,
    823:                                /* 69*/ 0,
    824:                                        0,
    825:                                        0,
    826:                                        0,
    827:                                        0,
    828:                                /* 74*/ 0,
    829:                                        0,
    830:                                        0,
    831:                                        0,
    832:                                        0,
    833:                                /* 79*/ 0,
    834:                                        0,
    835:                                        0,
    836:                                        0,
    837:                                        MatLoad_BlockMat,
    838:                                /* 84*/ 0,
    839:                                        0,
    840:                                        0,
    841:                                        0,
    842:                                        0,
    843:                                /* 89*/ 0,
    844:                                        0,
    845:                                        0,
    846:                                        0,
    847:                                        0,
    848:                                /* 94*/ 0,
    849:                                        0,
    850:                                        0,
    851:                                        0,
    852:                                        0,
    853:                                /* 99*/ 0,
    854:                                        0,
    855:                                        0,
    856:                                        0,
    857:                                        0,
    858:                                /*104*/ 0,
    859:                                        0,
    860:                                        0,
    861:                                        0,
    862:                                        0,
    863:                                /*109*/ 0,
    864:                                        0,
    865:                                        0,
    866:                                        0,
    867:                                        0,
    868:                                /*114*/ 0,
    869:                                        0,
    870:                                        0,
    871:                                        0,
    872:                                        0,
    873:                                /*119*/ 0,
    874:                                        0,
    875:                                        0,
    876:                                        0,
    877:                                        0,
    878:                                /*124*/ 0,
    879:                                        0,
    880:                                        0,
    881:                                        0,
    882:                                        0,
    883:                                /*129*/ 0,
    884:                                        0,
    885:                                        0,
    886:                                        0,
    887:                                        0,
    888:                                /*134*/ 0,
    889:                                        0,
    890:                                        0,
    891:                                        0,
    892:                                        0,
    893:                                /*139*/ 0,
    894:                                        0
    895: };

    899: /*@C
    900:    MatBlockMatSetPreallocation - For good matrix assembly performance
    901:    the user should preallocate the matrix storage by setting the parameter nz
    902:    (or the array nnz).  By setting these parameters accurately, performance
    903:    during matrix assembly can be increased by more than a factor of 50.

    905:    Collective on MPI_Comm

    907:    Input Parameters:
    908: +  B - The matrix
    909: .  bs - size of each block in matrix
    910: .  nz - number of nonzeros per block row (same for all rows)
    911: -  nnz - array containing the number of nonzeros in the various block rows
    912:          (possibly different for each row) or NULL

    914:    Notes:
    915:      If nnz is given then nz is ignored

    917:    Specify the preallocated storage with either nz or nnz (not both).
    918:    Set nz=PETSC_DEFAULT and nnz=NULL for PETSc to control dynamic memory
    919:    allocation.  For large problems you MUST preallocate memory or you
    920:    will get TERRIBLE performance, see the users' manual chapter on matrices.

    922:    Level: intermediate

    924: .seealso: MatCreate(), MatCreateBlockMat(), MatSetValues()

    926: @*/
    927: PetscErrorCode  MatBlockMatSetPreallocation(Mat B,PetscInt bs,PetscInt nz,const PetscInt nnz[])
    928: {

    932:   PetscTryMethod(B,"MatBlockMatSetPreallocation_C",(Mat,PetscInt,PetscInt,const PetscInt[]),(B,bs,nz,nnz));
    933:   return(0);
    934: }

    938: PetscErrorCode  MatBlockMatSetPreallocation_BlockMat(Mat A,PetscInt bs,PetscInt nz,PetscInt *nnz)
    939: {
    940:   Mat_BlockMat   *bmat = (Mat_BlockMat*)A->data;
    942:   PetscInt       i;

    945:   PetscLayoutSetBlockSize(A->rmap,bs);
    946:   PetscLayoutSetBlockSize(A->cmap,bs);
    947:   PetscLayoutSetUp(A->rmap);
    948:   PetscLayoutSetUp(A->cmap);
    949:   PetscLayoutGetBlockSize(A->rmap,&bs);

    951:   if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
    952:   if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %d",nz);
    953:   if (nnz) {
    954:     for (i=0; i<A->rmap->n/bs; i++) {
    955:       if (nnz[i] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be less than 0: local row %d value %d",i,nnz[i]);
    956:       if (nnz[i] > A->cmap->n/bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be greater than row length: local row %d value %d rowlength %d",i,nnz[i],A->cmap->n/bs);
    957:     }
    958:   }
    959:   bmat->mbs = A->rmap->n/bs;

    961:   VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->right);
    962:   VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->middle);
    963:   VecCreateSeq(PETSC_COMM_SELF,bs,&bmat->left);

    965:   if (!bmat->imax) {
    966:     PetscMalloc2(A->rmap->n,PetscInt,&bmat->imax,A->rmap->n,PetscInt,&bmat->ilen);
    967:     PetscLogObjectMemory(A,2*A->rmap->n*sizeof(PetscInt));
    968:   }
    969:   if (nnz) {
    970:     nz = 0;
    971:     for (i=0; i<A->rmap->n/A->rmap->bs; i++) {
    972:       bmat->imax[i] = nnz[i];
    973:       nz           += nnz[i];
    974:     }
    975:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Currently requires block row by row preallocation");

    977:   /* bmat->ilen will count nonzeros in each row so far. */
    978:   for (i=0; i<bmat->mbs; i++) bmat->ilen[i] = 0;

    980:   /* allocate the matrix space */
    981:   MatSeqXAIJFreeAIJ(A,(PetscScalar**)&bmat->a,&bmat->j,&bmat->i);
    982:   PetscMalloc3(nz,Mat,&bmat->a,nz,PetscInt,&bmat->j,A->rmap->n+1,PetscInt,&bmat->i);
    983:   PetscLogObjectMemory(A,(A->rmap->n+1)*sizeof(PetscInt)+nz*(sizeof(PetscScalar)+sizeof(PetscInt)));
    984:   bmat->i[0] = 0;
    985:   for (i=1; i<bmat->mbs+1; i++) {
    986:     bmat->i[i] = bmat->i[i-1] + bmat->imax[i-1];
    987:   }
    988:   bmat->singlemalloc = PETSC_TRUE;
    989:   bmat->free_a       = PETSC_TRUE;
    990:   bmat->free_ij      = PETSC_TRUE;

    992:   bmat->nz            = 0;
    993:   bmat->maxnz         = nz;
    994:   A->info.nz_unneeded = (double)bmat->maxnz;
    995:   MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);
    996:   return(0);
    997: }

    999: /*MC
    1000:    MATBLOCKMAT - A matrix that is defined by a set of Mat's that represents a sparse block matrix
    1001:                  consisting of (usually) sparse blocks.

    1003:   Level: advanced

    1005: .seealso: MatCreateBlockMat()

    1007: M*/

    1011: PETSC_EXTERN PetscErrorCode MatCreate_BlockMat(Mat A)
    1012: {
    1013:   Mat_BlockMat   *b;

    1017:   PetscNewLog(A,Mat_BlockMat,&b);
    1018:   A->data = (void*)b;
    1019:   PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));

    1021:   A->assembled    = PETSC_TRUE;
    1022:   A->preallocated = PETSC_FALSE;
    1023:   PetscObjectChangeTypeName((PetscObject)A,MATBLOCKMAT);

    1025:   PetscObjectComposeFunction((PetscObject)A,"MatBlockMatSetPreallocation_C",MatBlockMatSetPreallocation_BlockMat);
    1026:   return(0);
    1027: }

    1031: /*@C
    1032:    MatCreateBlockMat - Creates a new matrix based sparse Mat storage

    1034:   Collective on MPI_Comm

    1036:    Input Parameters:
    1037: +  comm - MPI communicator
    1038: .  m - number of rows
    1039: .  n  - number of columns
    1040: .  bs - size of each submatrix
    1041: .  nz  - expected maximum number of nonzero blocks in row (use PETSC_DEFAULT if not known)
    1042: -  nnz - expected number of nonzers per block row if known (use NULL otherwise)

    1045:    Output Parameter:
    1046: .  A - the matrix

    1048:    Level: intermediate

    1050:    PETSc requires that matrices and vectors being used for certain
    1051:    operations are partitioned accordingly.  For example, when
    1052:    creating a bmat matrix, A, that supports parallel matrix-vector
    1053:    products using MatMult(A,x,y) the user should set the number
    1054:    of local matrix rows to be the number of local elements of the
    1055:    corresponding result vector, y. Note that this is information is
    1056:    required for use of the matrix interface routines, even though
    1057:    the bmat matrix may not actually be physically partitioned.
    1058:    For example,

    1060: .keywords: matrix, bmat, create

    1062: .seealso: MATBLOCKMAT
    1063: @*/
    1064: PetscErrorCode  MatCreateBlockMat(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt bs,PetscInt nz,PetscInt *nnz, Mat *A)
    1065: {

    1069:   MatCreate(comm,A);
    1070:   MatSetSizes(*A,m,n,PETSC_DETERMINE,PETSC_DETERMINE);
    1071:   MatSetType(*A,MATBLOCKMAT);
    1072:   MatBlockMatSetPreallocation(*A,bs,nz,nnz);
    1073:   return(0);
    1074: }