Actual source code: mpiptap.c

  1: #define PETSCMAT_DLL

  3: /*
  4:   Defines projective product routines where A is a MPIAIJ matrix
  5:           C = P^T * A * P
  6: */

 8:  #include ../src/mat/impls/aij/seq/aij.h
 9:  #include ../src/mat/utils/freespace.h
 10:  #include ../src/mat/impls/aij/mpi/mpiaij.h
 11:  #include petscbt.h

 13: EXTERN PetscErrorCode MatDestroy_MPIAIJ(Mat);
 16: PetscErrorCode  MatDestroy_MPIAIJ_MatPtAP(Mat A)
 17: {
 18:   PetscErrorCode       ierr;
 19:   Mat_Merge_SeqsToMPI  *merge;
 20:   PetscContainer       container;

 23:   PetscObjectQuery((PetscObject)A,"MatMergeSeqsToMPI",(PetscObject *)&container);
 24:   if (container) {
 25:     PetscContainerGetPointer(container,(void **)&merge);
 26:     PetscFree(merge->id_r);
 27:     PetscFree(merge->len_s);
 28:     PetscFree(merge->len_r);
 29:     PetscFree(merge->bi);
 30:     PetscFree(merge->bj);
 31:     PetscFree(merge->buf_ri[0]);
 32:     PetscFree(merge->buf_ri);
 33:     PetscFree(merge->buf_rj[0]);
 34:     PetscFree(merge->buf_rj);
 35:     PetscFree(merge->coi);
 36:     PetscFree(merge->coj);
 37:     PetscFree(merge->owners_co);
 38:     PetscLayoutDestroy(merge->rowmap);
 39: 
 40:     PetscContainerDestroy(container);
 41:     PetscObjectCompose((PetscObject)A,"MatMergeSeqsToMPI",0);
 42:   }
 43:   merge->MatDestroy(A);
 44:   PetscFree(merge);
 45:   return(0);
 46: }

 50: PetscErrorCode MatDuplicate_MPIAIJ_MatPtAP(Mat A, MatDuplicateOption op, Mat *M)
 51: {
 52:   PetscErrorCode       ierr;
 53:   Mat_Merge_SeqsToMPI  *merge;
 54:   PetscContainer       container;

 57:   PetscObjectQuery((PetscObject)A,"MatMergeSeqsToMPI",(PetscObject *)&container);
 58:   if (container) {
 59:     PetscContainerGetPointer(container,(void **)&merge);
 60:   } else {
 61:     SETERRQ(PETSC_ERR_PLIB,"Container does not exit");
 62:   }
 63:   (*merge->MatDuplicate)(A,op,M);
 64:   (*M)->ops->destroy   = merge->MatDestroy;   /* =MatDestroy_MPIAIJ, *M doesn't duplicate A's container! */
 65:   (*M)->ops->duplicate = merge->MatDuplicate; /* =MatDuplicate_ MPIAIJ */
 66:   return(0);
 67: }

 71: PetscErrorCode MatPtAPSymbolic_MPIAIJ(Mat A,Mat P,PetscReal fill,Mat *C)
 72: {

 76:   if (!P->ops->ptapsymbolic_mpiaij) {
 77:     SETERRQ2(PETSC_ERR_SUP,"Not implemented for A=%s and P=%s",((PetscObject)A)->type_name,((PetscObject)P)->type_name);
 78:   }
 79:   (*P->ops->ptapsymbolic_mpiaij)(A,P,fill,C);
 80:   return(0);
 81: }

 85: PetscErrorCode MatPtAPNumeric_MPIAIJ(Mat A,Mat P,Mat C)
 86: {

 90:   if (!P->ops->ptapnumeric_mpiaij) {
 91:     SETERRQ2(PETSC_ERR_SUP,"Not implemented for A=%s and P=%s",((PetscObject)A)->type_name,((PetscObject)P)->type_name);
 92:   }
 93:   (*P->ops->ptapnumeric_mpiaij)(A,P,C);
 94:   return(0);
 95: }

 99: PetscErrorCode MatPtAPSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat P,PetscReal fill,Mat *C)
