/* Routines to compute overlapping regions of a parallel MPI matrix and to find submatrices that were shared across processors. */ #include <../src/mat/impls/baij/mpi/mpibaij.h> #include static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Local(Mat,PetscInt,char**,PetscInt*,PetscInt**); static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Receive(Mat,PetscInt,PetscInt**,PetscInt**,PetscInt*); extern PetscErrorCode MatGetRow_MPIBAIJ(Mat,PetscInt,PetscInt*,PetscInt**,PetscScalar**); extern PetscErrorCode MatRestoreRow_MPIBAIJ(Mat,PetscInt,PetscInt*,PetscInt**,PetscScalar**); #undef __FUNCT__ #define __FUNCT__ "MatIncreaseOverlap_MPIBAIJ" PetscErrorCode MatIncreaseOverlap_MPIBAIJ(Mat C,PetscInt imax,IS is[],PetscInt ov) { PetscErrorCode ierr; PetscInt i,N=C->cmap->N, bs=C->rmap->bs; IS *is_new; PetscFunctionBegin; ierr = PetscMalloc1(imax,&is_new);CHKERRQ(ierr); /* Convert the indices into block format */ ierr = ISCompressIndicesGeneral(N,C->rmap->n,bs,imax,is,is_new);CHKERRQ(ierr); if (ov < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative overlap specified\n"); for (i=0; i is[1] mesg [2] = sizeof(is[1]); ----------- mesg [5] = 5 => is[5] mesg [6] = sizeof(is[5]); ----------- mesg [7] mesg [n] data(is[1]) ----------- mesg[n+1] mesg[m] data(is[5]) ----------- Notes: nrqs - no of requests sent (or to be sent out) nrqr - no of requests recieved (which have to be or which have been processed */ #undef __FUNCT__ #define __FUNCT__ "MatIncreaseOverlap_MPIBAIJ_Once" PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Once(Mat C,PetscInt imax,IS is[]) { Mat_MPIBAIJ *c = (Mat_MPIBAIJ*)C->data; const PetscInt **idx,*idx_i; PetscInt *n,*w3,*w4,**data,len; PetscErrorCode ierr; PetscMPIInt size,rank,tag1,tag2,*w2,*w1,nrqr; PetscInt Mbs,i,j,k,**rbuf,row,proc=-1,nrqs,msz,**outdat,**ptr; PetscInt *ctr,*pa,*tmp,*isz,*isz1,**xdata,**rbuf2,*d_p; PetscMPIInt *onodes1,*olengths1,*onodes2,*olengths2; PetscBT *table; MPI_Comm comm; MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2; MPI_Status *s_status,*recv_status; char *t_p; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)C,&comm);CHKERRQ(ierr); size = c->size; rank = c->rank; Mbs = c->Mbs; ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)C,&tag2);CHKERRQ(ierr); ierr = PetscMalloc2(imax+1,&idx,imax,&n);CHKERRQ(ierr); for (i=0; irmap,row*C->rmap->bs,&proc);CHKERRQ(ierr); w4[proc]++; } for (j=0; jrmap,row*C->rmap->bs,&proc);CHKERRQ(ierr); if (proc != rank) { /* copy to the outgoing buffer */ ctr[proc]++; *ptr[proc] = row; ptr[proc]++; } else { /* Update the local table */ if (!PetscBTLookupSet(table_i,row)) data_i[isz_i++] = row; } } /* Update the headers for the current IS */ for (j=0; jdata; Mat A = c->A,B = c->B; Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)B->data; PetscInt start,end,val,max,rstart,cstart,*ai,*aj; PetscInt *bi,*bj,*garray,i,j,k,row,*data_i,isz_i; PetscBT table_i; PetscFunctionBegin; rstart = c->rstartbs; cstart = c->cstartbs; ai = a->i; aj = a->j; bi = b->i; bj = b->j; garray = c->garray; for (i=0; idata; Mat A = c->A,B = c->B; Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)B->data; PetscErrorCode ierr; PetscInt rstart,cstart,*ai,*aj,*bi,*bj,*garray,i,j,k; PetscInt row,total_sz,ct,ct1,ct2,ct3,mem_estimate,oct2,l,start,end; PetscInt val,max1,max2,Mbs,no_malloc =0,*tmp,new_estimate,ctr; PetscInt *rbuf_i,kmax,rbuf_0; PetscBT xtable; PetscFunctionBegin; Mbs = c->Mbs; rstart = c->rstartbs; cstart = c->cstartbs; ai = a->i; aj = a->j; bi = b->i; bj = b->j; garray = c->garray; for (i=0,ct=0,total_sz=0; iMbs) max1 = ct*(a->nz +b->nz)/c->Mbs; else max1 = 1; mem_estimate = 3*((total_sz > max1 ? total_sz : max1)+1); ierr = PetscMalloc1(mem_estimate,&xdata[0]);CHKERRQ(ierr); ++no_malloc; ierr = PetscBTCreate(Mbs,&xtable);CHKERRQ(ierr); ierr = PetscMemzero(isz1,nrqr*sizeof(PetscInt));CHKERRQ(ierr); ct3 = 0; for (i=0; idata; PetscErrorCode ierr; PetscInt nmax,nstages_local,nstages,i,pos,max_no,ncol,nrow,N=C->cmap->N,bs=C->rmap->bs; PetscBool colflag,*allcolumns,*allrows; PetscFunctionBegin; /* The compression and expansion should be avoided. Doesn't point out errors, might change the indices, hence buggey */ ierr = PetscMalloc2(ismax+1,&isrow_new,ismax+1,&iscol_new);CHKERRQ(ierr); ierr = ISCompressIndicesGeneral(N,C->rmap->n,bs,ismax,isrow,isrow_new);CHKERRQ(ierr); ierr = ISCompressIndicesGeneral(N,C->cmap->n,bs,ismax,iscol,iscol_new);CHKERRQ(ierr); /* Check for special case: each processor gets entire matrix columns */ ierr = PetscMalloc2(ismax+1,&allcolumns,ismax+1,&allrows);CHKERRQ(ierr); for (i=0; icmap->N) allcolumns[i] = PETSC_TRUE; else allcolumns[i] = PETSC_FALSE; ierr = ISIdentity(isrow[i],&colflag);CHKERRQ(ierr); ierr = ISGetLocalSize(isrow[i],&nrow);CHKERRQ(ierr); if (colflag && nrow == C->rmap->N) allrows[i] = PETSC_TRUE; else allrows[i] = PETSC_FALSE; } /* Allocate memory to hold all the submatrices */ if (scall != MAT_REUSE_MATRIX) { ierr = PetscMalloc1(ismax+1,submat);CHKERRQ(ierr); } /* Determine the number of stages through which submatrices are done */ nmax = 20*1000000 / (c->Nbs * sizeof(PetscInt)); if (!nmax) nmax = 1; nstages_local = ismax/nmax + ((ismax % nmax) ? 1 : 0); /* Make sure every processor loops through the nstages */ ierr = MPI_Allreduce(&nstages_local,&nstages,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)C));CHKERRQ(ierr); for (i=0,pos=0; i size) fproc = size; while (row < proc_gnode[fproc] || row >= proc_gnode[fproc+1]) { if (row < proc_gnode[fproc]) fproc--; else fproc++; } *rank = fproc; PetscFunctionReturn(0); } #endif /* -------------------------------------------------------------------------*/ /* This code is used for BAIJ and SBAIJ matrices (unfortunate dependency) */ #undef __FUNCT__ #define __FUNCT__ "MatGetSubMatrices_MPIBAIJ_local" PetscErrorCode MatGetSubMatrices_MPIBAIJ_local(Mat C,PetscInt ismax,const IS isrow[],const IS iscol[],MatReuse scall,PetscBool *allrows,PetscBool *allcolumns,Mat *submats) { Mat_MPIBAIJ *c = (Mat_MPIBAIJ*)C->data; Mat A = c->A; Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)c->B->data,*mat; const PetscInt **irow,**icol,*irow_i; PetscInt *nrow,*ncol,*w3,*w4,start; PetscErrorCode ierr; PetscMPIInt size,tag0,tag1,tag2,tag3,*w1,*w2,nrqr,idex,end,proc; PetscInt **sbuf1,**sbuf2,rank,i,j,k,l,ct1,ct2,**rbuf1,row; PetscInt nrqs,msz,**ptr,*req_size,*ctr,*pa,*tmp,tcol; PetscInt **rbuf3,*req_source,**sbuf_aj,**rbuf2,max1,max2; PetscInt **lens,is_no,ncols,*cols,mat_i,*mat_j,tmp2,jmax; PetscInt ctr_j,*sbuf1_j,*sbuf_aj_i,*rbuf1_i,kmax,*lens_i; PetscInt bs =C->rmap->bs,bs2=c->bs2,*a_j=a->j,*b_j=b->j,*cworkA,*cworkB; PetscInt cstart = c->cstartbs,nzA,nzB,*a_i=a->i,*b_i=b->i,imark; PetscInt *bmap = c->garray,ctmp,rstart=c->rstartbs; MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2,*r_waits3,*s_waits3; MPI_Status *r_status1,*r_status2,*s_status1,*s_status3,*s_status2,*r_status3; MPI_Comm comm; PetscBool flag; PetscMPIInt *onodes1,*olengths1; PetscBool ijonly=c->ijonly; /* private flag indicates only matrix data structures are requested */ /* variables below are used for the matrix numerical values - case of !ijonly */ MPI_Request *r_waits4,*s_waits4; MPI_Status *r_status4,*s_status4; MatScalar **rbuf4,**sbuf_aa,*vals,*mat_a = NULL,*sbuf_aa_i,*vworkA = NULL,*vworkB = NULL; MatScalar *a_a=a->a,*b_a=b->a; #if defined(PETSC_USE_CTABLE) PetscInt tt; PetscTable *rmap,*cmap,rmap_i,cmap_i=NULL; #else PetscInt **cmap,*cmap_i=NULL,*rtable,*rmap_i,**rmap, Mbs = c->Mbs; #endif PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)C,&comm);CHKERRQ(ierr); tag0 = ((PetscObject)C)->tag; size = c->size; rank = c->rank; /* Get some new tags to keep the communication clean */ ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)C,&tag2);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)C,&tag3);CHKERRQ(ierr); #if defined(PETSC_USE_CTABLE) ierr = PetscMalloc4(ismax,&irow,ismax,&icol,ismax,&nrow,ismax,&ncol);CHKERRQ(ierr); #else ierr = PetscMalloc5(ismax,&irow,ismax,&icol,ismax,&nrow,ismax,&ncol,Mbs+1,&rtable);CHKERRQ(ierr); /* Create hash table for the mapping :row -> proc*/ for (i=0,j=0; irmap->range[i+1]/bs; for (; jrmap->N/bs; } else { ierr = ISGetIndices(isrow[i],&irow[i]);CHKERRQ(ierr); ierr = ISGetLocalSize(isrow[i],&nrow[i]);CHKERRQ(ierr); } if (allcolumns[i]) { icol[i] = NULL; ncol[i] = C->cmap->N/bs; } else { ierr = ISGetIndices(iscol[i],&icol[i]);CHKERRQ(ierr); ierr = ISGetLocalSize(iscol[i],&ncol[i]);CHKERRQ(ierr); } } /* evaluate communication - mesg to who,length of mesg,and buffer space required. Based on this, buffers are allocated, and data copied into them*/ ierr = PetscCalloc4(size,&w1,size,&w2,size,&w3,size,&w4);CHKERRQ(ierr); for (i=0; irangebs,&proc);CHKERRQ(ierr); #else proc = rtable[row]; #endif w4[proc]++; } for (j=0; jrangebs,&proc);CHKERRQ(ierr); #else proc = rtable[row]; #endif if (proc != rank) { /* copy to the outgoing buf*/ ctr[proc]++; *ptr[proc] = row; ptr[proc]++; } } /* Update the headers for the current IS */ for (j=0; jA->data,*sB = (Mat_SeqBAIJ*)c->B->data; PetscInt *sAi = sA->i,*sBi = sB->i,id,*sbuf2_i; for (i=0; ij, and send them off */ ierr = PetscMalloc1(nrqr+1,&sbuf_aj);CHKERRQ(ierr); for (i=0,j=0; ia, and send them off */ if (!ijonly) { ierr = PetscMalloc1(nrqr+1,&sbuf_aa);CHKERRQ(ierr); for (i=0,j=0; i local col of submatrices */ { const PetscInt *icol_i; #if defined(PETSC_USE_CTABLE) ierr = PetscMalloc1(1+ismax,&cmap);CHKERRQ(ierr); for (i=0; iNbs+1,&cmap[i]);CHKERRQ(ierr); jmax = ncol[i]; icol_i = icol[i]; cmap_i = cmap[i]; for (j=0; jNbs,&cmap[i]);CHKERRQ(ierr); jmax = ncol[i]; icol_i = icol[i]; cmap_i = cmap[i]; for (j=0; jrangebs,&proc);CHKERRQ(ierr); #else proc = rtable[row]; #endif if (proc == rank) { /* Get indices from matA and then from matB */ row = row - rstart; nzA = a_i[row+1] - a_i[row]; nzB = b_i[row+1] - b_i[row]; cworkA = a_j + a_i[row]; cworkB = b_j + b_i[row]; if (!allcolumns[i]) { #if defined(PETSC_USE_CTABLE) for (k=0; kMbs+1,&rmap[i]);CHKERRQ(ierr); } #else /* Create row map*/ ierr = PetscMalloc((1+ismax)*sizeof(PetscInt*)+ ismax*Mbs*sizeof(PetscInt),&rmap);CHKERRQ(ierr); rmap[0] = (PetscInt*)(rmap + ismax); ierr = PetscMemzero(rmap[0],ismax*Mbs*sizeof(PetscInt));CHKERRQ(ierr); for (i=1; idata); if ((mat->mbs != nrow[i]) || (mat->nbs != ncol[i] || C->rmap->bs != bs)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size"); ierr = PetscMemcmp(mat->ilen,lens[i],mat->mbs *sizeof(PetscInt),&flag);CHKERRQ(ierr); if (!flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cannot reuse matrix. wrong no of nonzeros"); /* Initial matrix as if empty */ ierr = PetscMemzero(mat->ilen,mat->mbs*sizeof(PetscInt));CHKERRQ(ierr); submats[i]->factortype = C->factortype; } } else { PetscInt bs_tmp; if (ijonly) bs_tmp = 1; else bs_tmp = bs; for (i=0; itype_name);CHKERRQ(ierr); ierr = MatSeqBAIJSetPreallocation(submats[i],bs_tmp,0,lens[i]);CHKERRQ(ierr); ierr = MatSeqSBAIJSetPreallocation(submats[i],bs_tmp,0,lens[i]);CHKERRQ(ierr); /* this subroutine is used by SBAIJ routines */ } } /* Assemble the matrices */ /* First assemble the local rows */ { PetscInt ilen_row,*imat_ilen,*imat_j,*imat_i; MatScalar *imat_a = NULL; for (i=0; idata; imat_ilen = mat->ilen; imat_j = mat->j; imat_i = mat->i; if (!ijonly) imat_a = mat->a; if (!allcolumns[i]) cmap_i = cmap[i]; rmap_i = rmap[i]; irow_i = irow[i]; jmax = nrow[i]; for (j=0; jrangebs,&proc);CHKERRQ(ierr); #else proc = rtable[row]; #endif if (proc == rank) { row = row - rstart; nzA = a_i[row+1] - a_i[row]; nzB = b_i[row+1] - b_i[row]; cworkA = a_j + a_i[row]; cworkB = b_j + b_i[row]; if (!ijonly) { vworkA = a_a + a_i[row]*bs2; vworkB = b_a + b_i[row]*bs2; } #if defined(PETSC_USE_CTABLE) ierr = PetscTableFind(rmap_i,row+rstart+1,&row);CHKERRQ(ierr); row--; if (row < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"row not found in table"); #else row = rmap_i[row + rstart]; #endif mat_i = imat_i[row]; if (!ijonly) mat_a = imat_a + mat_i*bs2; mat_j = imat_j + mat_i; ilen_row = imat_ilen[row]; /* load the column indices for this row into cols*/ if (!allcolumns[i]) { for (l=0; ldata; imat_ilen = mat->ilen; imat_j = mat->j; imat_i = mat->i; if (!ijonly) imat_a = mat->a; max1 = sbuf1_i[2*j]; for (k=0; kdata; imat_ilen = mat->ilen; imat_j = mat->j; imat_i = mat->i; if (!ijonly) imat_a = mat->a; if (allcolumns[i]) continue; jmax = nrow[i]; for (j=0; jijonly = PETSC_FALSE; /* set back to the default */ PetscFunctionReturn(0); }