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,¤t_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,¤t_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,¤t_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: }