100: {
101:   PetscErrorCode       ierr;
102:   Mat                  B_mpi;
103:   Mat_MatMatMultMPI    *ap;
104:   PetscContainer       container;
105:   PetscFreeSpaceList   free_space=PETSC_NULL,current_space=PETSC_NULL;
106:   Mat_MPIAIJ           *a=(Mat_MPIAIJ*)A->data,*p=(Mat_MPIAIJ*)P->data;
107:   Mat_SeqAIJ           *ad=(Mat_SeqAIJ*)(a->A)->data,*ao=(Mat_SeqAIJ*)(a->B)->data;
108:   Mat_SeqAIJ           *p_loc,*p_oth;
109:   PetscInt             *pi_loc,*pj_loc,*pi_oth,*pj_oth,*pdti,*pdtj,*poti,*potj,*ptJ;
110:   PetscInt             *adi=ad->i,*adj=ad->j,*aoi=ao->i,*aoj=ao->j,nnz;
111:   PetscInt             nlnk,*lnk,*owners_co,*coi,*coj,i,k,pnz,row;
112:   PetscInt             am=A->rmap->n,pN=P->cmap->N,pn=P->cmap->n;
113:   PetscBT              lnkbt;
114:   MPI_Comm             comm=((PetscObject)A)->comm;
115:   PetscMPIInt          size,rank,tag,*len_si,*len_s,*len_ri;
116:   PetscInt             **buf_rj,**buf_ri,**buf_ri_k;
117:   PetscInt             len,proc,*dnz,*onz,*owners;
118:   PetscInt             nzi,*bi,*bj;
119:   PetscInt             nrows,*buf_s,*buf_si,*buf_si_i,**nextrow,**nextci;
120:   MPI_Request          *swaits,*rwaits;
121:   MPI_Status           *sstatus,rstatus;
122:   Mat_Merge_SeqsToMPI  *merge;
123:   PetscInt             *api,*apj,*Jptr,apnz,*prmap=p->garray,pon,nspacedouble=0;
124:   PetscMPIInt          j;

127:   MPI_Comm_size(comm,&size);
128:   MPI_Comm_rank(comm,&rank);

130:   /* destroy the container 'Mat_MatMatMultMPI' in case that P is attached to it */
131:   PetscObjectQuery((PetscObject)P,"Mat_MatMatMultMPI",(PetscObject *)&container);
132:   if (container) {
133:     /* reset functions */
134:     PetscContainerGetPointer(container,(void **)&ap);
135:     P->ops->destroy = ap->MatDestroy;
136:     P->ops->duplicate = ap->MatDuplicate;
137:     /* destroy container and contents */
138:     PetscContainerDestroy(container);
139:     PetscObjectCompose((PetscObject)P,"Mat_MatMatMultMPI",0);
140:   }

142:   /* create the container 'Mat_MatMatMultMPI' and attach it to P */
143:   PetscNew(Mat_MatMatMultMPI,&ap);
144:   ap->abi=PETSC_NULL; ap->abj=PETSC_NULL;
145:   ap->abnz_max = 0;

147:   PetscContainerCreate(PETSC_COMM_SELF,&container);
148:   PetscContainerSetPointer(container,ap);
149:   PetscObjectCompose((PetscObject)P,"Mat_MatMatMultMPI",(PetscObject)container);
150:   ap->MatDestroy  = P->ops->destroy;
151:   P->ops->destroy = MatDestroy_MPIAIJ_MatMatMult;
152:   ap->reuse       = MAT_INITIAL_MATRIX;
153:   PetscContainerSetUserDestroy(container,PetscContainerDestroy_Mat_MatMatMultMPI);

155:   /* get P_oth by taking rows of P (= non-zero cols of local A) from other processors */
156:   MatGetBrowsOfAoCols(A,P,MAT_INITIAL_MATRIX,&ap->startsj,&ap->startsj_r,&ap->bufa,&ap->B_oth);
157:   /* get P_loc by taking all local rows of P */
158:   MatGetLocalMat(P,MAT_INITIAL_MATRIX,&ap->B_loc);

160:   p_loc = (Mat_SeqAIJ*)(ap->B_loc)->data;
161:   p_oth = (Mat_SeqAIJ*)(ap->B_oth)->data;
162:   pi_loc = p_loc->i; pj_loc = p_loc->j;
163:   pi_oth = p_oth->i; pj_oth = p_oth->j;

165:   /* first, compute symbolic AP = A_loc*P = A_diag*P_loc + A_off*P_oth */
166:   /*-------------------------------------------------------------------*/
167:   PetscMalloc((am+2)*sizeof(PetscInt),&api);
168:   ap->abi = api;
169:   api[0] = 0;

171:   /* create and initialize a linked list */
172:   nlnk = pN+1;
173:   PetscLLCreate(pN,pN,nlnk,lnk,lnkbt);

175:   /* Initial FreeSpace size is fill*nnz(A) */
176:   PetscFreeSpaceGet((PetscInt)(fill*(adi[am]+aoi[am])),&free_space);
177:   current_space = free_space;

179:   for (i=0;i<am;i++) {
180:     apnz = 0;
181:     /* diagonal portion of A */
182:     nzi = adi[i+1] - adi[i];
183:     for (j=0; j<nzi; j++){
184:       row = *adj++;
185:       pnz = pi_loc[row+1] - pi_loc[row];
186:       Jptr  = pj_loc + pi_loc[row];
187:       /* add non-zero cols of P into the sorted linked list lnk */
188:       PetscLLAdd(pnz,Jptr,pN,nlnk,lnk,lnkbt);
189:       apnz += nlnk;
190:     }
191:     /* off-diagonal portion of A */
192:     nzi = aoi[i+1] - aoi[i];
193:     for (j=0; j<nzi; j++){
194:       row = *aoj++;
195:       pnz = pi_oth[row+1] - pi_oth[row];
196:       Jptr  = pj_oth + pi_oth[row];
197:       PetscLLAdd(pnz,Jptr,pN,nlnk,lnk,lnkbt);
198:       apnz += nlnk;
199:     }

201:     api[i+1] = api[i] + apnz;
202:     if (ap->abnz_max < apnz) ap->abnz_max = apnz;

204:     /* if free space is not available, double the total space in the list */
205:     if (current_space->local_remaining<apnz) {
206:       PetscFreeSpaceGet(apnz+current_space->total_array_size,&current_space);
207:       nspacedouble++;
208:     }

210:     /* Copy data into free space, then initialize lnk */
211:     PetscLLClean(pN,pN,apnz,lnk,current_space->array,lnkbt);
212:     current_space->array           += apnz;
213:     current_space->local_used      += apnz;
214:     current_space->local_remaining -= apnz;
215:   }
216:   /* Allocate space for apj, initialize apj, and */
217:   /* destroy list of free space and other temporary array(s) */
218:   PetscMalloc((api[am]+1)*sizeof(PetscInt),&ap->abj);
219:   apj = ap->abj;
220:   PetscFreeSpaceContiguous(&free_space,ap->abj);

222:   /* determine symbolic Co=(p->B)^T*AP - send to others */
223:   /*----------------------------------------------------*/
224:   MatGetSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);

