Actual source code: mpirowbs.c
1: #define PETSCMAT_DLL
3: #include ../src/mat/impls/rowbs/mpi/mpirowbs.h
5: #define CHUNCKSIZE_LOCAL 10
9: static PetscErrorCode MatFreeRowbs_Private(Mat A,int n,int *i,PetscScalar *v)
10: {
14: if (v) {
15: #if defined(PETSC_USE_LOG)
16: int len = -n*(sizeof(int)+sizeof(PetscScalar));
17: #endif
18: PetscFree(v);
19: PetscLogObjectMemory(A,len);
20: }
21: return(0);
22: }
26: static PetscErrorCode MatMallocRowbs_Private(Mat A,int n,int **i,PetscScalar **v)
27: {
29: int len;
32: if (!n) {
33: *i = 0; *v = 0;
34: } else {
35: len = n*(sizeof(int) + sizeof(PetscScalar));
36: PetscMalloc(len,v);
37: PetscLogObjectMemory(A,len);
38: *i = (int*)(*v + n);
39: }
40: return(0);
41: }
45: PetscErrorCode MatScale_MPIRowbs(Mat inA,PetscScalar alpha)
46: {
47: Mat_MPIRowbs *a = (Mat_MPIRowbs*)inA->data;
48: BSspmat *A = a->A;
49: BSsprow *vs;
50: PetscScalar *ap;
51: int i,m = inA->rmap->n,nrow,j;
55: for (i=0; i<m; i++) {
56: vs = A->rows[i];
57: nrow = vs->length;
58: ap = vs->nz;
59: for (j=0; j<nrow; j++) {
60: ap[j] *= alpha;
61: }
62: }
63: PetscLogFlops(a->nz);
64: return(0);
65: }
67: /* ----------------------------------------------------------------- */
70: static PetscErrorCode MatCreateMPIRowbs_local(Mat A,int nz,const int nnz[])
71: {
72: Mat_MPIRowbs *bsif = (Mat_MPIRowbs*)A->data;
74: int i,len,m = A->rmap->n,*tnnz;
75: BSspmat *bsmat;
76: BSsprow *vs;
79: PetscMalloc((m+1)*sizeof(int),&tnnz);
80: if (!nnz) {
81: if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
82: if (nz <= 0) nz = 1;
83: for (i=0; i<m; i++) tnnz[i] = nz;
84: nz = nz*m;
85: } else {
86: nz = 0;
87: for (i=0; i<m; i++) {
88: if (nnz[i] <= 0) tnnz[i] = 1;
89: else tnnz[i] = nnz[i];
90: nz += tnnz[i];
91: }
92: }
94: /* Allocate BlockSolve matrix context */
95: PetscNewLog(A,BSspmat,&bsif->A);
96: bsmat = bsif->A;
97: BSset_mat_icc_storage(bsmat,PETSC_FALSE);
98: BSset_mat_symmetric(bsmat,PETSC_FALSE);
99: len = m*(sizeof(BSsprow*)+ sizeof(BSsprow)) + 1;
100: PetscMalloc(len,&bsmat->rows);
101: bsmat->num_rows = m;
102: bsmat->global_num_rows = A->rmap->N;
103: bsmat->map = bsif->bsmap;
104: vs = (BSsprow*)(bsmat->rows + m);
105: for (i=0; i<m; i++) {
106: bsmat->rows[i] = vs;
107: bsif->imax[i] = tnnz[i];
108: vs->diag_ind = -1;
109: MatMallocRowbs_Private(A,tnnz[i],&(vs->col),&(vs->nz));
110: /* put zero on diagonal */
111: /*vs->length = 1;
112: vs->col[0] = i + bsif->rstart;
113: vs->nz[0] = 0.0;*/
114: vs->length = 0;
115: vs++;
116: }
117: PetscLogObjectMemory(A,sizeof(BSspmat) + len);
118: bsif->nz = 0;
119: bsif->maxnz = nz;
120: bsif->sorted = 0;
121: bsif->roworiented = PETSC_TRUE;
122: bsif->nonew = 0;
123: bsif->bs_color_single = 0;
125: PetscFree(tnnz);
126: return(0);
127: }
131: static PetscErrorCode MatSetValues_MPIRowbs_local(Mat AA,int m,const int im[],int n,const int in[],const PetscScalar v[],InsertMode addv)
132: {
133: Mat_MPIRowbs *mat = (Mat_MPIRowbs*)AA->data;
134: BSspmat *A = mat->A;
135: BSsprow *vs;
137: int *rp,k,a,b,t,ii,row,nrow,i,col,l,rmax;
138: int *imax = mat->imax,nonew = mat->nonew,sorted = mat->sorted;
139: PetscScalar *ap,value;
142: for (k=0; k<m; k++) { /* loop over added rows */
143: row = im[k];
144: if (row < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Negative row: %d",row);
145: if (row >= AA->rmap->n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %d max %d",row,AA->rmap->n-1);
146: vs = A->rows[row];
147: ap = vs->nz; rp = vs->col;
148: rmax = imax[row]; nrow = vs->length;
149: a = 0;
150: for (l=0; l<n; l++) { /* loop over added columns */
151: if (in[l] < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Negative col: %d",in[l]);
152: if (in[l] >= AA->cmap->N) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %d max %d",in[l],AA->cmap->N-1);
153: col = in[l]; value = *v++;
154: if (!sorted) a = 0; b = nrow;
155: while (b-a > 5) {
156: t = (b+a)/2;
157: if (rp[t] > col) b = t;
158: else a = t;
159: }
160: for (i=a; i<b; i++) {
161: if (rp[i] > col) break;
162: if (rp[i] == col) {
163: if (addv == ADD_VALUES) ap[i] += value;
164: else ap[i] = value;
165: goto noinsert;
166: }
167: }
168: if (nonew) goto noinsert;
169: if (nrow >= rmax) {
170: /* there is no extra room in row, therefore enlarge */
171: int *itemp,*iout,*iin = vs->col;
172: PetscScalar *vout,*vin = vs->nz,*vtemp;
174: /* malloc new storage space */
175: imax[row] += CHUNCKSIZE_LOCAL;
176: MatMallocRowbs_Private(AA,imax[row],&itemp,&vtemp);
177: vout = vtemp; iout = itemp;
178: for (ii=0; ii<i; ii++) {
179: vout[ii] = vin[ii];
180: iout[ii] = iin[ii];
181: }
182: vout[i] = value;
183: iout[i] = col;
184: for (ii=i+1; ii<=nrow; ii++) {
185: vout[ii] = vin[ii-1];
186: iout[ii] = iin[ii-1];
187: }
188: /* free old row storage */
189: if (rmax > 0) {
190: MatFreeRowbs_Private(AA,rmax,vs->col,vs->nz);
191: }
192: vs->col = iout; vs->nz = vout;
193: rmax = imax[row];
194: mat->maxnz += CHUNCKSIZE_LOCAL;
195: mat->reallocs++;
196: } else {
197: /* shift higher columns over to make room for newie */
198: for (ii=nrow-1; ii>=i; ii--) {
199: rp[ii+1] = rp[ii];
200: ap[ii+1] = ap[ii];
201: }
202: rp[i] = col;
203: ap[i] = value;
204: }
205: nrow++;
206: mat->nz++;
207: AA->same_nonzero = PETSC_FALSE;
208: noinsert:;
209: a = i + 1;
210: }
211: vs->length = nrow;
212: }
213: return(0);
214: }
219: static PetscErrorCode MatAssemblyBegin_MPIRowbs_local(Mat A,MatAssemblyType mode)
220: {
222: return(0);
223: }
227: static PetscErrorCode MatAssemblyEnd_MPIRowbs_local(Mat AA,MatAssemblyType mode)
228: {
229: Mat_MPIRowbs *a = (Mat_MPIRowbs*)AA->data;
230: BSspmat *A = a->A;
231: BSsprow *vs;
232: int i,j,rstart = AA->rmap->rstart;
235: if (mode == MAT_FLUSH_ASSEMBLY) return(0);
237: /* Mark location of diagonal */
238: for (i=0; i<AA->rmap->n; i++) {
239: vs = A->rows[i];
240: for (j=0; j<vs->length; j++) {
241: if (vs->col[j] == i + rstart) {
242: vs->diag_ind = j;
243: break;
244: }
245: }
246: if (vs->diag_ind == -1) {
247: SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"no diagonal entry");
248: }
249: }
250: return(0);
251: }
255: static PetscErrorCode MatZeroRows_MPIRowbs_local(Mat A,PetscInt N,const PetscInt rz[],PetscScalar diag)
256: {
257: Mat_MPIRowbs *a = (Mat_MPIRowbs*)A->data;
258: BSspmat *l = a->A;
260: int i,m = A->rmap->n - 1,col,base=A->rmap->rstart;
263: if (a->keepzeroedrows) {
264: for (i=0; i<N; i++) {
265: if (rz[i] < 0 || rz[i] > m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"row out of range");
266: PetscMemzero(l->rows[rz[i]]->nz,l->rows[rz[i]]->length*sizeof(PetscScalar));
267: if (diag != 0.0) {
268: col=rz[i]+base;
269: MatSetValues_MPIRowbs_local(A,1,&rz[i],1,&col,&diag,INSERT_VALUES);
270: }
271: }
272: } else {
273: if (diag != 0.0) {
274: for (i=0; i<N; i++) {
275: if (rz[i] < 0 || rz[i] > m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Out of range");
276: if (l->rows[rz[i]]->length > 0) { /* in case row was completely empty */
277: l->rows[rz[i]]->length = 1;
278: l->rows[rz[i]]->nz[0] = diag;
279: l->rows[rz[i]]->col[0] = A->rmap->rstart + rz[i];
280: } else {
281: col=rz[i]+base;
282: MatSetValues_MPIRowbs_local(A,1,&rz[i],1,&col,&diag,INSERT_VALUES);
283: }
284: }
285: } else {
286: for (i=0; i<N; i++) {
287: if (rz[i] < 0 || rz[i] > m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Out of range");
288: l->rows[rz[i]]->length = 0;
289: }
290: }
291: A->same_nonzero = PETSC_FALSE;
292: }
293: MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
294: MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
295: return(0);
296: }
300: static PetscErrorCode MatNorm_MPIRowbs_local(Mat A,NormType type,PetscReal *norm)
301: {
302: Mat_MPIRowbs *mat = (Mat_MPIRowbs*)A->data;
303: BSsprow *vs,**rs;
304: PetscScalar *xv;
305: PetscReal sum = 0.0;
307: int *xi,nz,i,j;
310: rs = mat->A->rows;
311: if (type == NORM_FROBENIUS) {
312: for (i=0; i<A->rmap->n; i++) {
313: vs = *rs++;
314: nz = vs->length;
315: xv = vs->nz;
316: while (nz--) {
317: #if defined(PETSC_USE_COMPLEX)
318: sum += PetscRealPart(PetscConj(*xv)*(*xv)); xv++;
319: #else
320: sum += (*xv)*(*xv); xv++;
321: #endif
322: }
323: }
324: *norm = sqrt(sum);
325: } else if (type == NORM_1) { /* max column norm */
326: PetscReal *tmp;
327: PetscMalloc(A->cmap->n*sizeof(PetscReal),&tmp);
328: PetscMemzero(tmp,A->cmap->n*sizeof(PetscReal));
329: *norm = 0.0;
330: for (i=0; i<A->rmap->n; i++) {
331: vs = *rs++;
332: nz = vs->length;
333: xi = vs->col;
334: xv = vs->nz;
335: while (nz--) {
336: tmp[*xi] += PetscAbsScalar(*xv);
337: xi++; xv++;
338: }
339: }
340: for (j=0; j<A->rmap->n; j++) {
341: if (tmp[j] > *norm) *norm = tmp[j];
342: }
343: PetscFree(tmp);
344: } else if (type == NORM_INFINITY) { /* max row norm */
345: *norm = 0.0;
346: for (i=0; i<A->rmap->n; i++) {
347: vs = *rs++;
348: nz = vs->length;
349: xv = vs->nz;
350: sum = 0.0;
351: while (nz--) {
352: sum += PetscAbsScalar(*xv); xv++;
353: }
354: if (sum > *norm) *norm = sum;
355: }
356: } else {
357: SETERRQ(PETSC_ERR_SUP,"No support for the two norm");
358: }
359: return(0);
360: }
362: /* ----------------------------------------------------------------- */
366: PetscErrorCode MatSetValues_MPIRowbs(Mat mat,int m,const int im[],int n,const int in[],const PetscScalar v[],InsertMode av)
367: {
368: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
370: int i,j,row,col,rstart = mat->rmap->rstart,rend = mat->rmap->rend;
371: PetscTruth roworiented = a->roworiented;
374: /* Note: There's no need to "unscale" the matrix, since scaling is
375: confined to a->pA, and we're working with a->A here */
376: for (i=0; i<m; i++) {
377: if (im[i] < 0) continue;
378: if (im[i] >= mat->rmap->N) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %d max %d",im[i],mat->rmap->N-1);
379: if (im[i] >= rstart && im[i] < rend) {
380: row = im[i] - rstart;
381: for (j=0; j<n; j++) {
382: if (in[j] < 0) continue;
383: if (in[j] >= mat->cmap->N) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %d max %d",in[j],mat->cmap->N-1);
384: if (in[j] >= 0 && in[j] < mat->cmap->N){
385: col = in[j];
386: if (roworiented) {
387: MatSetValues_MPIRowbs_local(mat,1,&row,1,&col,v+i*n+j,av);
388: } else {
389: MatSetValues_MPIRowbs_local(mat,1,&row,1,&col,v+i+j*m,av);
390: }
391: } else {SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid column");}
392: }
393: } else {
394: if (!a->donotstash) {
395: if (roworiented) {
396: MatStashValuesRow_Private(&mat->stash,im[i],n,in,v+i*n);
397: } else {
398: MatStashValuesCol_Private(&mat->stash,im[i],n,in,v+i,m);
399: }
400: }
401: }
402: }
403: return(0);
404: }
408: PetscErrorCode MatAssemblyBegin_MPIRowbs(Mat mat,MatAssemblyType mode)
409: {
410: MPI_Comm comm = ((PetscObject)mat)->comm;
412: int nstash,reallocs;
413: InsertMode addv;
416: /* Note: There's no need to "unscale" the matrix, since scaling is
417: confined to a->pA, and we're working with a->A here */
419: /* make sure all processors are either in INSERTMODE or ADDMODE */
420: MPI_Allreduce(&mat->insertmode,&addv,1,MPI_INT,MPI_BOR,comm);
421: if (addv == (ADD_VALUES|INSERT_VALUES)) {
422: SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Some procs inserted; others added");
423: }
424: mat->insertmode = addv; /* in case this processor had no cache */
426: MatStashScatterBegin_Private(mat,&mat->stash,mat->rmap->range);
427: MatStashGetInfo_Private(&mat->stash,&nstash,&reallocs);
428: PetscInfo2(mat,"Block-Stash has %d entries, uses %d mallocs.\n",nstash,reallocs);
429: return(0);
430: }
434: static PetscErrorCode MatView_MPIRowbs_ASCII(Mat mat,PetscViewer viewer)
435: {
436: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
438: int i,j;
439: PetscTruth iascii;
440: BSspmat *A = a->A;
441: BSsprow **rs = A->rows;
442: PetscViewerFormat format;
445: PetscViewerGetFormat(viewer,&format);
446: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
448: if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
449: int ind_l,ind_g,clq_l,clq_g,color;
450: ind_l = BSlocal_num_inodes(a->pA);CHKERRBS(0);
451: ind_g = BSglobal_num_inodes(a->pA);CHKERRBS(0);
452: clq_l = BSlocal_num_cliques(a->pA);CHKERRBS(0);
453: clq_g = BSglobal_num_cliques(a->pA);CHKERRBS(0);
454: color = BSnum_colors(a->pA);CHKERRBS(0);
455: PetscViewerASCIIPrintf(viewer," %d global inode(s), %d global clique(s), %d color(s)\n",ind_g,clq_g,color);
456: PetscViewerASCIISynchronizedPrintf(viewer," [%d] %d local inode(s), %d local clique(s)\n",a->rank,ind_l,clq_l);
457: } else if (format == PETSC_VIEWER_ASCII_COMMON) {
458: for (i=0; i<A->num_rows; i++) {
459: PetscViewerASCIISynchronizedPrintf(viewer,"row %d:",i+mat->rmap->rstart);
460: for (j=0; j<rs[i]->length; j++) {
461: if (rs[i]->nz[j]) {PetscViewerASCIISynchronizedPrintf(viewer," %d %g ",rs[i]->col[j],rs[i]->nz[j]);}
462: }
463: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
464: }
465: } else if (format == PETSC_VIEWER_ASCII_MATLAB) {
466: SETERRQ(PETSC_ERR_SUP,"Matlab format not supported");
467: } else {
468: PetscViewerASCIIUseTabs(viewer,PETSC_NO);
469: for (i=0; i<A->num_rows; i++) {
470: PetscViewerASCIISynchronizedPrintf(viewer,"row %d:",i+mat->rmap->rstart);
471: for (j=0; j<rs[i]->length; j++) {
472: PetscViewerASCIISynchronizedPrintf(viewer," %d %g ",rs[i]->col[j],rs[i]->nz[j]);
473: }
474: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
475: }
476: PetscViewerASCIIUseTabs(viewer,PETSC_YES);
477: }
478: PetscViewerFlush(viewer);
479: return(0);
480: }
484: static PetscErrorCode MatView_MPIRowbs_Binary(Mat mat,PetscViewer viewer)
485: {
486: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
488: PetscMPIInt rank,size,mnz;
489: PetscInt i,M,m,*sbuff,*rowlengths;
490: PetscInt *recvcts,*recvdisp,fd,*cols,maxnz,nz,j;
491: BSspmat *A = a->A;
492: BSsprow **rs = A->rows;
493: MPI_Comm comm = ((PetscObject)mat)->comm;
494: MPI_Status status;
495: PetscScalar *vals;
496: MatInfo info;
499: MPI_Comm_size(comm,&size);
500: MPI_Comm_rank(comm,&rank);
502: M = mat->rmap->N; m = mat->rmap->n;
503: /* First gather together on the first processor the lengths of
504: each row, and write them out to the file */
505: PetscMalloc(m*sizeof(int),&sbuff);
506: for (i=0; i<A->num_rows; i++) {
507: sbuff[i] = rs[i]->length;
508: }
509: MatGetInfo(mat,MAT_GLOBAL_SUM,&info);
510: if (!rank) {
511: PetscViewerBinaryGetDescriptor(viewer,&fd);
512: PetscMalloc((4+M)*sizeof(int),&rowlengths);
513: PetscMalloc(size*sizeof(int),&recvcts);
514: recvdisp = mat->rmap->range;
515: for (i=0; i<size; i++) {
516: recvcts[i] = recvdisp[i+1] - recvdisp[i];
517: }
518: /* first four elements of rowlength are the header */
519: rowlengths[0] = ((PetscObject)mat)->cookie;
520: rowlengths[1] = mat->rmap->N;
521: rowlengths[2] = mat->cmap->N;
522: rowlengths[3] = (int)info.nz_used;
523: MPI_Gatherv(sbuff,m,MPIU_INT,rowlengths+4,recvcts,recvdisp,MPIU_INT,0,comm);
524: PetscFree(sbuff);
525: PetscBinaryWrite(fd,rowlengths,4+M,PETSC_INT,PETSC_FALSE);
526: /* count the number of nonzeros on each processor */
527: PetscMemzero(recvcts,size*sizeof(int));
528: for (i=0; i<size; i++) {
529: for (j=recvdisp[i]; j<recvdisp[i+1]; j++) {
530: recvcts[i] += rowlengths[j+3];
531: }
532: }
533: /* allocate buffer long enough to hold largest one */
534: maxnz = 0;
535: for (i=0; i<size; i++) {
536: maxnz = PetscMax(maxnz,recvcts[i]);
537: }
538: PetscFree(rowlengths);
539: PetscFree(recvcts);
540: PetscMalloc(maxnz*sizeof(int),&cols);
542: /* binary store column indices for 0th processor */
543: nz = 0;
544: for (i=0; i<A->num_rows; i++) {
545: for (j=0; j<rs[i]->length; j++) {
546: cols[nz++] = rs[i]->col[j];
547: }
548: }
549: PetscBinaryWrite(fd,cols,nz,PETSC_INT,PETSC_FALSE);
551: /* receive and store column indices for all other processors */
552: for (i=1; i<size; i++) {
553: /* should tell processor that I am now ready and to begin the send */
554: MPI_Recv(cols,maxnz,MPIU_INT,i,((PetscObject)mat)->tag,comm,&status);
555: MPI_Get_count(&status,MPIU_INT,&mnz);
556: PetscBinaryWrite(fd,cols,nz,PETSC_INT,PETSC_FALSE);
557: }
558: PetscFree(cols);
559: PetscMalloc(maxnz*sizeof(PetscScalar),&vals);
561: /* binary store values for 0th processor */
562: nz = 0;
563: for (i=0; i<A->num_rows; i++) {
564: for (j=0; j<rs[i]->length; j++) {
565: vals[nz++] = rs[i]->nz[j];
566: }
567: }
568: PetscBinaryWrite(fd,vals,nz,PETSC_SCALAR,PETSC_FALSE);
570: /* receive and store nonzeros for all other processors */
571: for (i=1; i<size; i++) {
572: /* should tell processor that I am now ready and to begin the send */
573: MPI_Recv(vals,maxnz,MPIU_SCALAR,i,((PetscObject)mat)->tag,comm,&status);
574: MPI_Get_count(&status,MPIU_SCALAR,&nz);
575: PetscBinaryWrite(fd,vals,nz,PETSC_SCALAR,PETSC_FALSE);
576: }
577: PetscFree(vals);
578: } else {
579: MPI_Gatherv(sbuff,m,MPI_INT,0,0,0,MPI_INT,0,comm);
580: PetscFree(sbuff);
582: /* count local nonzeros */
583: nz = 0;
584: for (i=0; i<A->num_rows; i++) {
585: for (j=0; j<rs[i]->length; j++) {
586: nz++;
587: }
588: }
589: /* copy into buffer column indices */
590: PetscMalloc(nz*sizeof(int),&cols);
591: nz = 0;
592: for (i=0; i<A->num_rows; i++) {
593: for (j=0; j<rs[i]->length; j++) {
594: cols[nz++] = rs[i]->col[j];
595: }
596: }
597: /* send */ /* should wait until processor zero tells me to go */
598: MPI_Send(cols,nz,MPI_INT,0,((PetscObject)mat)->tag,comm);
599: PetscFree(cols);
601: /* copy into buffer column values */
602: PetscMalloc(nz*sizeof(PetscScalar),&vals);
603: nz = 0;
604: for (i=0; i<A->num_rows; i++) {
605: for (j=0; j<rs[i]->length; j++) {
606: vals[nz++] = rs[i]->nz[j];
607: }
608: }
609: /* send */ /* should wait until processor zero tells me to go */
610: MPI_Send(vals,nz,MPIU_SCALAR,0,((PetscObject)mat)->tag,comm);
611: PetscFree(vals);
612: }
614: return(0);
615: }
619: PetscErrorCode MatView_MPIRowbs(Mat mat,PetscViewer viewer)
620: {
621: Mat_MPIRowbs *bsif = (Mat_MPIRowbs*)mat->data;
623: PetscTruth iascii,isbinary;
626: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
627: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
628: if (!bsif->blocksolveassembly) {
629: MatAssemblyEnd_MPIRowbs_ForBlockSolve(mat);
630: }
631: if (iascii) {
632: MatView_MPIRowbs_ASCII(mat,viewer);
633: } else if (isbinary) {
634: MatView_MPIRowbs_Binary(mat,viewer);
635: } else {
636: SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported by MPIRowbs matrices",((PetscObject)viewer)->type_name);
637: }
638: return(0);
639: }
640:
643: static PetscErrorCode MatAssemblyEnd_MPIRowbs_MakeSymmetric(Mat mat)
644: {
645: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
646: BSspmat *A = a->A;
647: BSsprow *vs;
648: int size,rank,M,rstart,tag,i,j,*rtable,*w1,*w3,*w4,len,proc,nrqs;
649: int msz,*pa,bsz,nrqr,**rbuf1,**sbuf1,**ptr,*tmp,*ctr,col,idx,row;
651: int ctr_j,*sbuf1_j,k;
652: PetscScalar val=0.0;
653: MPI_Comm comm;
654: MPI_Request *s_waits1,*r_waits1;
655: MPI_Status *s_status,*r_status;
658: comm = ((PetscObject)mat)->comm;
659: tag = ((PetscObject)mat)->tag;
660: size = a->size;
661: rank = a->rank;
662: M = mat->rmap->N;
663: rstart = mat->rmap->rstart;
665: PetscMalloc(M*sizeof(int),&rtable);
666: /* Create hash table for the mapping :row -> proc */
667: for (i=0,j=0; i<size; i++) {
668: len = mat->rmap->range[i+1];
669: for (; j<len; j++) {
670: rtable[j] = i;
671: }
672: }
674: /* Evaluate communication - mesg to whom, length of mesg, and buffer space
675: required. Based on this, buffers are allocated, and data copied into them. */
676: PetscMalloc(size*4*sizeof(int),&w1);/* mesg size */
677: w3 = w1 + 2*size; /* no of IS that needs to be sent to proc i */
678: w4 = w3 + size; /* temp work space used in determining w1, w3 */
679: PetscMemzero(w1,size*3*sizeof(int)); /* initialize work vector */
681: for (i=0; i<mat->rmap->n; i++) {
682: PetscMemzero(w4,size*sizeof(int)); /* initialize work vector */
683: vs = A->rows[i];
684: for (j=0; j<vs->length; j++) {
685: proc = rtable[vs->col[j]];
686: w4[proc]++;
687: }
688: for (j=0; j<size; j++) {
689: if (w4[j]) { w1[2*j] += w4[j]; w3[j]++;}
690: }
691: }
692:
693: nrqs = 0; /* number of outgoing messages */
694: msz = 0; /* total mesg length (for all proc */
695: w1[2*rank] = 0; /* no mesg sent to itself */
696: w3[rank] = 0;
697: for (i=0; i<size; i++) {
698: if (w1[2*i]) {w1[2*i+1] = 1; nrqs++;} /* there exists a message to proc i */
699: }
700: /* pa - is list of processors to communicate with */
701: PetscMalloc((nrqs+1)*sizeof(int),&pa);
702: for (i=0,j=0; i<size; i++) {
703: if (w1[2*i]) {pa[j] = i; j++;}
704: }
706: /* Each message would have a header = 1 + 2*(no of ROWS) + data */
707: for (i=0; i<nrqs; i++) {
708: j = pa[i];
709: w1[2*j] += w1[2*j+1] + 2*w3[j];
710: msz += w1[2*j];
711: }
712:
713: /* Do a global reduction to determine how many messages to expect */
714: PetscMaxSum(comm,w1,&bsz,&nrqr);
716: /* Allocate memory for recv buffers . Prob none if nrqr = 0 ???? */
717: len = (nrqr+1)*sizeof(int*) + nrqr*bsz*sizeof(int);
718: PetscMalloc(len,&rbuf1);
719: rbuf1[0] = (int*)(rbuf1 + nrqr);
720: for (i=1; i<nrqr; ++i) rbuf1[i] = rbuf1[i-1] + bsz;
722: /* Post the receives */
723: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&r_waits1);
724: for (i=0; i<nrqr; ++i){
725: MPI_Irecv(rbuf1[i],bsz,MPI_INT,MPI_ANY_SOURCE,tag,comm,r_waits1+i);
726: }
727:
728: /* Allocate Memory for outgoing messages */
729: len = 2*size*sizeof(int*) + (size+msz)*sizeof(int);
730: PetscMalloc(len,&sbuf1);
731: ptr = sbuf1 + size; /* Pointers to the data in outgoing buffers */
732: PetscMemzero(sbuf1,2*size*sizeof(int*));
733: tmp = (int*)(sbuf1 + 2*size);
734: ctr = tmp + msz;
736: {
737: int *iptr = tmp,ict = 0;
738: for (i=0; i<nrqs; i++) {
739: j = pa[i];
740: iptr += ict;
741: sbuf1[j] = iptr;
742: ict = w1[2*j];
743: }
744: }
746: /* Form the outgoing messages */
747: /* Clean up the header space */
748: for (i=0; i<nrqs; i++) {
749: j = pa[i];
750: sbuf1[j][0] = 0;
751: PetscMemzero(sbuf1[j]+1,2*w3[j]*sizeof(int));
752: ptr[j] = sbuf1[j] + 2*w3[j] + 1;
753: }
755: /* Parse the matrix and copy the data into sbuf1 */
756: for (i=0; i<mat->rmap->n; i++) {
757: PetscMemzero(ctr,size*sizeof(int));
758: vs = A->rows[i];
759: for (j=0; j<vs->length; j++) {
760: col = vs->col[j];
761: proc = rtable[col];
762: if (proc != rank) { /* copy to the outgoing buffer */
763: ctr[proc]++;
764: *ptr[proc] = col;
765: ptr[proc]++;
766: } else {
767: row = col - rstart;
768: col = i + rstart;
769: MatSetValues_MPIRowbs_local(mat,1,&row,1,&col,&val,ADD_VALUES);
770: }
771: }
772: /* Update the headers for the current row */
773: for (j=0; j<size; j++) { /* Can Optimise this loop by using pa[] */
774: if ((ctr_j = ctr[j])) {
775: sbuf1_j = sbuf1[j];
776: k = ++sbuf1_j[0];
777: sbuf1_j[2*k] = ctr_j;
778: sbuf1_j[2*k-1] = i + rstart;
779: }
780: }
781: }
782: /* Check Validity of the outgoing messages */
783: {
784: int sum;
785: for (i=0 ; i<nrqs ; i++) {
786: j = pa[i];
787: if (w3[j] != sbuf1[j][0]) {SETERRQ(PETSC_ERR_PLIB,"Blew it! Header[1] mismatch!\n"); }
788: }
790: for (i=0 ; i<nrqs ; i++) {
791: j = pa[i];
792: sum = 1;
793: for (k = 1; k <= w3[j]; k++) sum += sbuf1[j][2*k]+2;
794: if (sum != w1[2*j]) { SETERRQ(PETSC_ERR_PLIB,"Blew it! Header[2-n] mismatch!\n"); }
795: }
796: }
797:
798: /* Now post the sends */
799: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&s_waits1);
800: for (i=0; i<nrqs; ++i) {
801: j = pa[i];
802: MPI_Isend(sbuf1[j],w1[2*j],MPI_INT,j,tag,comm,s_waits1+i);
803: }
804:
805: /* Receive messages*/
806: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&r_status);
807: for (i=0; i<nrqr; ++i) {
808: MPI_Waitany(nrqr,r_waits1,&idx,r_status+i);
809: /* Process the Message */
810: {
811: int *rbuf1_i,n_row,ct1;
813: rbuf1_i = rbuf1[idx];
814: n_row = rbuf1_i[0];
815: ct1 = 2*n_row+1;
816: val = 0.0;
817: /* Optimise this later */
818: for (j=1; j<=n_row; j++) {
819: col = rbuf1_i[2*j-1];
820: for (k=0; k<rbuf1_i[2*j]; k++,ct1++) {
821: row = rbuf1_i[ct1] - rstart;
822: MatSetValues_MPIRowbs_local(mat,1,&row,1,&col,&val,ADD_VALUES);
823: }
824: }
825: }
826: }
828: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&s_status);
829: if (nrqs) {MPI_Waitall(nrqs,s_waits1,s_status);}
831: PetscFree(rtable);
832: PetscFree(w1);
833: PetscFree(pa);
834: PetscFree(rbuf1);
835: PetscFree(sbuf1);
836: PetscFree(r_waits1);
837: PetscFree(s_waits1);
838: PetscFree(r_status);
839: PetscFree(s_status);
840: return(0);
841: }
843: /*
844: This does the BlockSolve portion of the matrix assembly.
845: It is provided in a separate routine so that users can
846: operate on the matrix (using MatScale(), MatShift() etc.) after
847: the matrix has been assembled but before BlockSolve has sucked it
848: in and devoured it.
849: */
852: PetscErrorCode MatAssemblyEnd_MPIRowbs_ForBlockSolve(Mat mat)
853: {
854: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
856: int ldim,low,high,i;
857: PetscScalar *diag;
860: if ((mat->was_assembled) && (!mat->same_nonzero)) { /* Free the old info */
861: if (a->pA) {BSfree_par_mat(a->pA);CHKERRBS(0);}
862: if (a->comm_pA) {BSfree_comm(a->comm_pA);CHKERRBS(0);}
863: }
865: if ((!mat->same_nonzero) || (!mat->was_assembled)) {
866: /* Indicates bypassing cliques in coloring */
867: if (a->bs_color_single) {
868: BSctx_set_si(a->procinfo,100);
869: }
870: /* Form permuted matrix for efficient parallel execution */
871: a->pA = BSmain_perm(a->procinfo,a->A);CHKERRBS(0);
872: /* Set up the communication */
873: a->comm_pA = BSsetup_forward(a->pA,a->procinfo);CHKERRBS(0);
874: } else {
875: /* Repermute the matrix */
876: BSmain_reperm(a->procinfo,a->A,a->pA);CHKERRBS(0);
877: }
879: /* Symmetrically scale the matrix by the diagonal */
880: BSscale_diag(a->pA,a->pA->diag,a->procinfo);CHKERRBS(0);
882: /* Store inverse of square root of permuted diagonal scaling matrix */
883: VecGetLocalSize(a->diag,&ldim);
884: VecGetOwnershipRange(a->diag,&low,&high);
885: VecGetArray(a->diag,&diag);
886: for (i=0; i<ldim; i++) {
887: if (a->pA->scale_diag[i] != 0.0) {
888: diag[i] = 1.0/sqrt(PetscAbsScalar(a->pA->scale_diag[i]));
889: } else {
890: diag[i] = 1.0;
891: }
892: }
893: VecRestoreArray(a->diag,&diag);
894: a->assembled_icc_storage = a->A->icc_storage;
895: a->blocksolveassembly = 1;
896: mat->was_assembled = PETSC_TRUE;
897: mat->same_nonzero = PETSC_TRUE;
898: PetscInfo(mat,"Completed BlockSolve95 matrix assembly\n");
899: return(0);
900: }
904: PetscErrorCode MatAssemblyEnd_MPIRowbs(Mat mat,MatAssemblyType mode)
905: {
906: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
908: int i,n,row,col,*rows,*cols,rstart,nzcount,flg,j,ncols;
909: PetscScalar *vals,val;
910: InsertMode addv = mat->insertmode;
913: while (1) {
914: MatStashScatterGetMesg_Private(&mat->stash,&n,&rows,&cols,&vals,&flg);
915: if (!flg) break;
916:
917: for (i=0; i<n;) {
918: /* Now identify the consecutive vals belonging to the same row */
919: for (j=i,rstart=rows[j]; j<n; j++) { if (rows[j] != rstart) break; }
920: if (j < n) ncols = j-i;
921: else ncols = n-i;
922: /* Now assemble all these values with a single function call */
923: MatSetValues_MPIRowbs(mat,1,rows+i,ncols,cols+i,vals+i,addv);
924: i = j;
925: }
926: }
927: MatStashScatterEnd_Private(&mat->stash);
929: rstart = mat->rmap->rstart;
930: nzcount = a->nz; /* This is the number of nonzeros entered by the user */
931: /* BlockSolve requires that the matrix is structurally symmetric */
932: if (mode == MAT_FINAL_ASSEMBLY && !mat->structurally_symmetric) {
933: MatAssemblyEnd_MPIRowbs_MakeSymmetric(mat);
934: }
935:
936: /* BlockSolve requires that all the diagonal elements are set */
937: val = 0.0;
938: for (i=0; i<mat->rmap->n; i++) {
939: row = i; col = i + rstart;
940: MatSetValues_MPIRowbs_local(mat,1,&row,1,&col,&val,ADD_VALUES);
941: }
942:
943: MatAssemblyBegin_MPIRowbs_local(mat,mode);
944: MatAssemblyEnd_MPIRowbs_local(mat,mode);
945:
946: a->blocksolveassembly = 0;
947: PetscInfo4(mat,"Matrix size: %d X %d; storage space: %d unneeded,%d used\n",mat->rmap->n,mat->cmap->n,a->maxnz-a->nz,a->nz);
948: PetscInfo2(mat,"User entered %d nonzeros, PETSc added %d\n",nzcount,a->nz-nzcount);
949: PetscInfo1(mat,"Number of mallocs during MatSetValues is %d\n",a->reallocs);
950: return(0);
951: }
955: PetscErrorCode MatZeroEntries_MPIRowbs(Mat mat)
956: {
957: Mat_MPIRowbs *l = (Mat_MPIRowbs*)mat->data;
958: BSspmat *A = l->A;
959: BSsprow *vs;
960: int i,j;
963: for (i=0; i <mat->rmap->n; i++) {
964: vs = A->rows[i];
965: for (j=0; j< vs->length; j++) vs->nz[j] = 0.0;
966: }
967: return(0);
968: }
970: /* the code does not do the diagonal entries correctly unless the
971: matrix is square and the column and row owerships are identical.
972: This is a BUG.
973: */
977: PetscErrorCode MatZeroRows_MPIRowbs(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag)
978: {
979: Mat_MPIRowbs *l = (Mat_MPIRowbs*)A->data;
981: int i,*owners = A->rmap->range,size = l->size;
982: int *nprocs,j,idx,nsends;
983: int nmax,*svalues,*starts,*owner,nrecvs,rank = l->rank;
984: int *rvalues,tag = ((PetscObject)A)->tag,count,base,slen,n,*source;
985: int *lens,imdex,*lrows,*values;
986: MPI_Comm comm = ((PetscObject)A)->comm;
987: MPI_Request *send_waits,*recv_waits;
988: MPI_Status recv_status,*send_status;
989: PetscTruth found;
992: /* first count number of contributors to each processor */
993: PetscMalloc(2*size*sizeof(int),&nprocs);
994: PetscMemzero(nprocs,2*size*sizeof(int));
995: PetscMalloc((N+1)*sizeof(int),&owner); /* see note*/
996: for (i=0; i<N; i++) {
997: idx = rows[i];
998: found = PETSC_FALSE;
999: for (j=0; j<size; j++) {
1000: if (idx >= owners[j] && idx < owners[j+1]) {
1001: nprocs[2*j]++; nprocs[2*j+1] = 1; owner[i] = j; found = PETSC_TRUE; break;
1002: }
1003: }
1004: if (!found) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Row out of range");
1005: }
1006: nsends = 0; for (i=0; i<size; i++) {nsends += nprocs[2*i+1];}
1008: /* inform other processors of number of messages and max length*/
1009: PetscMaxSum(comm,nprocs,&nmax,&nrecvs);
1011: /* post receives: */
1012: PetscMalloc((nrecvs+1)*(nmax+1)*sizeof(int),&rvalues);
1013: PetscMalloc((nrecvs+1)*sizeof(MPI_Request),&recv_waits);
1014: for (i=0; i<nrecvs; i++) {
1015: MPI_Irecv(rvalues+nmax*i,nmax,MPI_INT,MPI_ANY_SOURCE,tag,comm,recv_waits+i);
1016: }
1018: /* do sends:
1019: 1) starts[i] gives the starting index in svalues for stuff going to
1020: the ith processor
1021: */
1022: PetscMalloc((N+1)*sizeof(int),&svalues);
1023: PetscMalloc((nsends+1)*sizeof(MPI_Request),&send_waits);
1024: PetscMalloc((size+1)*sizeof(int),&starts);
1025: starts[0] = 0;
1026: for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[2*i-2];}
1027: for (i=0; i<N; i++) {
1028: svalues[starts[owner[i]]++] = rows[i];
1029: }
1031: starts[0] = 0;
1032: for (i=1; i<size+1; i++) { starts[i] = starts[i-1] + nprocs[2*i-2];}
1033: count = 0;
1034: for (i=0; i<size; i++) {
1035: if (nprocs[2*i+1]) {
1036: MPI_Isend(svalues+starts[i],nprocs[2*i],MPI_INT,i,tag,comm,send_waits+count++);
1037: }
1038: }
1039: PetscFree(starts);
1041: base = owners[rank];
1043: /* wait on receives */
1044: PetscMalloc(2*(nrecvs+1)*sizeof(int),&lens);
1045: source = lens + nrecvs;
1046: count = nrecvs; slen = 0;
1047: while (count) {
1048: MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);
1049: /* unpack receives into our local space */
1050: MPI_Get_count(&recv_status,MPI_INT,&n);
1051: source[imdex] = recv_status.MPI_SOURCE;
1052: lens[imdex] = n;
1053: slen += n;
1054: count--;
1055: }
1056: PetscFree(recv_waits);
1057:
1058: /* move the data into the send scatter */
1059: PetscMalloc((slen+1)*sizeof(int),&lrows);
1060: count = 0;
1061: for (i=0; i<nrecvs; i++) {
1062: values = rvalues + i*nmax;
1063: for (j=0; j<lens[i]; j++) {
1064: lrows[count++] = values[j] - base;
1065: }
1066: }
1067: PetscFree(rvalues);
1068: PetscFree(lens);
1069: PetscFree(owner);
1070: PetscFree(nprocs);
1071:
1072: /* actually zap the local rows */
1073: MatZeroRows_MPIRowbs_local(A,slen,lrows,diag);
1074: PetscFree(lrows);
1076: /* wait on sends */
1077: if (nsends) {
1078: PetscMalloc(nsends*sizeof(MPI_Status),&send_status);
1079: MPI_Waitall(nsends,send_waits,send_status);
1080: PetscFree(send_status);
1081: }
1082: PetscFree(send_waits);
1083: PetscFree(svalues);
1085: return(0);
1086: }
1090: PetscErrorCode MatNorm_MPIRowbs(Mat mat,NormType type,PetscReal *norm)
1091: {
1092: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
1093: BSsprow *vs,**rs;
1094: PetscScalar *xv;
1095: PetscReal sum = 0.0;
1097: int *xi,nz,i,j;
1100: if (a->size == 1) {
1101: MatNorm_MPIRowbs_local(mat,type,norm);
1102: } else {
1103: rs = a->A->rows;
1104: if (type == NORM_FROBENIUS) {
1105: for (i=0; i<mat->rmap->n; i++) {
1106: vs = *rs++;
1107: nz = vs->length;
1108: xv = vs->nz;
1109: while (nz--) {
1110: #if defined(PETSC_USE_COMPLEX)
1111: sum += PetscRealPart(PetscConj(*xv)*(*xv)); xv++;
1112: #else
1113: sum += (*xv)*(*xv); xv++;
1114: #endif
1115: }
1116: }
1117: MPI_Allreduce(&sum,norm,1,MPIU_REAL,MPI_SUM,((PetscObject)mat)->comm);
1118: *norm = sqrt(*norm);
1119: } else if (type == NORM_1) { /* max column norm */
1120: PetscReal *tmp,*tmp2;
1121: PetscMalloc(mat->cmap->n*sizeof(PetscReal),&tmp);
1122: PetscMalloc(mat->cmap->n*sizeof(PetscReal),&tmp2);
1123: PetscMemzero(tmp,mat->cmap->n*sizeof(PetscReal));
1124: *norm = 0.0;
1125: for (i=0; i<mat->rmap->n; i++) {
1126: vs = *rs++;
1127: nz = vs->length;
1128: xi = vs->col;
1129: xv = vs->nz;
1130: while (nz--) {
1131: tmp[*xi] += PetscAbsScalar(*xv);
1132: xi++; xv++;
1133: }
1134: }
1135: MPI_Allreduce(tmp,tmp2,mat->cmap->N,MPIU_REAL,MPI_SUM,((PetscObject)mat)->comm);
1136: for (j=0; j<mat->cmap->n; j++) {
1137: if (tmp2[j] > *norm) *norm = tmp2[j];
1138: }
1139: PetscFree(tmp);
1140: PetscFree(tmp2);
1141: } else if (type == NORM_INFINITY) { /* max row norm */
1142: PetscReal ntemp = 0.0;
1143: for (i=0; i<mat->rmap->n; i++) {
1144: vs = *rs++;
1145: nz = vs->length;
1146: xv = vs->nz;
1147: sum = 0.0;
1148: while (nz--) {
1149: sum += PetscAbsScalar(*xv); xv++;
1150: }
1151: if (sum > ntemp) ntemp = sum;
1152: }
1153: MPI_Allreduce(&ntemp,norm,1,MPIU_REAL,MPI_MAX,((PetscObject)mat)->comm);
1154: } else {
1155: SETERRQ(PETSC_ERR_SUP,"No support for two norm");
1156: }
1157: }
1158: return(0);
1159: }
1163: PetscErrorCode MatMult_MPIRowbs(Mat mat,Vec xx,Vec yy)
1164: {
1165: Mat_MPIRowbs *bsif = (Mat_MPIRowbs*)mat->data;
1166: BSprocinfo *bspinfo = bsif->procinfo;
1167: PetscScalar *xxa,*xworka,*yya;
1171: if (!bsif->blocksolveassembly) {
1172: MatAssemblyEnd_MPIRowbs_ForBlockSolve(mat);
1173: }
1175: /* Permute and apply diagonal scaling: [ xwork = D^{1/2} * x ] */
1176: if (!bsif->vecs_permscale) {
1177: VecGetArray(bsif->xwork,&xworka);
1178: VecGetArray(xx,&xxa);
1179: BSperm_dvec(xxa,xworka,bsif->pA->perm);CHKERRBS(0);
1180: VecRestoreArray(bsif->xwork,&xworka);
1181: VecRestoreArray(xx,&xxa);
1182: VecPointwiseDivide(xx,bsif->xwork,bsif->diag);
1183: }
1185: VecGetArray(xx,&xxa);
1186: VecGetArray(yy,&yya);
1187: /* Do lower triangular multiplication: [ y = L * xwork ] */
1188: if (bspinfo->single) {
1189: BSforward1(bsif->pA,xxa,yya,bsif->comm_pA,bspinfo);CHKERRBS(0);
1190: } else {
1191: BSforward(bsif->pA,xxa,yya,bsif->comm_pA,bspinfo);CHKERRBS(0);
1192: }
1193:
1194: /* Do upper triangular multiplication: [ y = y + L^{T} * xwork ] */
1195: if (mat->symmetric) {
1196: if (bspinfo->single){
1197: BSbackward1(bsif->pA,xxa,yya,bsif->comm_pA,bspinfo);CHKERRBS(0);
1198: } else {
1199: BSbackward(bsif->pA,xxa,yya,bsif->comm_pA,bspinfo);CHKERRBS(0);
1200: }
1201: }
1202: /* not needed for ILU version since forward does it all */
1203: VecRestoreArray(xx,&xxa);
1204: VecRestoreArray(yy,&yya);
1206: /* Apply diagonal scaling to vector: [ y = D^{1/2} * y ] */
1207: if (!bsif->vecs_permscale) {
1208: VecGetArray(bsif->xwork,&xworka);
1209: VecGetArray(xx,&xxa);
1210: BSiperm_dvec(xworka,xxa,bsif->pA->perm);CHKERRBS(0);
1211: VecRestoreArray(bsif->xwork,&xworka);
1212: VecRestoreArray(xx,&xxa);
1213: VecPointwiseDivide(bsif->xwork,yy,bsif->diag);
1214: VecGetArray(bsif->xwork,&xworka);
1215: VecGetArray(yy,&yya);
1216: BSiperm_dvec(xworka,yya,bsif->pA->perm);CHKERRBS(0);
1217: VecRestoreArray(bsif->xwork,&xworka);
1218: VecRestoreArray(yy,&yya);
1219: }
1220: PetscLogFlops(2*bsif->nz - mat->cmap->n);
1222: return(0);
1223: }
1227: PetscErrorCode MatMultAdd_MPIRowbs(Mat mat,Vec xx,Vec yy,Vec zz)
1228: {
1230: PetscScalar one = 1.0;
1233: (*mat->ops->mult)(mat,xx,zz);
1234: VecAXPY(zz,one,yy);
1235: return(0);
1236: }
1240: PetscErrorCode MatGetInfo_MPIRowbs(Mat A,MatInfoType flag,MatInfo *info)
1241: {
1242: Mat_MPIRowbs *mat = (Mat_MPIRowbs*)A->data;
1243: PetscReal isend[5],irecv[5];
1247: info->block_size = 1.0;
1248: info->mallocs = (double)mat->reallocs;
1249: isend[0] = mat->nz; isend[1] = mat->maxnz; isend[2] = mat->maxnz - mat->nz;
1250: isend[3] = ((PetscObject)A)->mem; isend[4] = info->mallocs;
1252: if (flag == MAT_LOCAL) {
1253: info->nz_used = isend[0];
1254: info->nz_allocated = isend[1];
1255: info->nz_unneeded = isend[2];
1256: info->memory = isend[3];
1257: info->mallocs = isend[4];
1258: } else if (flag == MAT_GLOBAL_MAX) {
1259: MPI_Allreduce(isend,irecv,3,MPIU_REAL,MPI_MAX,((PetscObject)A)->comm);
1260: info->nz_used = irecv[0];
1261: info->nz_allocated = irecv[1];
1262: info->nz_unneeded = irecv[2];
1263: info->memory = irecv[3];
1264: info->mallocs = irecv[4];
1265: } else if (flag == MAT_GLOBAL_SUM) {
1266: MPI_Allreduce(isend,irecv,3,MPIU_REAL,MPI_SUM,((PetscObject)A)->comm);
1267: info->nz_used = irecv[0];
1268: info->nz_allocated = irecv[1];
1269: info->nz_unneeded = irecv[2];
1270: info->memory = irecv[3];
1271: info->mallocs = irecv[4];
1272: }
1273: return(0);
1274: }
1278: PetscErrorCode MatGetDiagonal_MPIRowbs(Mat mat,Vec v)
1279: {
1280: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
1281: BSsprow **rs = a->A->rows;
1283: int i,n;
1284: PetscScalar *x,zero = 0.0;
1287: if (mat->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
1288: if (!a->blocksolveassembly) {
1289: MatAssemblyEnd_MPIRowbs_ForBlockSolve(mat);
1290: }
1292: VecSet(v,zero);
1293: VecGetLocalSize(v,&n);
1294: if (n != mat->rmap->n) SETERRQ(PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec");
1295: VecGetArray(v,&x);
1296: for (i=0; i<mat->rmap->n; i++) {
1297: x[i] = rs[i]->nz[rs[i]->diag_ind];
1298: }
1299: VecRestoreArray(v,&x);
1300: return(0);
1301: }
1305: PetscErrorCode MatDestroy_MPIRowbs(Mat mat)
1306: {
1307: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
1308: BSspmat *A = a->A;
1309: BSsprow *vs;
1311: int i;
1314: #if defined(PETSC_USE_LOG)
1315: PetscLogObjectState((PetscObject)mat,"Rows=%d, Cols=%d",mat->rmap->N,mat->cmap->N);
1316: #endif
1317: MatStashDestroy_Private(&mat->stash);
1318: if (a->bsmap) {
1319: PetscFree(a->bsmap->vlocal2global);
1320: PetscFree(a->bsmap->vglobal2local);
1321: if (a->bsmap->vglobal2proc) (*a->bsmap->free_g2p)(a->bsmap->vglobal2proc);
1322: PetscFree(a->bsmap);
1323: }
1325: if (A) {
1326: for (i=0; i<mat->rmap->n; i++) {
1327: vs = A->rows[i];
1328: MatFreeRowbs_Private(mat,vs->length,vs->col,vs->nz);
1329: }
1330: /* Note: A->map = a->bsmap is freed above */
1331: PetscFree(A->rows);
1332: PetscFree(A);
1333: }
1334: if (a->procinfo) {BSfree_ctx(a->procinfo);CHKERRBS(0);}
1335: if (a->diag) {VecDestroy(a->diag);}
1336: if (a->xwork) {VecDestroy(a->xwork);}
1337: if (a->pA) {BSfree_par_mat(a->pA);CHKERRBS(0);}
1338: if (a->fpA) {BSfree_copy_par_mat(a->fpA);CHKERRBS(0);}
1339: if (a->comm_pA) {BSfree_comm(a->comm_pA);CHKERRBS(0);}
1340: if (a->comm_fpA) {BSfree_comm(a->comm_fpA);CHKERRBS(0);}
1341: PetscFree(a->imax);
1342: MPI_Comm_free(&(a->comm_mpirowbs));
1343: PetscFree(a);
1345: PetscObjectChangeTypeName((PetscObject)mat,0);
1346: PetscObjectComposeFunction((PetscObject)mat,"MatMPIRowbsSetPreallocation_C","",PETSC_NULL);
1347: return(0);
1348: }
1352: PetscErrorCode MatSetOption_MPIRowbs(Mat A,MatOption op,PetscTruth flg)
1353: {
1354: Mat_MPIRowbs *a = (Mat_MPIRowbs*)A->data;
1358: switch (op) {
1359: case MAT_ROW_ORIENTED:
1360: a->roworiented = flg;
1361: break;
1362: case MAT_NEW_NONZERO_LOCATIONS:
1363: a->nonew = (flg ? 0 : 1);
1364: break;
1365: case MAT_USE_INODES:
1366: a->bs_color_single = (flg ? 0 : 1);
1367: break;
1368: case MAT_NEW_DIAGONALS:
1369: case MAT_NEW_NONZERO_LOCATION_ERR:
1370: case MAT_NEW_NONZERO_ALLOCATION_ERR:
1371: case MAT_USE_HASH_TABLE:
1372: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1373: break;
1374: case MAT_IGNORE_OFF_PROC_ENTRIES:
1375: a->donotstash = flg;
1376: break;
1377: case MAT_KEEP_ZEROED_ROWS:
1378: a->keepzeroedrows = flg;
1379: break;
1380: case MAT_SYMMETRIC:
1381: BSset_mat_symmetric(a->A,PETSC_TRUE);CHKERRBS(0);
1382: break;
1383: case MAT_STRUCTURALLY_SYMMETRIC:
1384: case MAT_HERMITIAN:
1385: case MAT_SYMMETRY_ETERNAL:
1386: PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);
1387: break;
1388: default:
1389: SETERRQ1(PETSC_ERR_SUP,"unknown option %d",op);
1390: break;
1391: }
1392: return(0);
1393: }
1397: PetscErrorCode MatGetRow_MPIRowbs(Mat AA,int row,int *nz,int **idx,PetscScalar **v)
1398: {
1399: Mat_MPIRowbs *mat = (Mat_MPIRowbs*)AA->data;
1400: BSspmat *A = mat->A;
1401: BSsprow *rs;
1402:
1404: if (row < AA->rmap->rstart || row >= AA->rmap->rend) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Only local rows");
1406: rs = A->rows[row - AA->rmap->rstart];
1407: *nz = rs->length;
1408: if (v) *v = rs->nz;
1409: if (idx) *idx = rs->col;
1410: return(0);
1411: }
1415: PetscErrorCode MatRestoreRow_MPIRowbs(Mat A,int row,int *nz,int **idx,PetscScalar **v)
1416: {
1418: return(0);
1419: }
1421: /* ------------------------------------------------------------------ */
1425: PetscErrorCode MatSetUpPreallocation_MPIRowbs(Mat A)
1426: {
1430: MatMPIRowbsSetPreallocation(A,PETSC_DEFAULT,0);
1431: return(0);
1432: }
1434: /* -------------------------------------------------------------------*/
1435: static struct _MatOps MatOps_Values = {MatSetValues_MPIRowbs,
1436: MatGetRow_MPIRowbs,
1437: MatRestoreRow_MPIRowbs,
1438: MatMult_MPIRowbs,
1439: /* 4*/ MatMultAdd_MPIRowbs,
1440: MatMult_MPIRowbs,
1441: MatMultAdd_MPIRowbs,
1442: 0,
1443: 0,
1444: 0,
1445: /*10*/ 0,
1446: 0,
1447: 0,
1448: 0,
1449: 0,
1450: /*15*/ MatGetInfo_MPIRowbs,
1451: 0,
1452: MatGetDiagonal_MPIRowbs,
1453: 0,
1454: MatNorm_MPIRowbs,
1455: /*20*/ MatAssemblyBegin_MPIRowbs,
1456: MatAssemblyEnd_MPIRowbs,
1457: 0,
1458: MatSetOption_MPIRowbs,
1459: MatZeroEntries_MPIRowbs,
1460: /*25*/ MatZeroRows_MPIRowbs,
1461: 0,
1462: 0,
1463: 0,
1464: 0,
1465: /*30*/ MatSetUpPreallocation_MPIRowbs,
1466: 0,
1467: 0,
1468: 0,
1469: 0,
1470: /*35*/ 0,
1471: 0,
1472: 0,
1473: 0,
1474: 0,
1475: /*40*/ 0,
1476: MatGetSubMatrices_MPIRowbs,
1477: 0,
1478: 0,
1479: 0,
1480: /*45*/ 0,
1481: MatScale_MPIRowbs,
1482: 0,
1483: 0,
1484: 0,
1485: /*50*/ 0,
1486: 0,
1487: 0,
1488: 0,
1489: 0,
1490: /*55*/ 0,
1491: 0,
1492: 0,
1493: 0,
1494: 0,
1495: /*60*/ MatGetSubMatrix_MPIRowbs,
1496: MatDestroy_MPIRowbs,
1497: MatView_MPIRowbs,
1498: 0,
1499: MatUseScaledForm_MPIRowbs,
1500: /*65*/ MatScaleSystem_MPIRowbs,
1501: MatUnScaleSystem_MPIRowbs,
1502: 0,
1503: 0,
1504: 0,
1505: /*70*/ 0,
1506: 0,
1507: 0,
1508: 0,
1509: 0,
1510: /*75*/ 0,
1511: 0,
1512: 0,
1513: 0,
1514: 0,
1515: /*80*/ 0,
1516: 0,
1517: 0,
1518: 0,
1519: MatLoad_MPIRowbs,
1520: /*85*/ 0,
1521: 0,
1522: 0,
1523: 0,
1524: 0,
1525: /*90*/ 0,
1526: 0,
1527: 0,
1528: 0,
1529: 0,
1530: /*95*/ 0,
1531: 0,
1532: 0,
1533: 0};
1535: /* ------------------------------------------------------------------- */
1540: PetscErrorCode MatMPIRowbsSetPreallocation_MPIRowbs(Mat mat,int nz,const int nnz[])
1541: {
1545: mat->preallocated = PETSC_TRUE;
1546: MatCreateMPIRowbs_local(mat,nz,nnz);
1547: return(0);
1548: }
1551: /*MC
1552: MATMPIROWBS - MATMPIROWBS = "mpirowbs" - A matrix type providing ILU and ICC for distributed sparse matrices for use
1553: with the external package BlockSolve95. If BlockSolve95 is installed (see the manual for instructions
1554: on how to declare the existence of external packages), a matrix type can be constructed which invokes
1555: BlockSolve95 preconditioners and solvers.
1557: Options Database Keys:
1558: . -mat_type mpirowbs - sets the matrix type to "mpirowbs" during a call to MatSetFromOptions()
1560: Level: beginner
1562: .seealso: MatCreateMPIRowbs
1563: M*/
1568: PetscErrorCode MatCreate_MPIRowbs(Mat A)
1569: {
1570: Mat_MPIRowbs *a;
1571: BSmapping *bsmap;
1572: BSoff_map *bsoff;
1574: int *offset,m,M;
1575: PetscTruth flg1,flg3;
1576: BSprocinfo *bspinfo;
1577: MPI_Comm comm;
1578:
1580: comm = ((PetscObject)A)->comm;
1582: PetscNewLog(A,Mat_MPIRowbs,&a);
1583: A->data = (void*)a;
1584: PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));
1585: A->factor = 0;
1586: A->mapping = 0;
1587: a->vecs_permscale = PETSC_FALSE;
1588: A->insertmode = NOT_SET_VALUES;
1589: a->blocksolveassembly = 0;
1590: a->keepzeroedrows = PETSC_FALSE;
1592: MPI_Comm_rank(comm,&a->rank);
1593: MPI_Comm_size(comm,&a->size);
1596: PetscMapSetBlockSize(A->rmap,1);
1597: PetscMapSetBlockSize(A->cmap,1);
1598: PetscMapSetUp(A->rmap);
1599: PetscMapSetUp(A->cmap);
1600: m = A->rmap->n;
1601: M = A->rmap->N;
1603: PetscMalloc((A->rmap->n+1)*sizeof(int),&a->imax);
1604: a->reallocs = 0;
1606: /* build cache for off array entries formed */
1607: MatStashCreate_Private(((PetscObject)A)->comm,1,&A->stash);
1608: a->donotstash = PETSC_FALSE;
1610: /* Initialize BlockSolve information */
1611: a->A = 0;
1612: a->pA = 0;
1613: a->comm_pA = 0;
1614: a->fpA = 0;
1615: a->comm_fpA = 0;
1616: a->alpha = 1.0;
1617: a->0;
1618: a->failures = 0;
1619: MPI_Comm_dup(((PetscObject)A)->comm,&(a->comm_mpirowbs));
1620: VecCreateMPI(((PetscObject)A)->comm,A->rmap->n,A->rmap->N,&(a->diag));
1621: VecDuplicate(a->diag,&(a->xwork));
1622: PetscLogObjectParent(A,a->diag); PetscLogObjectParent(A,a->xwork);
1623: PetscLogObjectMemory(A,(A->rmap->n+1)*sizeof(PetscScalar));
1624: bspinfo = BScreate_ctx();CHKERRBS(0);
1625: a->procinfo = bspinfo;
1626: BSctx_set_id(bspinfo,a->rank);CHKERRBS(0);
1627: BSctx_set_np(bspinfo,a->size);CHKERRBS(0);
1628: BSctx_set_ps(bspinfo,a->comm_mpirowbs);CHKERRBS(0);
1629: BSctx_set_cs(bspinfo,INT_MAX);CHKERRBS(0);
1630: BSctx_set_is(bspinfo,INT_MAX);CHKERRBS(0);
1631: BSctx_set_ct(bspinfo,IDO);CHKERRBS(0);
1632: #if defined(PETSC_USE_DEBUG)
1633: BSctx_set_err(bspinfo,1);CHKERRBS(0); /* BS error checking */
1634: #endif
1635: BSctx_set_rt(bspinfo,1);CHKERRBS(0);
1636: #if defined (PETSC_USE_INFO)
1637: PetscOptionsHasName(PETSC_NULL,"-info",&flg1);
1638: if (flg1) {
1639: BSctx_set_pr(bspinfo,1);CHKERRBS(0);
1640: }
1641: #endif
1642: PetscOptionsBegin(((PetscObject)A)->comm,PETSC_NULL,"Options for MPIROWBS matrix","Mat");
1643: PetscOptionsTruth("-pc_factor_factorpointwise","Do not optimize for inodes (slow)",PETSC_NULL,PETSC_FALSE,&flg1,PETSC_NULL);
1644: PetscOptionsTruth("-mat_rowbs_no_inode","Do not optimize for inodes (slow)",PETSC_NULL,PETSC_FALSE,&flg3,PETSC_NULL);
1645: PetscOptionsEnd();
1646: if (flg1 || flg3) {
1647: BSctx_set_si(bspinfo,1);CHKERRBS(0);
1648: } else {
1649: BSctx_set_si(bspinfo,0);CHKERRBS(0);
1650: }
1651: #if defined(PETSC_USE_LOG)
1652: MLOG_INIT(); /* Initialize logging */
1653: #endif
1655: /* Compute global offsets */
1656: offset = &A->rmap->rstart;
1658: PetscNewLog(A,BSmapping,&a->bsmap);
1659: bsmap = a->bsmap;
1660: PetscMalloc(sizeof(int),&bsmap->vlocal2global);
1661: *((int*)bsmap->vlocal2global) = (*offset);
1662: bsmap->flocal2global = BSloc2glob;
1663: bsmap->free_l2g = 0;
1664: PetscMalloc(sizeof(int),&bsmap->vglobal2local);
1665: *((int*)bsmap->vglobal2local) = (*offset);
1666: bsmap->fglobal2local = BSglob2loc;
1667: bsmap->free_g2l = 0;
1668: bsoff = BSmake_off_map(*offset,bspinfo,A->rmap->N);
1669: bsmap->vglobal2proc = (void*)bsoff;
1670: bsmap->fglobal2proc = BSglob2proc;
1671: bsmap->free_g2p = (void(*)(void*)) BSfree_off_map;
1672: PetscObjectComposeFunctionDynamic((PetscObject)A,"MatMPIRowbsSetPreallocation_C",
1673: "MatMPIRowbsSetPreallocation_MPIRowbs",
1674: MatMPIRowbsSetPreallocation_MPIRowbs);
1675: PetscObjectChangeTypeName((PetscObject)A,MATMPIROWBS);
1676: return(0);
1677: }
1682: /* @
1683: MatMPIRowbsSetPreallocation - Sets the number of expected nonzeros
1684: per row in the matrix.
1686: Input Parameter:
1687: + mat - matrix
1688: . nz - maximum expected for any row
1689: - nzz - number expected in each row
1691: Note:
1692: This routine is valid only for matrices stored in the MATMPIROWBS
1693: format.
1694: @ */
1695: PetscErrorCode MatMPIRowbsSetPreallocation(Mat mat,int nz,const int nnz[])
1696: {
1697: PetscErrorCode ierr,(*f)(Mat,int,const int[]);
1700: PetscObjectQueryFunction((PetscObject)mat,"MatMPIRowbsSetPreallocation_C",(void (**)(void))&f);
1701: if (f) {
1702: (*f)(mat,nz,nnz);
1703: }
1704: return(0);
1705: }
1707: /* --------------- extra BlockSolve-specific routines -------------- */
1710: /* @
1711: MatGetBSProcinfo - Gets the BlockSolve BSprocinfo context, which the
1712: user can then manipulate to alter the default parameters.
1714: Input Parameter:
1715: mat - matrix
1717: Output Parameter:
1718: procinfo - processor information context
1720: Note:
1721: This routine is valid only for matrices stored in the MATMPIROWBS
1722: format.
1723: @ */
1724: PetscErrorCode MatGetBSProcinfo(Mat mat,BSprocinfo *procinfo)
1725: {
1726: Mat_MPIRowbs *a = (Mat_MPIRowbs*)mat->data;
1727: PetscTruth ismpirowbs;
1731: PetscTypeCompare((PetscObject)mat,MATMPIROWBS,&ismpirowbs);
1732: if (!ismpirowbs) SETERRQ(PETSC_ERR_ARG_WRONG,"For MATMPIROWBS matrix type");
1733: procinfo = a->procinfo;
1734: return(0);
1735: }
1739: PetscErrorCode MatLoad_MPIRowbs(PetscViewer viewer,const MatType type,Mat *newmat)
1740: {
1741: Mat_MPIRowbs *a;
1742: BSspmat *A;
1743: BSsprow **rs;
1744: Mat mat;
1746: int i,nz,j,rstart,rend,fd,*ourlens,*sndcounts = 0,*procsnz;
1747: int header[4],rank,size,*rowlengths = 0,M,m,*rowners,maxnz,*cols;
1748: PetscScalar *vals;
1749: MPI_Comm comm = ((PetscObject)viewer)->comm;
1750: MPI_Status status;
1753: MPI_Comm_size(comm,&size);
1754: MPI_Comm_rank(comm,&rank);
1755: if (!rank) {
1756: PetscViewerBinaryGetDescriptor(viewer,&fd);
1757: PetscBinaryRead(fd,(char *)header,4,PETSC_INT);
1758: if (header[0] != MAT_FILE_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Not matrix object");
1759: if (header[3] < 0) {
1760: SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"Matrix stored in special format,cannot load as MPIRowbs");
1761: }
1762: }
1764: MPI_Bcast(header+1,3,MPI_INT,0,comm);
1765: M = header[1];
1767: /* determine ownership of all rows */
1768: m = M/size + ((M % size) > rank);
1769: PetscMalloc((size+2)*sizeof(int),&rowners);
1770: MPI_Allgather(&m,1,MPI_INT,rowners+1,1,MPI_INT,comm);
1771: rowners[0] = 0;
1772: for (i=2; i<=size; i++) {
1773: rowners[i] += rowners[i-1];
1774: }
1775: rstart = rowners[rank];
1776: rend = rowners[rank+1];
1778: /* distribute row lengths to all processors */
1779: PetscMalloc((rend-rstart)*sizeof(int),&ourlens);
1780: if (!rank) {
1781: PetscMalloc(M*sizeof(int),&rowlengths);
1782: PetscBinaryRead(fd,rowlengths,M,PETSC_INT);
1783: PetscMalloc(size*sizeof(int),&sndcounts);
1784: for (i=0; i<size; i++) sndcounts[i] = rowners[i+1] - rowners[i];
1785: MPI_Scatterv(rowlengths,sndcounts,rowners,MPI_INT,ourlens,rend-rstart,MPI_INT,0,comm);
1786: PetscFree(sndcounts);
1787: } else {
1788: MPI_Scatterv(0,0,0,MPI_INT,ourlens,rend-rstart,MPI_INT,0,comm);
1789: }
1791: /* create our matrix */
1792: MatCreate(comm,newmat);
1793: MatSetSizes(*newmat,m,m,M,M);
1794: MatSetType(*newmat,type);
1795: MatMPIRowbsSetPreallocation(*newmat,0,ourlens);
1796: mat = *newmat;
1797: PetscFree(ourlens);
1799: a = (Mat_MPIRowbs*)mat->data;
1800: A = a->A;
1801: rs = A->rows;
1803: if (!rank) {
1804: /* calculate the number of nonzeros on each processor */
1805: PetscMalloc(size*sizeof(int),&procsnz);
1806: PetscMemzero(procsnz,size*sizeof(int));
1807: for (i=0; i<size; i++) {
1808: for (j=rowners[i]; j< rowners[i+1]; j++) {
1809: procsnz[i] += rowlengths[j];
1810: }
1811: }
1812: PetscFree(rowlengths);
1814: /* determine max buffer needed and allocate it */
1815: maxnz = 0;
1816: for (i=0; i<size; i++) {
1817: maxnz = PetscMax(maxnz,procsnz[i]);
1818: }
1819: PetscMalloc(maxnz*sizeof(int),&cols);
1821: /* read in my part of the matrix column indices */
1822: nz = procsnz[0];
1823: PetscBinaryRead(fd,cols,nz,PETSC_INT);
1824:
1825: /* insert it into my part of matrix */
1826: nz = 0;
1827: for (i=0; i<A->num_rows; i++) {
1828: for (j=0; j<a->imax[i]; j++) {
1829: rs[i]->col[j] = cols[nz++];
1830: }
1831: rs[i]->length = a->imax[i];
1832: }
1833: /* read in parts for all other processors */
1834: for (i=1; i<size; i++) {
1835: nz = procsnz[i];
1836: PetscBinaryRead(fd,cols,nz,PETSC_INT);
1837: MPI_Send(cols,nz,MPI_INT,i,((PetscObject)mat)->tag,comm);
1838: }
1839: PetscFree(cols);
1840: PetscMalloc(maxnz*sizeof(PetscScalar),&vals);
1842: /* read in my part of the matrix numerical values */
1843: nz = procsnz[0];
1844: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
1845:
1846: /* insert it into my part of matrix */
1847: nz = 0;
1848: for (i=0; i<A->num_rows; i++) {
1849: for (j=0; j<a->imax[i]; j++) {
1850: rs[i]->nz[j] = vals[nz++];
1851: }
1852: }
1853: /* read in parts for all other processors */
1854: for (i=1; i<size; i++) {
1855: nz = procsnz[i];
1856: PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);
1857: MPI_Send(vals,nz,MPIU_SCALAR,i,((PetscObject)mat)->tag,comm);
1858: }
1859: PetscFree(vals);
1860: PetscFree(procsnz);
1861: } else {
1862: /* determine buffer space needed for message */
1863: nz = 0;
1864: for (i=0; i<A->num_rows; i++) {
1865: nz += a->imax[i];
1866: }
1867: PetscMalloc(nz*sizeof(int),&cols);
1869: /* receive message of column indices*/
1870: MPI_Recv(cols,nz,MPI_INT,0,((PetscObject)mat)->tag,comm,&status);
1871: MPI_Get_count(&status,MPI_INT,&maxnz);
1872: if (maxnz != nz) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"something is wrong");
1874: /* insert it into my part of matrix */
1875: nz = 0;
1876: for (i=0; i<A->num_rows; i++) {
1877: for (j=0; j<a->imax[i]; j++) {
1878: rs[i]->col[j] = cols[nz++];
1879: }
1880: rs[i]->length = a->imax[i];
1881: }
1882: PetscFree(cols);
1883: PetscMalloc(nz*sizeof(PetscScalar),&vals);
1885: /* receive message of values*/
1886: MPI_Recv(vals,nz,MPIU_SCALAR,0,((PetscObject)mat)->tag,comm,&status);
1887: MPI_Get_count(&status,MPIU_SCALAR,&maxnz);
1888: if (maxnz != nz) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,"something is wrong");
1890: /* insert it into my part of matrix */
1891: nz = 0;
1892: for (i=0; i<A->num_rows; i++) {
1893: for (j=0; j<a->imax[i]; j++) {
1894: rs[i]->nz[j] = vals[nz++];
1895: }
1896: rs[i]->length = a->imax[i];
1897: }
1898: PetscFree(vals);
1899: }
1900: PetscFree(rowners);
1901: a->nz = a->maxnz;
1902: MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);
1903: MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);
1904: return(0);
1905: }
1907: /*
1908: Special destroy and view routines for factored matrices
1909: */
1912: static PetscErrorCode MatDestroy_MPIRowbs_Factored(Mat mat)
1913: {
1915: #if defined(PETSC_USE_LOG)
1916: PetscLogObjectState((PetscObject)mat,"Rows=%d, Cols=%d",mat->rmap->N,mat->cmap->N);
1917: #endif
1918: return(0);
1919: }
1923: static PetscErrorCode MatView_MPIRowbs_Factored(Mat mat,PetscViewer viewer)
1924: {
1928: MatView((Mat) mat->data,viewer);
1929: return(0);
1930: }
1934: PetscErrorCode MatIncompleteCholeskyFactorSymbolic_MPIRowbs(Mat newmat,Mat mat,IS isrow,const MatFactorInfo *info)
1935: {
1936: /* Note: f is not currently used in BlockSolve */
1937: Mat_MPIRowbs *mbs = (Mat_MPIRowbs*)mat->data;
1939: PetscTruth idn;
1942: if (isrow) {
1943: ISIdentity(isrow,&idn);
1944: if (!idn) SETERRQ(PETSC_ERR_SUP,"Only identity row permutation supported");
1945: }
1947: if (!mat->symmetric) {
1948: SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"To use incomplete Cholesky \n\
1949: preconditioning with a MATMPIROWBS matrix you must declare it to be \n\
1950: symmetric using the option MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE)");
1951: }
1953: /* If the icc_storage flag wasn't set before the last blocksolveassembly, */
1954: /* we must completely redo the assembly as a different storage format is required. */
1955: if (mbs->blocksolveassembly && !mbs->assembled_icc_storage) {
1956: mat->same_nonzero = PETSC_FALSE;
1957: mbs->blocksolveassembly = 0;
1958: }
1960: if (!mbs->blocksolveassembly) {
1961: BSset_mat_icc_storage(mbs->A,PETSC_TRUE);CHKERRBS(0);
1962: BSset_mat_symmetric(mbs->A,PETSC_TRUE);CHKERRBS(0);
1963: MatAssemblyEnd_MPIRowbs_ForBlockSolve(mat);
1964: }
1966: /* Copy permuted matrix */
1967: if (mbs->fpA) {BSfree_copy_par_mat(mbs->fpA);CHKERRBS(0);}
1968: mbs->fpA = BScopy_par_mat(mbs->pA);CHKERRBS(0);
1970: /* Set up the communication for factorization */
1971: if (mbs->comm_fpA) {BSfree_comm(mbs->comm_fpA);CHKERRBS(0);}
1972: mbs->comm_fpA = BSsetup_factor(mbs->fpA,mbs->procinfo);CHKERRBS(0);
1974: /*
1975: Create a new Mat structure to hold the "factored" matrix,
1976: not this merely contains a pointer to the original matrix, since
1977: the original matrix contains the factor information.
1978: */
1979: PetscHeaderCreate(newmat,_p_Mat,struct _MatOps,MAT_COOKIE,-1,"Mat",((PetscObject)mat)->comm,MatDestroy,MatView);
1981: newmat->data = (void*)mat;
1982: PetscMemcpy(newmat->ops,&MatOps_Values,sizeof(struct _MatOps));
1983: newmat->ops->destroy = MatDestroy_MPIRowbs_Factored;
1984: newmat->ops->view = MatView_MPIRowbs_Factored;
1985: newmat->factor = 1;
1986: newmat->preallocated = PETSC_TRUE;
1987: PetscMapCopy(((PetscObject)mat)->comm,mat->rmap,newmat->rmap);
1988: PetscMapCopy(((PetscObject)mat)->comm,mat->cmap,newmat->cmap);
1990: PetscStrallocpy(MATMPIROWBS,&((PetscObject)newmat)->type_name);
1991: newmat->ops->lufactornumeric = MatLUFactorNumeric_MPIRowbs;
1992: return(0);
1993: }
1997: PetscErrorCode MatILUFactorSymbolic_MPIRowbs(Mat newmat,Mat mat,IS isrow,IS iscol,const MatFactorInfo* info)
1998: {
1999: Mat_MPIRowbs *mbs = (Mat_MPIRowbs*)mat->data;
2001: PetscTruth idn;
2004: if (info->levels) SETERRQ(PETSC_ERR_SUP,"Blocksolve ILU only supports 0 fill");
2005: if (isrow) {
2006: ISIdentity(isrow,&idn);
2007: if (!idn) SETERRQ(PETSC_ERR_SUP,"Only identity row permutation supported");
2008: }
2009: if (iscol) {
2010: ISIdentity(iscol,&idn);
2011: if (!idn) SETERRQ(PETSC_ERR_SUP,"Only identity column permutation supported");
2012: }
2014: if (!mbs->blocksolveassembly) {
2015: MatAssemblyEnd_MPIRowbs_ForBlockSolve(mat);
2016: }
2017:
2018: /* if (mat->symmetric) { */
2019: /* SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"To use ILU preconditioner with \n\ */
2020: /* MatCreateMPIRowbs() matrix you CANNOT declare it to be a symmetric matrix\n\ */
2021: /* using the option MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE)"); */
2022: /* } */
2024: /* Copy permuted matrix */
2025: if (mbs->fpA) {BSfree_copy_par_mat(mbs->fpA);CHKERRBS(0);}
2026: mbs->fpA = BScopy_par_mat(mbs->pA);CHKERRBS(0);
2028: /* Set up the communication for factorization */
2029: if (mbs->comm_fpA) {BSfree_comm(mbs->comm_fpA);CHKERRBS(0);}
2030: mbs->comm_fpA = BSsetup_factor(mbs->fpA,mbs->procinfo);CHKERRBS(0);
2032: /*
2033: Create a new Mat structure to hold the "factored" matrix,
2034: not this merely contains a pointer to the original matrix, since
2035: the original matrix contains the factor information.
2036: */
2037: PetscHeaderCreate(newmat,_p_Mat,struct _MatOps,MAT_COOKIE,-1,"Mat",((PetscObject)mat)->comm,MatDestroy,MatView);
2039: newmat->data = (void*)mat;
2040: PetscMemcpy(newmat->ops,&MatOps_Values,sizeof(struct _MatOps));
2041: newmat->ops->destroy = MatDestroy_MPIRowbs_Factored;
2042: newmat->ops->view = MatView_MPIRowbs_Factored;
2043: newmat->factor = 1;
2044: newmat->preallocated = PETSC_TRUE;
2046: PetscMapCopy(((PetscObject)mat)->comm,mat->rmap,newmat->rmap);
2047: PetscMapCopy(((PetscObject)mat)->comm,mat->cmap,newmat->cmap);
2049: PetscStrallocpy(MATMPIROWBS,&((PetscObject)newmat)->type_name);
2051: newmat->ops->lufactornumeric = MatLUFactorNumeric_MPIRowbs;
2052: *newfact = newmat;
2053: return(0);
2054: }
2058: /*@C
2059: MatCreateMPIRowbs - Creates a sparse parallel matrix in the MATMPIROWBS
2060: format. This format is intended primarily as an interface for BlockSolve95.
2062: Collective on MPI_Comm
2064: Input Parameters:
2065: + comm - MPI communicator
2066: . m - number of local rows (or PETSC_DECIDE to have calculated)
2067: . M - number of global rows (or PETSC_DECIDE to have calculated)
2068: . nz - number of nonzeros per row (same for all local rows)
2069: - nnz - number of nonzeros per row (possibly different for each row).
2071: Output Parameter:
2072: . newA - the matrix
2074: Notes:
2075: If PETSC_DECIDE or PETSC_DETERMINE is used for a particular argument on one processor
2076: than it must be used on all processors that share the object for that argument.
2078: The user MUST specify either the local or global matrix dimensions
2079: (possibly both).
2081: Specify the preallocated storage with either nz or nnz (not both). Set
2082: nz=PETSC_DEFAULT and nnz=PETSC_NULL for PETSc to control dynamic memory
2083: allocation.
2085: Notes:
2086: By default, the matrix is assumed to be nonsymmetric; the user can
2087: take advantage of special optimizations for symmetric matrices by calling
2088: $ MatSetOption(mat,MAT_SYMMETRIC,PETSC_TRUE)
2089: $ MatSetOption(mat,MAT_SYMMETRY_ETERNAL,PETSC_TRUE)
2090: BEFORE calling the routine MatAssemblyBegin().
2092: Internally, the MATMPIROWBS format inserts zero elements to the
2093: matrix if necessary, so that nonsymmetric matrices are considered
2094: to be symmetric in terms of their sparsity structure; this format
2095: is required for use of the parallel communication routines within
2096: BlockSolve95. In particular, if the matrix element A[i,j] exists,
2097: then PETSc will internally allocate a 0 value for the element
2098: A[j,i] during MatAssemblyEnd() if the user has not already set
2099: a value for the matrix element A[j,i].
2101: Options Database Keys:
2102: . -mat_rowbs_no_inode - Do not use inodes.
2104: Level: intermediate
2105:
2106: .keywords: matrix, row, symmetric, sparse, parallel, BlockSolve
2108: .seealso: MatCreate(), MatSetValues()
2109: @*/
2110: PetscErrorCode MatCreateMPIRowbs(MPI_Comm comm,int m,int M,int nz,const int nnz[],Mat *newA)
2111: {
2113:
2115: MatCreate(comm,newA);
2116: MatSetSizes(*newA,m,m,M,M);
2117: MatSetType(*newA,MATMPIROWBS);
2118: MatMPIRowbsSetPreallocation(*newA,nz,nnz);
2119: return(0);
2120: }
2123: /* -------------------------------------------------------------------------*/
2125: #include ../src/mat/impls/aij/seq/aij.h
2126: #include ../src/mat/impls/aij/mpi/mpiaij.h
2130: PetscErrorCode MatGetSubMatrices_MPIRowbs(Mat C,int ismax,const IS isrow[],const IS iscol[],MatReuse scall,Mat *submat[])
2131: {
2133: int nmax,nstages_local,nstages,i,pos,max_no;
2137: /* Allocate memory to hold all the submatrices */
2138: if (scall != MAT_REUSE_MATRIX) {
2139: PetscMalloc((ismax+1)*sizeof(Mat),submat);
2140: }
2141:
2142: /* Determine the number of stages through which submatrices are done */
2143: nmax = 20*1000000 / (C->cmap->N * sizeof(int));
2144: if (!nmax) nmax = 1;
2145: nstages_local = ismax/nmax + ((ismax % nmax)?1:0);
2147: /* Make sure every processor loops through the nstages */
2148: MPI_Allreduce(&nstages_local,&nstages,1,MPI_INT,MPI_MAX,((PetscObject)C)->comm);
2150: for (i=0,pos=0; i<nstages; i++) {
2151: if (pos+nmax <= ismax) max_no = nmax;
2152: else if (pos == ismax) max_no = 0;
2153: else max_no = ismax-pos;
2154: MatGetSubMatrices_MPIRowbs_Local(C,max_no,isrow+pos,iscol+pos,scall,*submat+pos);
2155: pos += max_no;
2156: }
2157: return(0);
2158: }
2159: /* -------------------------------------------------------------------------*/
2160: /* for now MatGetSubMatrices_MPIRowbs_Local get MPIAij submatrices of input
2161: matrix and preservs zeroes from structural symetry
2162: */
2165: PetscErrorCode MatGetSubMatrices_MPIRowbs_Local(Mat C,int ismax,const IS isrow[],const IS iscol[],MatReuse scall,Mat *submats)
2166: {
2167: Mat_MPIRowbs *c = (Mat_MPIRowbs *)(C->data);
2168: BSspmat *A = c->A;
2169: Mat_SeqAIJ *mat;
2171: const int **irow,**icol,*irow_i;
2172: int *nrow,*ncol,*w1,*w2,*w3,*w4,*rtable,start,end,size;
2173: int **sbuf1,**sbuf2,rank,m,i,j,k,l,ct1,ct2,**rbuf1,row,proc;
2174: int nrqs,msz,**ptr,idx,*req_size,*ctr,*pa,*tmp,tcol,nrqr;
2175: int **rbuf3,*req_source,**sbuf_aj,**rbuf2,max1,max2,**rmap;
2176: int **cmap,**lens,is_no,ncols,*cols,mat_i,*mat_j,tmp2,jmax;
2177: int len,ctr_j,*sbuf1_j,*sbuf_aj_i,*rbuf1_i,kmax,*cmap_i,*lens_i;
2178: int *rmap_i,tag0,tag1,tag2,tag3;
2179: MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2,*r_waits3;
2180: MPI_Request *r_waits4,*s_waits3,*s_waits4;
2181: MPI_Status *r_status1,*r_status2,*s_status1,*s_status3,*s_status2;
2182: MPI_Status *r_status3,*r_status4,*s_status4;
2183: MPI_Comm comm;
2184: FLOAT **rbuf4,**sbuf_aa,*vals,*sbuf_aa_i;
2185: PetscScalar *mat_a;
2186: PetscTruth sorted;
2187: int *onodes1,*olengths1;
2190: comm = ((PetscObject)C)->comm;
2191: tag0 = ((PetscObject)C)->tag;
2192: size = c->size;
2193: rank = c->rank;
2194: m = C->rmap->N;
2195:
2196: /* Get some new tags to keep the communication clean */
2197: PetscObjectGetNewTag((PetscObject)C,&tag1);
2198: PetscObjectGetNewTag((PetscObject)C,&tag2);
2199: PetscObjectGetNewTag((PetscObject)C,&tag3);
2201: /* Check if the col indices are sorted */
2202: for (i=0; i<ismax; i++) {
2203: ISSorted(isrow[i],&sorted);
2204: if (!sorted) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"ISrow is not sorted");
2205: ISSorted(iscol[i],&sorted);
2206: /* if (!sorted) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"IScol is not sorted"); */
2207: }
2209: len = (2*ismax+1)*(sizeof(int*)+ sizeof(int)) + (m+1)*sizeof(int);
2210: PetscMalloc(len,&irow);
2211: icol = irow + ismax;
2212: nrow = (int*)(icol + ismax);
2213: ncol = nrow + ismax;
2214: rtable = ncol + ismax;
2216: for (i=0; i<ismax; i++) {
2217: ISGetIndices(isrow[i],&irow[i]);
2218: ISGetIndices(iscol[i],&icol[i]);
2219: ISGetLocalSize(isrow[i],&nrow[i]);
2220: ISGetLocalSize(iscol[i],&ncol[i]);
2221: }
2223: /* Create hash table for the mapping :row -> proc*/
2224: for (i=0,j=0; i<size; i++) {
2225: jmax = C->rmap->range[i+1];
2226: for (; j<jmax; j++) {
2227: rtable[j] = i;
2228: }
2229: }
2231: /* evaluate communication - mesg to who, length of mesg, and buffer space
2232: required. Based on this, buffers are allocated, and data copied into them*/
2233: PetscMalloc(size*4*sizeof(int),&w1); /* mesg size */
2234: w2 = w1 + size; /* if w2[i] marked, then a message to proc i*/
2235: w3 = w2 + size; /* no of IS that needs to be sent to proc i */
2236: w4 = w3 + size; /* temp work space used in determining w1, w2, w3 */
2237: PetscMemzero(w1,size*3*sizeof(int)); /* initialize work vector*/
2238: for (i=0; i<ismax; i++) {
2239: PetscMemzero(w4,size*sizeof(int)); /* initialize work vector*/
2240: jmax = nrow[i];
2241: irow_i = irow[i];
2242: for (j=0; j<jmax; j++) {
2243: row = irow_i[j];
2244: proc = rtable[row];
2245: w4[proc]++;
2246: }
2247: for (j=0; j<size; j++) {
2248: if (w4[j]) { w1[j] += w4[j]; w3[j]++;}
2249: }
2250: }
2251:
2252: nrqs = 0; /* no of outgoing messages */
2253: msz = 0; /* total mesg length (for all procs) */
2254: w1[rank] = 0; /* no mesg sent to self */
2255: w3[rank] = 0;
2256: for (i=0; i<size; i++) {
2257: if (w1[i]) { w2[i] = 1; nrqs++;} /* there exists a message to proc i */
2258: }
2259: PetscMalloc((nrqs+1)*sizeof(int),&pa); /*(proc -array)*/
2260: for (i=0,j=0; i<size; i++) {
2261: if (w1[i]) { pa[j] = i; j++; }
2262: }
2264: /* Each message would have a header = 1 + 2*(no of IS) + data */
2265: for (i=0; i<nrqs; i++) {
2266: j = pa[i];
2267: w1[j] += w2[j] + 2* w3[j];
2268: msz += w1[j];
2269: }
2271: /* Determine the number of messages to expect, their lengths, from from-ids */
2272: PetscGatherNumberOfMessages(comm,w2,w1,&nrqr);
2273: PetscGatherMessageLengths(comm,nrqs,nrqr,w1,&onodes1,&olengths1);
2275: /* Now post the Irecvs corresponding to these messages */
2276: PetscPostIrecvInt(comm,tag0,nrqr,onodes1,olengths1,&rbuf1,&r_waits1);
2277:
2278: PetscFree(onodes1);
2279: PetscFree(olengths1);
2280:
2281: /* Allocate Memory for outgoing messages */
2282: len = 2*size*sizeof(int*) + 2*msz*sizeof(int) + size*sizeof(int);
2283: PetscMalloc(len,&sbuf1);
2284: ptr = sbuf1 + size; /* Pointers to the data in outgoing buffers */
2285: PetscMemzero(sbuf1,2*size*sizeof(int*));
2286: /* allocate memory for outgoing data + buf to receive the first reply */
2287: tmp = (int*)(ptr + size);
2288: ctr = tmp + 2*msz;
2290: {
2291: int *iptr = tmp,ict = 0;
2292: for (i=0; i<nrqs; i++) {
2293: j = pa[i];
2294: iptr += ict;
2295: sbuf1[j] = iptr;
2296: ict = w1[j];
2297: }
2298: }
2300: /* Form the outgoing messages */
2301: /* Initialize the header space */
2302: for (i=0; i<nrqs; i++) {
2303: j = pa[i];
2304: sbuf1[j][0] = 0;
2305: PetscMemzero(sbuf1[j]+1,2*w3[j]*sizeof(int));
2306: ptr[j] = sbuf1[j] + 2*w3[j] + 1;
2307: }
2308:
2309: /* Parse the isrow and copy data into outbuf */
2310: for (i=0; i<ismax; i++) {
2311: PetscMemzero(ctr,size*sizeof(int));
2312: irow_i = irow[i];
2313: jmax = nrow[i];
2314: for (j=0; j<jmax; j++) { /* parse the indices of each IS */
2315: row = irow_i[j];
2316: proc = rtable[row];
2317: if (proc != rank) { /* copy to the outgoing buf*/
2318: ctr[proc]++;
2319: *ptr[proc] = row;
2320: ptr[proc]++;
2321: }
2322: }
2323: /* Update the headers for the current IS */
2324: for (j=0; j<size; j++) { /* Can Optimise this loop too */
2325: if ((ctr_j = ctr[j])) {
2326: sbuf1_j = sbuf1[j];
2327: k = ++sbuf1_j[0];
2328: sbuf1_j[2*k] = ctr_j;
2329: sbuf1_j[2*k-1] = i;
2330: }
2331: }
2332: }
2334: /* Now post the sends */
2335: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&s_waits1);
2336: for (i=0; i<nrqs; ++i) {
2337: j = pa[i];
2338: MPI_Isend(sbuf1[j],w1[j],MPI_INT,j,tag0,comm,s_waits1+i);
2339: }
2341: /* Post Receives to capture the buffer size */
2342: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits2);
2343: PetscMalloc((nrqs+1)*sizeof(int*),&rbuf2);
2344: rbuf2[0] = tmp + msz;
2345: for (i=1; i<nrqs; ++i) {
2346: rbuf2[i] = rbuf2[i-1]+w1[pa[i-1]];
2347: }
2348: for (i=0; i<nrqs; ++i) {
2349: j = pa[i];
2350: MPI_Irecv(rbuf2[i],w1[j],MPI_INT,j,tag1,comm,r_waits2+i);
2351: }
2353: /* Send to other procs the buf size they should allocate */
2354:
2356: /* Receive messages*/
2357: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits2);
2358: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&r_status1);
2359: len = 2*nrqr*sizeof(int) + (nrqr+1)*sizeof(int*);
2360: PetscMalloc(len,&sbuf2);
2361: req_size = (int*)(sbuf2 + nrqr);
2362: req_source = req_size + nrqr;
2363:
2364: {
2365: BSsprow **sAi = A->rows;
2366: int id,rstart = C->rmap->rstart;
2367: int *sbuf2_i;
2369: for (i=0; i<nrqr; ++i) {
2370: MPI_Waitany(nrqr,r_waits1,&idx,r_status1+i);
2371: req_size[idx] = 0;
2372: rbuf1_i = rbuf1[idx];
2373: start = 2*rbuf1_i[0] + 1;
2374: MPI_Get_count(r_status1+i,MPI_INT,&end);
2375: PetscMalloc((end+1)*sizeof(int),&sbuf2[idx]);
2376: sbuf2_i = sbuf2[idx];
2377: for (j=start; j<end; j++) {
2378: id = rbuf1_i[j] - rstart;
2379: ncols = (sAi[id])->length;
2380: sbuf2_i[j] = ncols;
2381: req_size[idx] += ncols;
2382: }
2383: req_source[idx] = r_status1[i].MPI_SOURCE;
2384: /* form the header */
2385: sbuf2_i[0] = req_size[idx];
2386: for (j=1; j<start; j++) { sbuf2_i[j] = rbuf1_i[j]; }
2387: MPI_Isend(sbuf2_i,end,MPI_INT,req_source[idx],tag1,comm,s_waits2+i);
2388: }
2389: }
2390: PetscFree(r_status1);
2391: PetscFree(r_waits1);
2393: /* recv buffer sizes */
2394: /* Receive messages*/
2395:
2396: PetscMalloc((nrqs+1)*sizeof(int*),&rbuf3);
2397: PetscMalloc((nrqs+1)*sizeof(FLOAT *),&rbuf4);
2398: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits3);
2399: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits4);
2400: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status2);
2402: for (i=0; i<nrqs; ++i) {
2403: MPI_Waitany(nrqs,r_waits2,&idx,r_status2+i);
2404: PetscMalloc((rbuf2[idx][0]+1)*sizeof(int),&rbuf3[idx]);
2405: PetscMalloc((rbuf2[idx][0]+1)*sizeof(FLOAT),&rbuf4[idx]);
2406: MPI_Irecv(rbuf3[idx],rbuf2[idx][0],MPI_INT,r_status2[i].MPI_SOURCE,tag2,comm,r_waits3+idx);
2407: MPI_Irecv(rbuf4[idx],rbuf2[idx][0],MPIU_SCALAR,r_status2[i].MPI_SOURCE,tag3,comm,r_waits4+idx);
2408: }
2409: PetscFree(r_status2);
2410: PetscFree(r_waits2);
2411:
2412: /* Wait on sends1 and sends2 */
2413: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&s_status1);
2414: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status2);
2416: if (nrqs) {MPI_Waitall(nrqs,s_waits1,s_status1);}
2417: if (nrqr) {MPI_Waitall(nrqr,s_waits2,s_status2);}
2418: PetscFree(s_status1);
2419: PetscFree(s_status2);
2420: PetscFree(s_waits1);
2421: PetscFree(s_waits2);
2423: /* Now allocate buffers for a->j, and send them off */
2424: PetscMalloc((nrqr+1)*sizeof(int*),&sbuf_aj);
2425: for (i=0,j=0; i<nrqr; i++) j += req_size[i];
2426: PetscMalloc((j+1)*sizeof(int),&sbuf_aj[0]);
2427: for (i=1; i<nrqr; i++) sbuf_aj[i] = sbuf_aj[i-1] + req_size[i-1];
2428:
2429: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits3);
2430: {
2431: BSsprow *brow;
2432: int *Acol;
2433: int rstart = C->rmap->rstart;
2435: for (i=0; i<nrqr; i++) {
2436: rbuf1_i = rbuf1[i];
2437: sbuf_aj_i = sbuf_aj[i];
2438: ct1 = 2*rbuf1_i[0] + 1;
2439: ct2 = 0;
2440: for (j=1,max1=rbuf1_i[0]; j<=max1; j++) {
2441: kmax = rbuf1[i][2*j];
2442: for (k=0; k<kmax; k++,ct1++) {
2443: brow = A->rows[rbuf1_i[ct1] - rstart];
2444: ncols = brow->length;
2445: Acol = brow->col;
2446: /* load the column indices for this row into cols*/
2447: cols = sbuf_aj_i + ct2;
2448: PetscMemcpy(cols,Acol,ncols*sizeof(int));
2449: /*for (l=0; l<ncols;l++) cols[l]=Acol[l]; */ /* How is it with
2450: mappings?? */
2451: ct2 += ncols;
2452: }
2453: }
2454: MPI_Isend(sbuf_aj_i,req_size[i],MPI_INT,req_source[i],tag2,comm,s_waits3+i);
2455: }
2456: }
2457: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status3);
2458: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status3);
2460: /* Allocate buffers for a->a, and send them off */
2461: PetscMalloc((nrqr+1)*sizeof(FLOAT*),&sbuf_aa);
2462: for (i=0,j=0; i<nrqr; i++) j += req_size[i];
2463: PetscMalloc((j+1)*sizeof(FLOAT),&sbuf_aa[0]);
2464: for (i=1; i<nrqr; i++) sbuf_aa[i] = sbuf_aa[i-1] + req_size[i-1];
2465:
2466: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits4);
2467: {
2468: BSsprow *brow;
2469: FLOAT *Aval;
2470: int rstart = C->rmap->rstart;
2471:
2472: for (i=0; i<nrqr; i++) {
2473: rbuf1_i = rbuf1[i];
2474: sbuf_aa_i = sbuf_aa[i];
2475: ct1 = 2*rbuf1_i[0]+1;
2476: ct2 = 0;
2477: for (j=1,max1=rbuf1_i[0]; j<=max1; j++) {
2478: kmax = rbuf1_i[2*j];
2479: for (k=0; k<kmax; k++,ct1++) {
2480: brow = A->rows[rbuf1_i[ct1] - rstart];
2481: ncols = brow->length;
2482: Aval = brow->nz;
2483: /* load the column values for this row into vals*/
2484: vals = sbuf_aa_i+ct2;
2485: PetscMemcpy(vals,Aval,ncols*sizeof(FLOAT));
2486: ct2 += ncols;
2487: }
2488: }
2489: MPI_Isend(sbuf_aa_i,req_size[i],MPIU_SCALAR,req_source[i],tag3,comm,s_waits4+i);
2490: }
2491: }
2492: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status4);
2493: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status4);
2494: PetscFree(rbuf1);
2496: /* Form the matrix */
2497: /* create col map */
2498: {
2499: int *icol_i;
2500:
2501: len = (1+ismax)*sizeof(int*)+ ismax*C->cmap->N*sizeof(int);
2502: PetscMalloc(len,&cmap);
2503: cmap[0] = (int*)(cmap + ismax);
2504: PetscMemzero(cmap[0],(1+ismax*C->cmap->N)*sizeof(int));
2505: for (i=1; i<ismax; i++) { cmap[i] = cmap[i-1] + C->cmap->N; }
2506: for (i=0; i<ismax; i++) {
2507: jmax = ncol[i];
2508: icol_i = icol[i];
2509: cmap_i = cmap[i];
2510: for (j=0; j<jmax; j++) {
2511: cmap_i[icol_i[j]] = j+1;
2512: }
2513: }
2514: }
2516: /* Create lens which is required for MatCreate... */
2517: for (i=0,j=0; i<ismax; i++) { j += nrow[i]; }
2518: len = (1+ismax)*sizeof(int*)+ j*sizeof(int);
2519: PetscMalloc(len,&lens);
2520: lens[0] = (int*)(lens + ismax);
2521: PetscMemzero(lens[0],j*sizeof(int));
2522: for (i=1; i<ismax; i++) { lens[i] = lens[i-1] + nrow[i-1]; }
2523:
2524: /* Update lens from local data */
2525: { BSsprow *Arow;
2526: for (i=0; i<ismax; i++) {
2527: jmax = nrow[i];
2528: cmap_i = cmap[i];
2529: irow_i = irow[i];
2530: lens_i = lens[i];
2531: for (j=0; j<jmax; j++) {
2532: row = irow_i[j];
2533: proc = rtable[row];
2534: if (proc == rank) {
2535: Arow=A->rows[row-C->rmap->rstart];
2536: ncols=Arow->length;
2537: cols=Arow->col;
2538: for (k=0; k<ncols; k++) {
2539: if (cmap_i[cols[k]]) { lens_i[j]++;}
2540: }
2541: }
2542: }
2543: }
2544: }
2545:
2546: /* Create row map*/
2547: len = (1+ismax)*sizeof(int*)+ ismax*C->rmap->N*sizeof(int);
2548: PetscMalloc(len,&rmap);
2549: rmap[0] = (int*)(rmap + ismax);
2550: PetscMemzero(rmap[0],ismax*C->rmap->N*sizeof(int));
2551: for (i=1; i<ismax; i++) { rmap[i] = rmap[i-1] + C->rmap->N;}
2552: for (i=0; i<ismax; i++) {
2553: rmap_i = rmap[i];
2554: irow_i = irow[i];
2555: jmax = nrow[i];
2556: for (j=0; j<jmax; j++) {
2557: rmap_i[irow_i[j]] = j;
2558: }
2559: }
2560:
2561: /* Update lens from offproc data */
2562: {
2563: int *rbuf2_i,*rbuf3_i,*sbuf1_i;
2565: for (tmp2=0; tmp2<nrqs; tmp2++) {
2566: MPI_Waitany(nrqs,r_waits3,&i,r_status3+tmp2);
2567: idx = pa[i];
2568: sbuf1_i = sbuf1[idx];
2569: jmax = sbuf1_i[0];
2570: ct1 = 2*jmax+1;
2571: ct2 = 0;
2572: rbuf2_i = rbuf2[i];
2573: rbuf3_i = rbuf3[i];
2574: for (j=1; j<=jmax; j++) {
2575: is_no = sbuf1_i[2*j-1];
2576: max1 = sbuf1_i[2*j];
2577: lens_i = lens[is_no];
2578: cmap_i = cmap[is_no];
2579: rmap_i = rmap[is_no];
2580: for (k=0; k<max1; k++,ct1++) {
2581: row = rmap_i[sbuf1_i[ct1]]; /* the val in the new matrix to be */
2582: max2 = rbuf2_i[ct1];
2583: for (l=0; l<max2; l++,ct2++) {
2584: if (cmap_i[rbuf3_i[ct2]]) {
2585: lens_i[row]++;
2586: }
2587: }
2588: }
2589: }
2590: }
2591: }
2592: PetscFree(r_status3);
2593: PetscFree(r_waits3);
2594: if (nrqr) {MPI_Waitall(nrqr,s_waits3,s_status3);}
2595: PetscFree(s_status3);
2596: PetscFree(s_waits3);
2598: /* Create the submatrices */
2599: if (scall == MAT_REUSE_MATRIX) {
2600: PetscTruth same;
2601:
2602: /*
2603: Assumes new rows are same length as the old rows,hence bug!
2604: */
2605: for (i=0; i<ismax; i++) {
2606: PetscTypeCompare((PetscObject)(submats[i]),MATSEQAIJ,&same);
2607: if (!same) {
2608: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong type");
2609: }
2610: mat = (Mat_SeqAIJ*)(submats[i]->data);
2611: if ((submats[i]->rmap->n != nrow[i]) || (submats[i]->cmap->n != ncol[i])) {
2612: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size");
2613: }
2614: PetscMemcmp(mat->ilen,lens[i],submats[i]->rmap->n*sizeof(int),&same);
2615: if (!same) {
2616: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong no of nonzeros");
2617: }
2618: /* Initial matrix as if empty */
2619: PetscMemzero(mat->ilen,submats[i]->rmap->n*sizeof(int));
2620: submats[i]->factor = C->factor;
2621: }
2622: } else {
2623: for (i=0; i<ismax; i++) {
2624: /* Here we want to explicitly generate SeqAIJ matrices */
2625: MatCreate(PETSC_COMM_SELF,submats+i);
2626: MatSetSizes(submats[i],nrow[i],ncol[i],nrow[i],ncol[i]);
2627: MatSetType(submats[i],MATSEQAIJ);
2628: MatSeqAIJSetPreallocation(submats[i],0,lens[i]);
2629: }
2630: }
2632: /* Assemble the matrices */
2633: /* First assemble the local rows */
2634: {
2635: int ilen_row,*imat_ilen,*imat_j,*imat_i,old_row;
2636: PetscScalar *imat_a;
2637: BSsprow *Arow;
2638:
2639: for (i=0; i<ismax; i++) {
2640: mat = (Mat_SeqAIJ*)submats[i]->data;
2641: imat_ilen = mat->ilen;
2642: imat_j = mat->j;
2643: imat_i = mat->i;
2644: imat_a = mat->a;
2645: cmap_i = cmap[i];
2646: rmap_i = rmap[i];
2647: irow_i = irow[i];
2648: jmax = nrow[i];
2649: for (j=0; j<jmax; j++) {
2650: row = irow_i[j];
2651: proc = rtable[row];
2652: if (proc == rank) {
2653: old_row = row;
2654: row = rmap_i[row];
2655: ilen_row = imat_ilen[row];
2656:
2657: Arow=A->rows[old_row-C->rmap->rstart];
2658: ncols=Arow->length;
2659: cols=Arow->col;
2660: vals=Arow->nz;
2661:
2662: mat_i = imat_i[row];
2663: mat_a = imat_a + mat_i;
2664: mat_j = imat_j + mat_i;
2665: for (k=0; k<ncols; k++) {
2666: if ((tcol = cmap_i[cols[k]])) {
2667: *mat_j++ = tcol - 1;
2668: *mat_a++ = (PetscScalar)vals[k];
2669: ilen_row++;
2670: }
2671: }
2672: imat_ilen[row] = ilen_row;
2673: }
2674: }
2675: }
2676: }
2678: /* Now assemble the off proc rows*/
2679: {
2680: int *sbuf1_i,*rbuf2_i,*rbuf3_i,*imat_ilen,ilen;
2681: int *imat_j,*imat_i;
2682: PetscScalar *imat_a;
2683: FLOAT *rbuf4_i;
2684:
2685: for (tmp2=0; tmp2<nrqs; tmp2++) {
2686: MPI_Waitany(nrqs,r_waits4,&i,r_status4+tmp2);
2687: idx = pa[i];
2688: sbuf1_i = sbuf1[idx];
2689: jmax = sbuf1_i[0];
2690: ct1 = 2*jmax + 1;
2691: ct2 = 0;
2692: rbuf2_i = rbuf2[i];
2693: rbuf3_i = rbuf3[i];
2694: rbuf4_i = rbuf4[i];
2695: for (j=1; j<=jmax; j++) {
2696: is_no = sbuf1_i[2*j-1];
2697: rmap_i = rmap[is_no];
2698: cmap_i = cmap[is_no];
2699: mat = (Mat_SeqAIJ*)submats[is_no]->data;
2700: imat_ilen = mat->ilen;
2701: imat_j = mat->j;
2702: imat_i = mat->i;
2703: imat_a = mat->a;
2704: max1 = sbuf1_i[2*j];
2705: for (k=0; k<max1; k++,ct1++) {
2706: row = sbuf1_i[ct1];
2707: row = rmap_i[row];
2708: ilen = imat_ilen[row];
2709: mat_i = imat_i[row];
2710: mat_a = imat_a + mat_i;
2711: mat_j = imat_j + mat_i;
2712: max2 = rbuf2_i[ct1];
2713: for (l=0; l<max2; l++,ct2++) {
2714: if ((tcol = cmap_i[rbuf3_i[ct2]])) {
2715: *mat_j++ = tcol - 1;
2716: *mat_a++ = (PetscScalar)rbuf4_i[ct2];
2717: ilen++;
2718: }
2719: }
2720: imat_ilen[row] = ilen;
2721: }
2722: }
2723: }
2724: }
2725: PetscFree(r_status4);
2726: PetscFree(r_waits4);
2727: if (nrqr) {MPI_Waitall(nrqr,s_waits4,s_status4);}
2728: PetscFree(s_waits4);
2729: PetscFree(s_status4);
2731: /* Restore the indices */
2732: for (i=0; i<ismax; i++) {
2733: ISRestoreIndices(isrow[i],irow+i);
2734: ISRestoreIndices(iscol[i],icol+i);
2735: }
2737: /* Destroy allocated memory */
2738: PetscFree(irow);
2739: PetscFree(w1);
2740: PetscFree(pa);
2742: PetscFree(sbuf1);
2743: PetscFree(rbuf2);
2744: for (i=0; i<nrqr; ++i) {
2745: PetscFree(sbuf2[i]);
2746: }
2747: for (i=0; i<nrqs; ++i) {
2748: PetscFree(rbuf3[i]);
2749: PetscFree(rbuf4[i]);
2750: }
2752: PetscFree(sbuf2);
2753: PetscFree(rbuf3);
2754: PetscFree(rbuf4);
2755: PetscFree(sbuf_aj[0]);
2756: PetscFree(sbuf_aj);
2757: PetscFree(sbuf_aa[0]);
2758: PetscFree(sbuf_aa);
2759:
2760: PetscFree(cmap);
2761: PetscFree(rmap);
2762: PetscFree(lens);
2764: for (i=0; i<ismax; i++) {
2765: MatAssemblyBegin(submats[i],MAT_FINAL_ASSEMBLY);
2766: MatAssemblyEnd(submats[i],MAT_FINAL_ASSEMBLY);
2767: }
2768: return(0);
2769: }
2771: /*
2772: can be optimized by send only non-zeroes in iscol IS -
2773: so prebuild submatrix on sending side including A,B partitioning
2774: */
2777: #include ../src/vec/is/impls/general/general.h
2778: PetscErrorCode MatGetSubMatrix_MPIRowbs(Mat C,IS isrow,IS iscol,int csize,MatReuse scall,Mat *submat)
2779: {
2780: Mat_MPIRowbs *c = (Mat_MPIRowbs*)C->data;
2781: BSspmat *A = c->A;
2782: BSsprow *Arow;
2783: Mat_SeqAIJ *matA,*matB; /* on prac , off proc part of submat */
2784: Mat_MPIAIJ *mat; /* submat->data */
2786: const int *irow,*icol;
2787: int nrow,ncol,*rtable,size,rank,tag0,tag1,tag2,tag3;
2788: int *w1,*w2,*pa,nrqs,nrqr,msz,row_t;
2789: int i,j,k,l,len,jmax,proc,idx;
2790: int **sbuf1,**sbuf2,**rbuf1,**rbuf2,*req_size,**sbuf3,**rbuf3;
2791: FLOAT **rbuf4,**sbuf4; /* FLOAT is from Block Solve 95 library */
2793: int *cmap,*rmap,nlocal,*o_nz,*d_nz,cstart,cend;
2794: int *req_source;
2795: int ncols_t;
2796:
2797:
2798: MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2,*r_waits3;
2799: MPI_Request *r_waits4,*s_waits3,*s_waits4;
2800:
2801: MPI_Status *r_status1,*r_status2,*s_status1,*s_status3,*s_status2;
2802: MPI_Status *r_status3,*r_status4,*s_status4;
2803: MPI_Comm comm;
2807: comm = ((PetscObject)C)->comm;
2808: tag0 = ((PetscObject)C)->tag;
2809: size = c->size;
2810: rank = c->rank;
2812: if (size==1) {
2813: if (scall == MAT_REUSE_MATRIX) {
2814: ierr=MatGetSubMatrices(C,1,&isrow,&iscol,MAT_REUSE_MATRIX,&submat);
2815: return(0);
2816: } else {
2817: Mat *newsubmat;
2818:
2819: ierr=MatGetSubMatrices(C,1,&isrow,&iscol,MAT_INITIAL_MATRIX,&newsubmat);
2820: *submat=*newsubmat;
2821: ierr=PetscFree(newsubmat);
2822: return(0);
2823: }
2824: }
2825:
2826: /* Get some new tags to keep the communication clean */
2827: PetscObjectGetNewTag((PetscObject)C,&tag1);
2828: PetscObjectGetNewTag((PetscObject)C,&tag2);
2829: PetscObjectGetNewTag((PetscObject)C,&tag3);
2831: /* Check if the col indices are sorted */
2832: {PetscTruth sorted;
2833: ISSorted(isrow,&sorted);
2834: if (!sorted) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"ISrow is not sorted");
2835: ISSorted(iscol,&sorted);
2836: if (!sorted) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"IScol is not sorted");
2837: }
2838:
2839: ISGetIndices(isrow,&irow);
2840: ISGetIndices(iscol,&icol);
2841: ISGetLocalSize(isrow,&nrow);
2842: ISGetLocalSize(iscol,&ncol);
2843:
2844: if (!isrow) SETERRQ(PETSC_ERR_ARG_SIZ,"Empty ISrow");
2845: if (!iscol) SETERRQ(PETSC_ERR_ARG_SIZ,"Empty IScol");
2846:
2847:
2848: len = (C->rmap->N+1)*sizeof(int);
2849: PetscMalloc(len,&rtable);
2850: /* Create hash table for the mapping :row -> proc*/
2851: for (i=0,j=0; i<size; i++) {
2852: jmax = C->rmap->range[i+1];
2853: for (; j<jmax; j++) {
2854: rtable[j] = i;
2855: }
2856: }
2858: /* evaluate communication - mesg to who, length of mesg, and buffer space
2859: required. Based on this, buffers are allocated, and data copied into them*/
2860: PetscMalloc(size*2*sizeof(int),&w1); /* mesg size */
2861: w2 = w1 + size; /* if w2[i] marked, then a message to proc i*/
2862: PetscMemzero(w1,size*2*sizeof(int)); /* initialize work vector*/
2863: for (j=0; j<nrow; j++) {
2864: row_t = irow[j];
2865: proc = rtable[row_t];
2866: w1[proc]++;
2867: }
2868: nrqs = 0; /* no of outgoing messages */
2869: msz = 0; /* total mesg length (for all procs) */
2870: w1[rank] = 0; /* no mesg sent to self */
2871: for (i=0; i<size; i++) {
2872: if (w1[i]) { w2[i] = 1; nrqs++;} /* there exists a message to proc i */
2873: }
2874:
2875: PetscMalloc((nrqs+1)*sizeof(int),&pa); /*(proc -array)*/
2876: for (i=0,j=0; i<size; i++) {
2877: if (w1[i]) {
2878: pa[j++] = i;
2879: w1[i]++; /* header for return data */
2880: msz+=w1[i];
2881: }
2882: }
2883:
2884: {int *onodes1,*olengths1;
2885: /* Determine the number of messages to expect, their lengths, from from-ids */
2886: PetscGatherNumberOfMessages(comm,w2,w1,&nrqr);
2887: PetscGatherMessageLengths(comm,nrqs,nrqr,w1,&onodes1,&olengths1);
2888: /* Now post the Irecvs corresponding to these messages */
2889: PetscPostIrecvInt(comm,tag0,nrqr,onodes1,olengths1,&rbuf1,&r_waits1);
2890: PetscFree(onodes1);
2891: PetscFree(olengths1);
2892: }
2893:
2894: { int **ptr,*iptr,*tmp;
2895: /* Allocate Memory for outgoing messages */
2896: len = 2*size*sizeof(int*) + msz*sizeof(int);
2897: PetscMalloc(len,&sbuf1);
2898: ptr = sbuf1 + size; /* Pointers to the data in outgoing buffers */
2899: PetscMemzero(sbuf1,2*size*sizeof(int*));
2900: /* allocate memory for outgoing data + buf to receive the first reply */
2901: tmp = (int*)(ptr + size);
2903: for (i=0,iptr=tmp; i<nrqs; i++) {
2904: j = pa[i];
2905: sbuf1[j] = iptr;
2906: iptr += w1[j];
2907: }
2909: /* Form the outgoing messages */
2910: for (i=0; i<nrqs; i++) {
2911: j = pa[i];
2912: sbuf1[j][0] = 0; /*header */
2913: ptr[j] = sbuf1[j] + 1;
2914: }
2915:
2916: /* Parse the isrow and copy data into outbuf */
2917: for (j=0; j<nrow; j++) {
2918: row_t = irow[j];
2919: proc = rtable[row_t];
2920: if (proc != rank) { /* copy to the outgoing buf*/
2921: sbuf1[proc][0]++;
2922: *ptr[proc] = row_t;
2923: ptr[proc]++;
2924: }
2925: }
2926: } /* block */
2928: /* Now post the sends */
2929:
2930: /* structure of sbuf1[i]/rbuf1[i] : 1 (num of rows) + nrow-local rows (nuberes
2931: * of requested rows)*/
2933: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&s_waits1);
2934: for (i=0; i<nrqs; ++i) {
2935: j = pa[i];
2936: MPI_Isend(sbuf1[j],w1[j],MPI_INT,j,tag0,comm,s_waits1+i);
2937: }
2939: /* Post Receives to capture the buffer size */
2940: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits2);
2941: PetscMalloc((nrqs+1)*sizeof(int*),&rbuf2);
2942: PetscMalloc(msz*sizeof(int)+1,&(rbuf2[0]));
2943: for (i=1; i<nrqs; ++i) {
2944: rbuf2[i] = rbuf2[i-1]+w1[pa[i-1]];
2945: }
2946: for (i=0; i<nrqs; ++i) {
2947: j = pa[i];
2948: MPI_Irecv(rbuf2[i],w1[j],MPI_INT,j,tag1,comm,r_waits2+i);
2949: }
2951: /* Send to other procs the buf size they should allocate */
2952: /* structure of sbuf2[i]/rbuf2[i]: 1 (total size to allocate) + nrow-locrow
2953: * (row sizes) */
2955: /* Receive messages*/
2956: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits2);
2957: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&r_status1);
2958: len = 2*nrqr*sizeof(int) + (nrqr+1)*sizeof(int*);
2959: PetscMalloc(len,&sbuf2);
2960: req_size = (int*)(sbuf2 + nrqr);
2961: req_source = req_size + nrqr;
2962:
2963: {
2964: BSsprow **sAi = A->rows;
2965: int id,rstart = C->rmap->rstart;
2966: int *sbuf2_i,*rbuf1_i,end;
2968: for (i=0; i<nrqr; ++i) {
2969: MPI_Waitany(nrqr,r_waits1,&idx,r_status1+i);
2970: req_size[idx] = 0;
2971: rbuf1_i = rbuf1[idx];
2972: MPI_Get_count(r_status1+i,MPI_INT,&end);
2973: PetscMalloc((end+1)*sizeof(int),&sbuf2[idx]);
2974: sbuf2_i = sbuf2[idx];
2975: for (j=1; j<end; j++) {
2976: id = rbuf1_i[j] - rstart;
2977: ncols_t = (sAi[id])->length;
2978: sbuf2_i[j] = ncols_t;
2979: req_size[idx] += ncols_t;
2980: }
2981: req_source[idx] = r_status1[i].MPI_SOURCE;
2982: /* form the header */
2983: sbuf2_i[0] = req_size[idx];
2984: MPI_Isend(sbuf2_i,end,MPI_INT,req_source[idx],tag1,comm,s_waits2+i);
2985: }
2986: }
2987: PetscFree(r_status1);
2988: PetscFree(r_waits1);
2990: /* recv buffer sizes */
2991: /* Receive messages*/
2992:
2993: PetscMalloc((nrqs+1)*sizeof(int*),&rbuf3);
2994: PetscMalloc((nrqs+1)*sizeof(FLOAT*),&rbuf4);
2995: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits3);
2996: PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits4);
2997: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status2);
2999: for (i=0; i<nrqs; ++i) {
3000: MPI_Waitany(nrqs,r_waits2,&idx,r_status2+i);
3001: PetscMalloc((rbuf2[idx][0]+1)*sizeof(int),&rbuf3[idx]);
3002: PetscMalloc((rbuf2[idx][0]+1)*sizeof(FLOAT),&rbuf4[idx]);
3003: MPI_Irecv(rbuf3[idx],rbuf2[idx][0],MPI_INT,r_status2[i].MPI_SOURCE,tag2,comm,r_waits3+idx);
3004: MPI_Irecv(rbuf4[idx],rbuf2[idx][0],MPIU_SCALAR,r_status2[i].MPI_SOURCE,tag3,comm,r_waits4+idx);
3005: }
3006: PetscFree(r_status2);
3007: PetscFree(r_waits2);
3008:
3009: /* Wait on sends1 and sends2 */
3010: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&s_status1);
3011: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status2);
3013: if (nrqs) {MPI_Waitall(nrqs,s_waits1,s_status1);}
3014: if (nrqr) {MPI_Waitall(nrqr,s_waits2,s_status2);}
3015: PetscFree(s_status1);
3016: PetscFree(s_status2);
3017: PetscFree(s_waits1);
3018: PetscFree(s_waits2);
3020: /* Now allocate buffers for a->j, and send them off */
3021: /* structure of sbuf3[i]/rbuf3[i],sbuf4[i]/rbuf4[i]: reqsize[i] (cols resp.
3022: * vals of all req. rows; row sizes was in rbuf2; vals are of FLOAT type */
3023:
3024: PetscMalloc((nrqr+1)*sizeof(int*),&sbuf3);
3025: for (i=0,j=0; i<nrqr; i++) j += req_size[i];
3026: PetscMalloc((j+1)*sizeof(int),&sbuf3[0]);
3027: for (i=1; i<nrqr; i++) sbuf3[i] = sbuf3[i-1] + req_size[i-1];
3028:
3029: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits3);
3030: {
3031: int *Acol,*rbuf1_i,*sbuf3_i,rqrow,noutcols,kmax,*cols,ncols;
3032: int rstart = C->rmap->rstart;
3034: for (i=0; i<nrqr; i++) {
3035: rbuf1_i = rbuf1[i];
3036: sbuf3_i = sbuf3[i];
3037: noutcols = 0;
3038: kmax = rbuf1_i[0]; /* num. of req. rows */
3039: for (k=0,rqrow=1; k<kmax; k++,rqrow++) {
3040: Arow = A->rows[rbuf1_i[rqrow] - rstart];
3041: ncols = Arow->length;
3042: Acol = Arow->col;
3043: /* load the column indices for this row into cols*/
3044: cols = sbuf3_i + noutcols;
3045: PetscMemcpy(cols,Acol,ncols*sizeof(int));
3046: /*for (l=0; l<ncols;l++) cols[l]=Acol[l]; */ /* How is it with mappings?? */
3047: noutcols += ncols;
3048: }
3049: MPI_Isend(sbuf3_i,req_size[i],MPI_INT,req_source[i],tag2,comm,s_waits3+i);
3050: }
3051: }
3052: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status3);
3053: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status3);
3055: /* Allocate buffers for a->a, and send them off */
3056: /* can be optimized by conect with previous block */
3057: PetscMalloc((nrqr+1)*sizeof(FLOAT*),&sbuf4);
3058: for (i=0,j=0; i<nrqr; i++) j += req_size[i];
3059: PetscMalloc((j+1)*sizeof(FLOAT),&sbuf4[0]);
3060: for (i=1; i<nrqr; i++) sbuf4[i] = sbuf4[i-1] + req_size[i-1];
3061:
3062: PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits4);
3063: {
3064: FLOAT *Aval,*vals,*sbuf4_i;
3065: int rstart = C->rmap->rstart,*rbuf1_i,rqrow,noutvals,kmax,ncols;
3066:
3067:
3068: for (i=0; i<nrqr; i++) {
3069: rbuf1_i = rbuf1[i];
3070: sbuf4_i = sbuf4[i];
3071: rqrow = 1;
3072: noutvals = 0;
3073: kmax = rbuf1_i[0]; /* num of req. rows */
3074: for (k=0; k<kmax; k++,rqrow++) {
3075: Arow = A->rows[rbuf1_i[rqrow] - rstart];
3076: ncols = Arow->length;
3077: Aval = Arow->nz;
3078: /* load the column values for this row into vals*/
3079: vals = sbuf4_i+noutvals;
3080: PetscMemcpy(vals,Aval,ncols*sizeof(FLOAT));
3081: noutvals += ncols;
3082: }
3083: MPI_Isend(sbuf4_i,req_size[i],MPIU_SCALAR,req_source[i],tag3,comm,s_waits4+i);
3084: }
3085: }
3086: PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status4);
3087: PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status4);
3088: PetscFree(rbuf1);
3090: /* Form the matrix */
3092: /* create col map */
3093: len = C->cmap->N*sizeof(int)+1;
3094: PetscMalloc(len,&cmap);
3095: PetscMemzero(cmap,C->cmap->N*sizeof(int));
3096: for (j=0; j<ncol; j++) {
3097: cmap[icol[j]] = j+1;
3098: }
3099:
3100: /* Create row map / maybe I will need global rowmap but here is local rowmap*/
3101: len = C->rmap->N*sizeof(int)+1;
3102: PetscMalloc(len,&rmap);
3103: PetscMemzero(rmap,C->rmap->N*sizeof(int));
3104: for (j=0; j<nrow; j++) {
3105: rmap[irow[j]] = j;
3106: }
3108: /*
3109: Determine the number of non-zeros in the diagonal and off-diagonal
3110: portions of the matrix in order to do correct preallocation
3111: */
3113: /* first get start and end of "diagonal" columns */
3114: if (csize == PETSC_DECIDE) {
3115: nlocal = ncol/size + ((ncol % size) > rank);
3116: } else {
3117: nlocal = csize;
3118: }
3119: {
3120: int ncols,*cols,olen,dlen,thecol;
3121: int *rbuf2_i,*rbuf3_i,*sbuf1_i,row,kmax,cidx;
3122:
3123: MPI_Scan(&nlocal,&cend,1,MPI_INT,MPI_SUM,comm);
3124: cstart = cend - nlocal;
3125: if (rank == size - 1 && cend != ncol) {
3126: SETERRQ(PETSC_ERR_ARG_SIZ,"Local column sizes do not add up to total number of columns");
3127: }
3129: PetscMalloc((2*nrow+1)*sizeof(int),&d_nz);
3130: o_nz = d_nz + nrow;
3131:
3132: /* Update lens from local data */
3133: for (j=0; j<nrow; j++) {
3134: row = irow[j];
3135: proc = rtable[row];
3136: if (proc == rank) {
3137: Arow=A->rows[row-C->rmap->rstart];
3138: ncols=Arow->length;
3139: cols=Arow->col;
3140: olen=dlen=0;
3141: for (k=0; k<ncols; k++) {
3142: if ((thecol=cmap[cols[k]])) {
3143: if (cstart<thecol && thecol<=cend) dlen++; /* thecol is from 1 */
3144: else olen++;
3145: }
3146: }
3147: o_nz[j]=olen;
3148: d_nz[j]=dlen;
3149: } else d_nz[j]=o_nz[j]=0;
3150: }
3151: /* Update lens from offproc data and done waits */
3152: /* this will be much simplier after sending only appropriate columns */
3153: for (j=0; j<nrqs;j++) {
3154: MPI_Waitany(nrqs,r_waits3,&i,r_status3+j);
3155: proc = pa[i];
3156: sbuf1_i = sbuf1[proc];
3157: cidx = 0;
3158: rbuf2_i = rbuf2[i];
3159: rbuf3_i = rbuf3[i];
3160: kmax = sbuf1_i[0]; /*num of rq. rows*/
3161: for (k=1; k<=kmax; k++) {
3162: row = rmap[sbuf1_i[k]]; /* the val in the new matrix to be */
3163: for (l=0; l<rbuf2_i[k]; l++,cidx++) {
3164: if ((thecol=cmap[rbuf3_i[cidx]])) {
3165:
3166: if (cstart<thecol && thecol<=cend) d_nz[row]++; /* thecol is from 1 */
3167: else o_nz[row]++;
3168: }
3169: }
3170: }
3171: }
3172: }
3173: PetscFree(r_status3);
3174: PetscFree(r_waits3);
3175: if (nrqr) {MPI_Waitall(nrqr,s_waits3,s_status3);}
3176: PetscFree(s_status3);
3177: PetscFree(s_waits3);
3179: if (scall == MAT_INITIAL_MATRIX) {
3180: MatCreate(comm,submat);
3181: MatSetSizes(*submat,nrow,nlocal,PETSC_DECIDE,ncol);
3182: MatSetType(*submat,((PetscObject)C)->type_name);
3183: MatMPIAIJSetPreallocation(*submat,0,d_nz,0,o_nz);
3184: mat=(Mat_MPIAIJ *)((*submat)->data);
3185: matA=(Mat_SeqAIJ *)(mat->A->data);
3186: matB=(Mat_SeqAIJ *)(mat->B->data);
3187:
3188: } else {
3189: PetscTruth same;
3190: /* folowing code can be optionaly dropped for debuged versions of users
3191: * program, but I don't know PETSc option which can switch off such safety
3192: * tests - in a same way counting of o_nz,d_nz can be droped for REUSE
3193: * matrix */
3194:
3195: PetscTypeCompare((PetscObject)(*submat),MATMPIAIJ,&same);
3196: if (!same) {
3197: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong type");
3198: }
3199: if (((*submat)->rmap->n != nrow) || ((*submat)->cmap->N != ncol)) {
3200: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size");
3201: }
3202: mat=(Mat_MPIAIJ *)((*submat)->data);
3203: matA=(Mat_SeqAIJ *)(mat->A->data);
3204: matB=(Mat_SeqAIJ *)(mat->B->data);
3205: PetscMemcmp(matA->ilen,d_nz,nrow*sizeof(int),&same);
3206: if (!same) {
3207: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong no of nonzeros");
3208: }
3209: PetscMemcmp(matB->ilen,o_nz,nrow*sizeof(int),&same);
3210: if (!same) {
3211: SETERRQ(PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong no of nonzeros");
3212: }
3213: /* Initial matrix as if empty */
3214: PetscMemzero(matA->ilen,nrow*sizeof(int));
3215: PetscMemzero(matB->ilen,nrow*sizeof(int));
3216: /* Perhaps MatZeroEnteries may be better - look what it is exactly doing - I must
3217: * delete all possibly nonactual inforamtion */
3218: /*submats[i]->factor = C->factor; !!! ??? if factor will be same then I must
3219: * copy some factor information - where are thay */
3220: (*submat)->was_assembled=PETSC_FALSE;
3221: (*submat)->assembled=PETSC_FALSE;
3222:
3223: }
3224: PetscFree(d_nz);
3226: /* Assemble the matrix */
3227: /* First assemble from local rows */
3228: {
3229: int i_row,oldrow,row,ncols,*cols,*matA_j,*matB_j,ilenA,ilenB,tcol;
3230: FLOAT *vals;
3231: PetscScalar *matA_a,*matB_a;
3232:
3233: for (j=0; j<nrow; j++) {
3234: oldrow = irow[j];
3235: proc = rtable[oldrow];
3236: if (proc == rank) {
3237: row = rmap[oldrow];
3238:
3239: Arow = A->rows[oldrow-C->rmap->rstart];
3240: ncols = Arow->length;
3241: cols = Arow->col;
3242: vals = Arow->nz;
3243:
3244: i_row = matA->i[row];
3245: matA_a = matA->a + i_row;
3246: matA_j = matA->j + i_row;
3247: i_row = matB->i[row];
3248: matB_a = matB->a + i_row;
3249: matB_j = matB->j + i_row;
3250: for (k=0,ilenA=0,ilenB=0; k<ncols; k++) {
3251: if ((tcol = cmap[cols[k]])) {
3252: if (tcol<=cstart) {
3253: *matB_j++ = tcol-1;
3254: *matB_a++ = vals[k];
3255: ilenB++;
3256: } else if (tcol<=cend) {
3257: *matA_j++ = (tcol-1)-cstart;
3258: *matA_a++ = (PetscScalar)(vals[k]);
3259: ilenA++;
3260: } else {
3261: *matB_j++ = tcol-1;
3262: *matB_a++ = vals[k];
3263: ilenB++;
3264: }
3265: }
3266: }
3267: matA->ilen[row]=ilenA;
3268: matB->ilen[row]=ilenB;
3269:
3270: }
3271: }
3272: }
3274: /* Now assemble the off proc rows*/
3275: {
3276: int *sbuf1_i,*rbuf2_i,*rbuf3_i,cidx,kmax,row,i_row;
3277: int *matA_j,*matB_j,lmax,tcol,ilenA,ilenB;
3278: PetscScalar *matA_a,*matB_a;
3279: FLOAT *rbuf4_i;
3281: for (j=0; j<nrqs; j++) {
3282: MPI_Waitany(nrqs,r_waits4,&i,r_status4+j);
3283: proc = pa[i];
3284: sbuf1_i = sbuf1[proc];
3285:
3286: cidx = 0;
3287: rbuf2_i = rbuf2[i];
3288: rbuf3_i = rbuf3[i];
3289: rbuf4_i = rbuf4[i];
3290: kmax = sbuf1_i[0];
3291: for (k=1; k<=kmax; k++) {
3292: row = rmap[sbuf1_i[k]];
3293:
3294: i_row = matA->i[row];
3295: matA_a = matA->a + i_row;
3296: matA_j = matA->j + i_row;
3297: i_row = matB->i[row];
3298: matB_a = matB->a + i_row;
3299: matB_j = matB->j + i_row;
3300:
3301: lmax = rbuf2_i[k];
3302: for (l=0,ilenA=0,ilenB=0; l<lmax; l++,cidx++) {
3303: if ((tcol = cmap[rbuf3_i[cidx]])) {
3304: if (tcol<=cstart) {
3305: *matB_j++ = tcol-1;
3306: *matB_a++ = (PetscScalar)(rbuf4_i[cidx]);;
3307: ilenB++;
3308: } else if (tcol<=cend) {
3309: *matA_j++ = (tcol-1)-cstart;
3310: *matA_a++ = (PetscScalar)(rbuf4_i[cidx]);
3311: ilenA++;
3312: } else {
3313: *matB_j++ = tcol-1;
3314: *matB_a++ = (PetscScalar)(rbuf4_i[cidx]);
3315: ilenB++;
3316: }
3317: }
3318: }
3319: matA->ilen[row]=ilenA;
3320: matB->ilen[row]=ilenB;
3321: }
3322: }
3323: }
3325: PetscFree(r_status4);
3326: PetscFree(r_waits4);
3327: if (nrqr) {MPI_Waitall(nrqr,s_waits4,s_status4);}
3328: PetscFree(s_waits4);
3329: PetscFree(s_status4);
3331: /* Restore the indices */
3332: ISRestoreIndices(isrow,&irow);
3333: ISRestoreIndices(iscol,&icol);
3335: /* Destroy allocated memory */
3336: PetscFree(rtable);
3337: PetscFree(w1);
3338: PetscFree(pa);
3340: PetscFree(sbuf1);
3341: PetscFree(rbuf2[0]);
3342: PetscFree(rbuf2);
3343: for (i=0; i<nrqr; ++i) {
3344: PetscFree(sbuf2[i]);
3345: }
3346: for (i=0; i<nrqs; ++i) {
3347: PetscFree(rbuf3[i]);
3348: PetscFree(rbuf4[i]);
3349: }
3351: PetscFree(sbuf2);
3352: PetscFree(rbuf3);
3353: PetscFree(rbuf4);
3354: PetscFree(sbuf3[0]);
3355: PetscFree(sbuf3);
3356: PetscFree(sbuf4[0]);
3357: PetscFree(sbuf4);
3358:
3359: PetscFree(cmap);
3360: PetscFree(rmap);
3363: MatAssemblyBegin(*submat,MAT_FINAL_ASSEMBLY);
3364: MatAssemblyEnd(*submat,MAT_FINAL_ASSEMBLY);
3367: return(0);
3368: }