226:   /* then, compute symbolic Co = (p->B)^T*AP */
227:   pon = (p->B)->cmap->n; /* total num of rows to be sent to other processors 
228:                          >= (num of nonzero rows of C_seq) - pn */
229:   PetscMalloc((pon+1)*sizeof(PetscInt),&coi);
230:   coi[0] = 0;

232:   /* set initial free space to be 3*pon*max( nnz(AP) per row) */
233:   nnz           = 3*pon*ap->abnz_max + 1;
234:   PetscFreeSpaceGet(nnz,&free_space);
235:   current_space = free_space;

237:   for (i=0; i<pon; i++) {
238:     nnz  = 0;
239:     pnz = poti[i+1] - poti[i];
240:     j     = pnz;
241:     ptJ   = potj + poti[i+1];
242:     while (j){/* assume cols are almost in increasing order, starting from its end saves computation */
243:       j--; ptJ--;
244:       row  = *ptJ; /* row of AP == col of Pot */
245:       apnz = api[row+1] - api[row];
246:       Jptr   = apj + api[row];
247:       /* add non-zero cols of AP into the sorted linked list lnk */
248:       PetscLLAdd(apnz,Jptr,pN,nlnk,lnk,lnkbt);
249:       nnz += nlnk;
250:     }

252:     /* If free space is not available, double the total space in the list */
253:     if (current_space->local_remaining<nnz) {
254:       PetscFreeSpaceGet(nnz+current_space->total_array_size,&current_space);
255:     }

257:     /* Copy data into free space, and zero out denserows */
258:     PetscLLClean(pN,pN,nnz,lnk,current_space->array,lnkbt);
259:     current_space->array           += nnz;
260:     current_space->local_used      += nnz;
261:     current_space->local_remaining -= nnz;
262:     coi[i+1] = coi[i] + nnz;
263:   }
264:   PetscMalloc((coi[pon]+1)*sizeof(PetscInt),&coj);
265:   PetscFreeSpaceContiguous(&free_space,coj);
266:   MatRestoreSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);

268:   /* send j-array (coj) of Co to other processors */
269:   /*----------------------------------------------*/
270:   /* determine row ownership */
271:   PetscNew(Mat_Merge_SeqsToMPI,&merge);
272:   PetscLayoutCreate(comm,&merge->rowmap);
273:   merge->rowmap->n = pn;
274:   merge->rowmap->bs = 1;
275:   PetscLayoutSetUp(merge->rowmap);
276:   owners = merge->rowmap->range;

278:   /* determine the number of messages to send, their lengths */
279:   PetscMalloc(size*sizeof(PetscMPIInt),&len_si);
280:   PetscMemzero(len_si,size*sizeof(PetscMPIInt));
281:   PetscMalloc(size*sizeof(PetscMPIInt),&merge->len_s);
282:   len_s = merge->len_s;
283:   merge->nsend = 0;
284: 
285:   PetscMalloc((size+2)*sizeof(PetscInt),&owners_co);
286:   PetscMemzero(len_s,size*sizeof(PetscMPIInt));

288:   proc = 0;
289:   for (i=0; i<pon; i++){
290:     while (prmap[i] >= owners[proc+1]) proc++;
291:     len_si[proc]++;  /* num of rows in Co to be sent to [proc] */
292:     len_s[proc] += coi[i+1] - coi[i];
293:   }

295:   len   = 0;  /* max length of buf_si[] */
296:   owners_co[0] = 0;
297:   for (proc=0; proc<size; proc++){
298:     owners_co[proc+1] = owners_co[proc] + len_si[proc];
299:     if (len_si[proc]){
300:       merge->nsend++;
301:       len_si[proc] = 2*(len_si[proc] + 1);
302:       len += len_si[proc];
303:     }
304:   }

306:   /* determine the number and length of messages to receive for coi and coj  */
307:   PetscGatherNumberOfMessages(comm,PETSC_NULL,len_s,&merge->nrecv);
308:   PetscGatherMessageLengths2(comm,merge->nsend,merge->nrecv,len_s,len_si,&merge->id_r,&merge->len_r,&len_ri);

310:   /* post the Irecv and Isend of coj */
311:   PetscCommGetNewTag(comm,&tag);
312:   PetscPostIrecvInt(comm,tag,merge->nrecv,merge->id_r,merge->len_r,&buf_rj,&rwaits);

314:   PetscMalloc((merge->nsend+1)*sizeof(MPI_Request),&swaits);

316:   for (proc=0, k=0; proc<size; proc++){
317:     if (!len_s[proc]) continue;
318:     i = owners_co[proc];
319:     MPI_Isend(coj+coi[i],len_s[proc],MPIU_INT,proc,tag,comm,swaits+k);
320:     k++;
321:   }

323:   /* receives and sends of coj are complete */
324:   PetscMalloc(size*sizeof(MPI_Status),&sstatus);
325:   i = merge->nrecv;
326:   while (i--) {
327:     MPI_Waitany(merge->nrecv,rwaits,&j,&rstatus);
328:   }
329:   PetscFree(rwaits);
330:   if (merge->nsend) {MPI_Waitall(merge->nsend,swaits,sstatus);}
331: 
332:   /* send and recv coi */
333:   /*-------------------*/
334:   PetscPostIrecvInt(comm,tag,merge->nrecv,merge->id_r,len_ri,&buf_ri,&rwaits);
335: 
336:   PetscMalloc((len+1)*sizeof(PetscInt),&buf_s);
337:   buf_si = buf_s;  /* points to the beginning of k-th msg to be sent */
338:   for (proc=0,k=0; proc<size; proc++){
339:     if (!len_s[proc]) continue;
340:     /* form outgoing message for i-structure: 
341:          buf_si[0]:                 nrows to be sent
342:                [1:nrows]:           row index (global)
343:                [nrows+1:2*nrows+1]: i-structure index
344:     */
345:     /*-------------------------------------------*/
346:     nrows = len_si[proc]/2 - 1;
347:     buf_si_i    = buf_si + nrows+1;
348:     buf_si[0]   = nrows;
349:     buf_si_i[0] = 0;
350:     nrows = 0;
351:     for (i=owners_co[proc]; i<owners_co[proc+1]; i++){
352:       nzi = coi[i+1] - coi[i];
353:       buf_si_i[nrows+1] = buf_si_i[nrows] + nzi; /* i-structure */
354:       buf_si[nrows+1] =prmap[i] -owners[proc]; /* local row index */
355:       nrows++;
356:     }
357:     MPI_Isend(buf_si,len_si[proc],MPIU_INT,proc,tag,comm,swaits+k);
358:     k++;
359:     buf_si += len_si[proc];
360:   }
361:   i = merge->nrecv;
362:   while (i--) {
363:     MPI_Waitany(merge->nrecv,rwaits,&j,&rstatus);
364:   }
365:   PetscFree(rwaits);
366:   if (merge->nsend) {MPI_Waitall(merge->nsend,swaits,sstatus);}
367:   /*
368:   PetscInfo2(A,"nsend: %d, nrecv: %d\n",merge->nsend,merge->nrecv);
369:   for (i=0; i<merge->nrecv; i++){
370:     PetscInfo3(A,"recv len_ri=%d, len_rj=%d from [%d]\n",len_ri[i],merge->len_r[i],merge->id_r[i]);
371:   }
372:   */
373:   PetscFree(len_si);
374:   PetscFree(len_ri);
375:   PetscFree(swaits);
376:   PetscFree(sstatus);
377:   PetscFree(buf_s);

379:   /* compute the local portion of C (mpi mat) */
380:   /*------------------------------------------*/
381:   MatGetSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);

383:   /* allocate bi array and free space for accumulating nonzero column info */
384:   PetscMalloc((pn+1)*sizeof(PetscInt),&bi);
385:   bi[0] = 0;
386: 
387:   /* set initial free space to be 3*pn*max( nnz(AP) per row) */
388:   nnz           = 3*pn*ap->abnz_max + 1;
389:   PetscFreeSpaceGet(nnz,&free_space);
390:   current_space = free_space;

392:   PetscMalloc3(merge->nrecv,PetscInt**,&buf_ri_k,merge->nrecv,PetscInt*,&nextrow,merge->nrecv,PetscInt*,&nextci);
393:   for (k=0; k<merge->nrecv; k++){
394:     buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
395:     nrows       = *buf_ri_k[k];
396:     nextrow[k]  = buf_ri_k[k] + 1;  /* next row number of k-th recved i-structure */
397:     nextci[k]   = buf_ri_k[k] + (nrows + 1);/* poins to the next i-structure of k-th recved i-structure  */
398:   }
399:   MatPreallocateInitialize(comm,pn,pn,dnz,onz);
400:   for (i=0; i<pn; i++) {
401:     /* add pdt[i,:]*AP into lnk */
402:     nnz = 0;
403:     pnz  = pdti[i+1] - pdti[i];
404:     j    = pnz;
405:     ptJ  = pdtj + pdti[i+1];
406:     while (j){/* assume cols are almost in increasing order, starting from its end saves computation */
407:       j--; ptJ--;
408:       row  = *ptJ; /* row of AP == col of Pt */
409:       apnz = api[row+1] - api[row];
410:       Jptr   = apj + api[row];
411:       /* add non-zero cols of AP into the sorted linked list lnk */
412:       PetscLLAdd(apnz,Jptr,pN,nlnk,lnk,lnkbt);
413:       nnz += nlnk;
414:     }
415:     /* add received col data into lnk */
416:     for (k=0; k<merge->nrecv; k++){ /* k-th received message */
417:       if (i == *nextrow[k]) { /* i-th row */
418:         nzi = *(nextci[k]+1) - *nextci[k];
419:         Jptr  = buf_rj[k] + *nextci[k];
420:         PetscLLAdd(nzi,Jptr,pN,nlnk,lnk,lnkbt);
421:         nnz += nlnk;
422:         nextrow[k]++; nextci[k]++;
423:       }
424:     }

426:     /* if free space is not available, make more free space */
427:     if (current_space->local_remaining<nnz) {
428:       PetscFreeSpaceGet(nnz+current_space->total_array_size,&current_space);
429:     }
430:     /* copy data into free space, then initialize lnk */
431:     PetscLLClean(pN,pN,nnz,lnk,current_space->array,lnkbt);
432:     MatPreallocateSet(i+owners[rank],nnz,current_space->array,dnz,onz);
433:     current_space->array           += nnz;
434:     current_space->local_used      += nnz;
435:     current_space->local_remaining -= nnz;
436:     bi[i+1] = bi[i] + nnz;
437:   }
438:   MatRestoreSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);
439:   PetscFree3(buf_ri_k,nextrow,nextci);

441:   PetscMalloc((bi[pn]+1)*sizeof(PetscInt),&bj);
442:   PetscFreeSpaceContiguous(&free_space,bj);
443:   PetscLLDestroy(lnk,lnkbt);

445:   /* create symbolic parallel matrix B_mpi */
446:   /*---------------------------------------*/
447:   MatCreate(comm,&B_mpi);
448:   MatSetSizes(B_mpi,pn,pn,PETSC_DETERMINE,PETSC_DETERMINE);
449:   MatSetType(B_mpi,MATMPIAIJ);
450:   MatMPIAIJSetPreallocation(B_mpi,0,dnz,0,onz);
451:   MatPreallocateFinalize(dnz,onz);

453:   merge->bi            = bi;
454:   merge->bj            = bj;
455:   merge->coi           = coi;
456:   merge->coj           = coj;
457:   merge->buf_ri        = buf_ri;
458:   merge->buf_rj        = buf_rj;
459:   merge->owners_co     = owners_co;
460:   merge->MatDestroy    = B_mpi->ops->destroy;
461:   merge->MatDuplicate  = B_mpi->ops->duplicate;

463:   /* B_mpi is not ready for use - assembly will be done by MatPtAPNumeric() */
464:   B_mpi->assembled     = PETSC_FALSE;
465:   B_mpi->ops->destroy  = MatDestroy_MPIAIJ_MatPtAP;
466:   B_mpi->ops->duplicate = MatDuplicate_MPIAIJ_MatPtAP;

468:   /* attach the supporting struct to B_mpi for reuse */
469:   PetscContainerCreate(PETSC_COMM_SELF,&container);
470:   PetscContainerSetPointer(container,merge);
471:   PetscObjectCompose((PetscObject)B_mpi,"MatMergeSeqsToMPI",(PetscObject)container);
472:   *C = B_mpi;
473: #if defined(PETSC_USE_INFO)
474:   if (bi[pn] != 0) {
475:     PetscReal afill = ((PetscReal)bi[pn])/(adi[am]+aoi[am]);
476:     if (afill < 1.0) afill = 1.0;
477:     PetscInfo3(B_mpi,"Reallocs %D; Fill ratio: given %G needed %G when computing A*P.\n",nspacedouble,fill,afill);
478:     PetscInfo1(B_mpi,"Use MatPtAP(A,P,MatReuse,%G,&C) for best performance.\n",afill);
479:   } else {
480:     PetscInfo(B_mpi,"Empty matrix product\n");
481:   }
482: #endif
483:   return(0);
484: }

488: PetscErrorCode MatPtAPNumeric_MPIAIJ_MPIAIJ(Mat A,Mat P,Mat C)
489: {
490:   PetscErrorCode       ierr;
491:   Mat_Merge_SeqsToMPI  *merge;
492:   Mat_MatMatMultMPI    *ap;
493:   PetscContainer       cont_merge,cont_ptap;
494:   Mat_MPIAIJ           *a=(Mat_MPIAIJ*)A->data,*p=(Mat_MPIAIJ*)P->data;
495:   Mat_SeqAIJ           *ad=(Mat_SeqAIJ*)(a->A)->data,*ao=(Mat_SeqAIJ*)(a->B)->data;
496:   Mat_SeqAIJ           *pd=(Mat_SeqAIJ*)(p->A)->data,*po=(Mat_SeqAIJ*)(p->B)->data;
497:   Mat_SeqAIJ           *p_loc,*p_oth;
498:   PetscInt             *adi=ad->i,*aoi=ao->i,*adj=ad->j,*aoj=ao->j,*apJ,nextp;
499:   PetscInt             *pi_loc,*pj_loc,*pi_oth,*pj_oth,*pJ,*pj;
500:   PetscInt             i,j,k,anz,pnz,apnz,nextap,row,*cj;
501:   MatScalar            *ada=ad->a,*aoa=ao->a,*apa,*pa,*ca,*pa_loc,*pa_oth;
502:   PetscInt             am=A->rmap->n,cm=C->rmap->n,pon=(p->B)->cmap->n;
503:   MPI_Comm             comm=((PetscObject)C)->comm;
504:   PetscMPIInt          size,rank,taga,*len_s;
505:   PetscInt             *owners,proc,nrows,**buf_ri_k,**nextrow,**nextci;
506:   PetscInt             **buf_ri,**buf_rj;
507:   PetscInt             cnz=0,*bj_i,*bi,*bj,bnz,nextcj; /* bi,bj,ba: local array of C(mpi mat) */
508:   MPI_Request          *s_waits,*r_waits;
509:   MPI_Status           *status;
510:   MatScalar            **abuf_r,*ba_i,*pA,*coa,*ba;
511:   PetscInt             *api,*apj,*coi,*coj;
512:   PetscInt             *poJ=po->j,*pdJ=pd->j,pcstart=P->cmap->rstart,pcend=P->cmap->rend;

515:   MPI_Comm_size(comm,&size);
516:   MPI_Comm_rank(comm,&rank);

518:   PetscObjectQuery((PetscObject)C,"MatMergeSeqsToMPI",(PetscObject *)&cont_merge);
519:   if (cont_merge) {
520:     PetscContainerGetPointer(cont_merge,(void **)&merge);
521:   } else {
522:     SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Matrix C does not posses an object container");
523:   }

525:   PetscObjectQuery((PetscObject)P,"Mat_MatMatMultMPI",(PetscObject *)&cont_ptap);
526:   if (cont_ptap) {
527:     PetscContainerGetPointer(cont_ptap,(void **)&ap);
528:     if (ap->reuse == MAT_INITIAL_MATRIX){
529:       ap->reuse = MAT_REUSE_MATRIX;
530:     } else { /* update numerical values of P_oth and P_loc */
531:       MatGetBrowsOfAoCols(A,P,MAT_REUSE_MATRIX,&ap->startsj,&ap->startsj_r,&ap->bufa,&ap->B_oth);
532:       MatGetLocalMat(P,MAT_REUSE_MATRIX,&ap->B_loc);
533:     }
534:   } else {
535:     SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Matrix P does not posses an object container");
536:   }

538:   /* get data from symbolic products */
539:   p_loc = (Mat_SeqAIJ*)(ap->B_loc)->data;
540:   p_oth = (Mat_SeqAIJ*)(ap->B_oth)->data;
541:   pi_loc=p_loc->i; pj_loc=p_loc->j; pJ=pj_loc; pa_loc=p_loc->a,pA=pa_loc;
542:   pi_oth=p_oth->i; pj_oth=p_oth->j; pa_oth=p_oth->a;
543: 
544:   coi = merge->coi; coj = merge->coj;
545:   PetscMalloc((coi[pon]+1)*sizeof(MatScalar),&coa);
546:   PetscMemzero(coa,coi[pon]*sizeof(MatScalar));

548:   bi     = merge->bi; bj = merge->bj;
549:   owners = merge->rowmap->range;
550:   PetscMalloc((bi[cm]+1)*sizeof(MatScalar),&ba);
551:   PetscMemzero(ba,bi[cm]*sizeof(MatScalar));

553:   /* get data from symbolic A*P */
554:   PetscMalloc((ap->abnz_max+1)*sizeof(MatScalar),&apa);
555:   PetscMemzero(apa,ap->abnz_max*sizeof(MatScalar));

557:   /* compute numeric C_seq=P_loc^T*A_loc*P */
558:   api = ap->abi; apj = ap->abj;
559:   for (i=0;i<am;i++) {
560:     /* form i-th sparse row of A*P */
561:     apnz = api[i+1] - api[i];
562:     apJ  = apj + api[i];
563:     /* diagonal portion of A */
564:     anz  = adi[i+1] - adi[i];
565:     for (j=0;j<anz;j++) {
566:       row = *adj++;
567:       pnz = pi_loc[row+1] - pi_loc[row];
568:       pj  = pj_loc + pi_loc[row];
569:       pa  = pa_loc + pi_loc[row];
570:       nextp = 0;
571:       for (k=0; nextp<pnz; k++) {
572:         if (apJ[k] == pj[nextp]) { /* col of AP == col of P */
573:           apa[k] += (*ada)*pa[nextp++];
574:         }
575:       }
576:       PetscLogFlops(2.0*pnz);
577:       ada++;
578:     }
579:     /* off-diagonal portion of A */
580:     anz  = aoi[i+1] - aoi[i];
581:     for (j=0; j<anz; j++) {
582:       row = *aoj++;
583:       pnz = pi_oth[row+1] - pi_oth[row];
584:       pj  = pj_oth + pi_oth[row];
585:       pa  = pa_oth + pi_oth[row];
586:       nextp = 0;
587:       for (k=0; nextp<pnz; k++) {
588:         if (apJ[k] == pj[nextp]) { /* col of AP == col of P */
589:           apa[k] += (*aoa)*pa[nextp++];
590:         }
591:       }
592:       PetscLogFlops(2.0*pnz);
593:       aoa++;
594:     }

596:     /* Compute P_loc[i,:]^T*AP[i,:] using outer product */
597:     pnz = pi_loc[i+1] - pi_loc[i];
598:     for (j=0; j<pnz; j++) {
599:       nextap = 0;
600:       row    = *pJ++; /* global index */
601:       if (row < pcstart || row >=pcend) { /* put the value into Co */
602:         cj  = coj + coi[*poJ];
603:         ca  = coa + coi[*poJ++];
604:       } else {                            /* put the value into Cd */
605:         cj   = bj + bi[*pdJ];
606:         ca   = ba + bi[*pdJ++];
607:       }
608:       for (k=0; nextap<apnz; k++) {
609:         if (cj[k]==apJ[nextap]) ca[k] += (*pA)*apa[nextap++];
610:       }
611:       PetscLogFlops(2.0*apnz);
612:       pA++;
613:     }

615:     /* zero the current row info for A*P */
616:     PetscMemzero(apa,apnz*sizeof(MatScalar));
617:   }
618:   PetscFree(apa);
619: 
620:   /* send and recv matrix values */
621:   /*-----------------------------*/
622:   buf_ri = merge->buf_ri;
623:   buf_rj = merge->buf_rj;
624:   len_s  = merge->len_s;
625:   PetscCommGetNewTag(comm,&taga);
626:   PetscPostIrecvScalar(comm,taga,merge->nrecv,merge->id_r,merge->len_r,&abuf_r,&r_waits);

628:   PetscMalloc((merge->nsend+1)*sizeof(MPI_Request),&s_waits);
629:   for (proc=0,k=0; proc<size; proc++){
630:     if (!len_s[proc]) continue;
631:     i = merge->owners_co[proc];
632:     MPI_Isend(coa+coi[i],len_s[proc],MPIU_MATSCALAR,proc,taga,comm,s_waits+k);
633:     k++;
634:   }
635:   PetscMalloc(size*sizeof(MPI_Status),&status);
636:   if (merge->nrecv) {MPI_Waitall(merge->nrecv,r_waits,status);}
637:   if (merge->nsend) {MPI_Waitall(merge->nsend,s_waits,status);}
638:   PetscFree(status);

640:   PetscFree(s_waits);
641:   PetscFree(r_waits);
642:   PetscFree(coa);

644:   /* insert local and received values into C */
645:   /*-----------------------------------------*/
646:   PetscMalloc3(merge->nrecv,PetscInt**,&buf_ri_k,merge->nrecv,PetscInt*,&nextrow,merge->nrecv,PetscInt*,&nextci);

648:   for (k=0; k<merge->nrecv; k++){
649:     buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
650:     nrows       = *(buf_ri_k[k]);
651:     nextrow[k]  = buf_ri_k[k]+1;  /* next row number of k-th recved i-structure */
652:     nextci[k]   = buf_ri_k[k] + (nrows + 1);/* poins to the next i-structure of k-th recved i-structure  */
653:   }

655:   for (i=0; i<cm; i++) {
656:     row = owners[rank] + i; /* global row index of C_seq */
657:     bj_i = bj + bi[i];  /* col indices of the i-th row of C */
658:     ba_i = ba + bi[i];
659:     bnz  = bi[i+1] - bi[i];
660:     /* add received vals into ba */
661:     for (k=0; k<merge->nrecv; k++){ /* k-th received message */
662:       /* i-th row */
663:       if (i == *nextrow[k]) {
664:         cnz = *(nextci[k]+1) - *nextci[k];
665:         cj  = buf_rj[k] + *(nextci[k]);
666:         ca  = abuf_r[k] + *(nextci[k]);
667:         nextcj = 0;
668:         for (j=0; nextcj<cnz; j++){
669:           if (bj_i[j] == cj[nextcj]){ /* bcol == ccol */
670:             ba_i[j] += ca[nextcj++];
671:           }
672:         }
673:         nextrow[k]++; nextci[k]++;
674:       }
675:     }
676:     MatSetValues(C,1,&row,bnz,bj_i,ba_i,INSERT_VALUES);
677:     PetscLogFlops(2.0*cnz);
678:   }
679:   MatSetBlockSize(C,1);
680:   MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);
681:   MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);

683:   PetscFree(ba);
684:   PetscFree(abuf_r[0]);
685:   PetscFree(abuf_r);
686:   PetscFree3(buf_ri_k,nextrow,nextci);
687:   return(0);
688: }