static PetscErrorCode PetscCommBuildTwoSided_Allreduce(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt size,*iflags,nrecvs,tag,*franks,i;
MPI_Aint lb,unitbytes;
char *tdata,*fdata;
MPI_Request *reqs,*sendreqs;
MPI_Status *statuses;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscCalloc1(size,&iflags);CHKERRQ(ierr);
for (i=0; i<nto; i++) iflags[toranks[i]] = 1;
ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&nrecvs);CHKERRQ(ierr);
ierr = PetscFree(iflags);CHKERRQ(ierr);
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
ierr = PetscMalloc(nrecvs*count*unitbytes,&fdata);CHKERRQ(ierr);
tdata = (char*)todata;
ierr = PetscMalloc2(nto+nrecvs,&reqs,nto+nrecvs,&statuses);CHKERRQ(ierr);
sendreqs = reqs + nrecvs;
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv((void*)(fdata+count*unitbytes*i),count,dtype,MPI_ANY_SOURCE,tag,comm,reqs+i);CHKERRQ(ierr);
}
for (i=0; i<nto; i++) {
ierr = MPI_Isend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = MPI_Waitall(nto+nrecvs,reqs,statuses);CHKERRQ(ierr);
ierr = PetscMalloc1(nrecvs,&franks);CHKERRQ(ierr);
for (i=0; i<nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
ierr = PetscFree2(reqs,statuses);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
*nfrom = nrecvs;
*fromranks = franks;
*(void**)fromdata = fdata;
PetscFunctionReturn(0);
}
static PetscErrorCode PetscCommBuildTwoSided_Allreduce(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscInt nto,const PetscMPIInt *toranks,const void *todata,PetscInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt size,*iflags,nrecvs,tag,unitbytes,*franks;
PetscInt i;
char *tdata,*fdata;
MPI_Request *reqs,*sendreqs;
MPI_Status *statuses;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(*iflags),&iflags);CHKERRQ(ierr);
ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
for (i=0; i<nto; i++) iflags[toranks[i]] = 1;
ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&nrecvs);CHKERRQ(ierr);
ierr = PetscFree(iflags);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_size(dtype,&unitbytes);CHKERRQ(ierr);
ierr = PetscMalloc(nrecvs*count*unitbytes,&fdata);CHKERRQ(ierr);
tdata = (char*)todata;
ierr = PetscMalloc2(nto+nrecvs,MPI_Request,&reqs,nto+nrecvs,MPI_Status,&statuses);CHKERRQ(ierr);
sendreqs = reqs + nrecvs;
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv((void*)(fdata+count*unitbytes*i),count,dtype,MPI_ANY_SOURCE,tag,comm,reqs+i);CHKERRQ(ierr);
}
for (i=0; i<nto; i++) {
ierr = MPI_Isend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = MPI_Waitall(nto+nrecvs,reqs,statuses);CHKERRQ(ierr);
ierr = PetscMalloc(nrecvs*sizeof(PetscMPIInt),&franks);CHKERRQ(ierr);
for (i=0; i<nrecvs; i++) franks[i] = statuses[i].MPI_SOURCE;
ierr = PetscFree2(reqs,statuses);CHKERRQ(ierr);
*nfrom = nrecvs;
*fromranks = franks;
*(void**)fromdata = fdata;
PetscFunctionReturn(0);
}
static PetscErrorCode MatStashScatterBegin_Ref(Mat mat,MatStash *stash,PetscInt *owners)
{
PetscInt *owner,*startv,*starti,tag1=stash->tag1,tag2=stash->tag2,bs2;
PetscInt size=stash->size,nsends;
PetscErrorCode ierr;
PetscInt count,*sindices,**rindices,i,j,idx,lastidx,l;
PetscScalar **rvalues,*svalues;
MPI_Comm comm = stash->comm;
MPI_Request *send_waits,*recv_waits,*recv_waits1,*recv_waits2;
PetscMPIInt *sizes,*nlengths,nreceives;
PetscInt *sp_idx,*sp_idy;
PetscScalar *sp_val;
PetscMatStashSpace space,space_next;
PetscFunctionBegin;
{ /* make sure all processors are either in INSERTMODE or ADDMODE */
InsertMode addv;
ierr = MPIU_Allreduce((PetscEnum*)&mat->insertmode,(PetscEnum*)&addv,1,MPIU_ENUM,MPI_BOR,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
if (addv == (ADD_VALUES|INSERT_VALUES)) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"Some processors inserted others added");
mat->insertmode = addv; /* in case this processor had no cache */
}
bs2 = stash->bs*stash->bs;
/* first count number of contributors to each processor */
ierr = PetscCalloc1(size,&sizes);CHKERRQ(ierr);
ierr = PetscCalloc1(size,&nlengths);CHKERRQ(ierr);
ierr = PetscMalloc1(stash->n+1,&owner);CHKERRQ(ierr);
i = j = 0;
lastidx = -1;
space = stash->space_head;
while (space) {
space_next = space->next;
sp_idx = space->idx;
for (l=0; l<space->local_used; l++) {
/* if indices are NOT locally sorted, need to start search at the beginning */
if (lastidx > (idx = sp_idx[l])) j = 0;
lastidx = idx;
for (; j<size; j++) {
if (idx >= owners[j] && idx < owners[j+1]) {
nlengths[j]++; owner[i] = j; break;
}
}
i++;
}
space = space_next;
}
/* Now check what procs get messages - and compute nsends. */
for (i=0, nsends=0; i<size; i++) {
if (nlengths[i]) {
sizes[i] = 1; nsends++;
}
}
{PetscMPIInt *onodes,*olengths;
/* Determine the number of messages to expect, their lengths, from from-ids */
ierr = PetscGatherNumberOfMessages(comm,sizes,nlengths,&nreceives);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths(comm,nsends,nreceives,nlengths,&onodes,&olengths);CHKERRQ(ierr);
/* since clubbing row,col - lengths are multiplied by 2 */
for (i=0; i<nreceives; i++) olengths[i] *=2;
ierr = PetscPostIrecvInt(comm,tag1,nreceives,onodes,olengths,&rindices,&recv_waits1);CHKERRQ(ierr);
/* values are size 'bs2' lengths (and remove earlier factor 2 */
for (i=0; i<nreceives; i++) olengths[i] = olengths[i]*bs2/2;
ierr = PetscPostIrecvScalar(comm,tag2,nreceives,onodes,olengths,&rvalues,&recv_waits2);CHKERRQ(ierr);
ierr = PetscFree(onodes);CHKERRQ(ierr);
ierr = PetscFree(olengths);CHKERRQ(ierr);}
/* do sends:
1) starts[i] gives the starting index in svalues for stuff going to
the ith processor
*/
ierr = PetscMalloc2(bs2*stash->n,&svalues,2*(stash->n+1),&sindices);CHKERRQ(ierr);
ierr = PetscMalloc1(2*nsends,&send_waits);CHKERRQ(ierr);
ierr = PetscMalloc2(size,&startv,size,&starti);CHKERRQ(ierr);
/* use 2 sends the first with all_a, the next with all_i and all_j */
startv[0] = 0; starti[0] = 0;
for (i=1; i<size; i++) {
startv[i] = startv[i-1] + nlengths[i-1];
starti[i] = starti[i-1] + 2*nlengths[i-1];
}
i = 0;
space = stash->space_head;
while (space) {
space_next = space->next;
sp_idx = space->idx;
sp_idy = space->idy;
sp_val = space->val;
for (l=0; l<space->local_used; l++) {
j = owner[i];
if (bs2 == 1) {
svalues[startv[j]] = sp_val[l];
} else {
PetscInt k;
PetscScalar *buf1,*buf2;
buf1 = svalues+bs2*startv[j];
buf2 = space->val + bs2*l;
for (k=0; k<bs2; k++) buf1[k] = buf2[k];
}
sindices[starti[j]] = sp_idx[l];
sindices[starti[j]+nlengths[j]] = sp_idy[l];
startv[j]++;
starti[j]++;
i++;
}
space = space_next;
}
startv[0] = 0;
for (i=1; i<size; i++) startv[i] = startv[i-1] + nlengths[i-1];
for (i=0,count=0; i<size; i++) {
if (sizes[i]) {
ierr = MPI_Isend(sindices+2*startv[i],2*nlengths[i],MPIU_INT,i,tag1,comm,send_waits+count++);CHKERRQ(ierr);
ierr = MPI_Isend(svalues+bs2*startv[i],bs2*nlengths[i],MPIU_SCALAR,i,tag2,comm,send_waits+count++);CHKERRQ(ierr);
}
}
#if defined(PETSC_USE_INFO)
ierr = PetscInfo1(NULL,"No of messages: %d \n",nsends);CHKERRQ(ierr);
for (i=0; i<size; i++) {
if (sizes[i]) {
ierr = PetscInfo2(NULL,"Mesg_to: %d: size: %d bytes\n",i,nlengths[i]*(bs2*sizeof(PetscScalar)+2*sizeof(PetscInt)));CHKERRQ(ierr);
}
}
#endif
ierr = PetscFree(nlengths);CHKERRQ(ierr);
ierr = PetscFree(owner);CHKERRQ(ierr);
ierr = PetscFree2(startv,starti);CHKERRQ(ierr);
ierr = PetscFree(sizes);CHKERRQ(ierr);
/* recv_waits need to be contiguous for MatStashScatterGetMesg_Private() */
ierr = PetscMalloc1(2*nreceives,&recv_waits);CHKERRQ(ierr);
for (i=0; i<nreceives; i++) {
recv_waits[2*i] = recv_waits1[i];
recv_waits[2*i+1] = recv_waits2[i];
}
stash->recv_waits = recv_waits;
ierr = PetscFree(recv_waits1);CHKERRQ(ierr);
ierr = PetscFree(recv_waits2);CHKERRQ(ierr);
stash->svalues = svalues;
stash->sindices = sindices;
stash->rvalues = rvalues;
stash->rindices = rindices;
stash->send_waits = send_waits;
stash->nsends = nsends;
stash->nrecvs = nreceives;
stash->reproduce_count = 0;
PetscFunctionReturn(0);
}
static PetscErrorCode MatIncreaseOverlap_MPISBAIJ_Once(Mat C,PetscInt is_max,IS is[])
{
Mat_MPISBAIJ *c = (Mat_MPISBAIJ*)C->data;
PetscErrorCode ierr;
PetscMPIInt size,rank,tag1,tag2,*len_s,nrqr,nrqs,*id_r1,*len_r1,flag,len;
const PetscInt *idx_i;
PetscInt idx,isz,col,*n,*data1,**data1_start,*data2,*data2_i,*data,*data_i,
Mbs,i,j,k,*odata1,*odata2,
proc_id,**odata2_ptr,*ctable=0,*btable,len_max,len_est;
PetscInt proc_end=0,*iwork,len_unused,nodata2;
PetscInt ois_max; /* max no of is[] in each of processor */
char *t_p;
MPI_Comm comm;
MPI_Request *s_waits1,*s_waits2,r_req;
MPI_Status *s_status,r_status;
PetscBT *table; /* mark indices of this processor's is[] */
PetscBT table_i;
PetscBT otable; /* mark indices of other processors' is[] */
PetscInt bs=C->rmap->bs,Bn = c->B->cmap->n,Bnbs = Bn/bs,*Bowners;
IS garray_local,garray_gl;
PetscFunctionBegin;
comm = ((PetscObject)C)->comm;
size = c->size;
rank = c->rank;
Mbs = c->Mbs;
ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)C,&tag2);CHKERRQ(ierr);
/* create tables used in
step 1: table[i] - mark c->garray of proc [i]
step 3: table[i] - mark indices of is[i] when whose=MINE
table[0] - mark incideces of is[] when whose=OTHER */
len = PetscMax(is_max, size);CHKERRQ(ierr);
ierr = PetscMalloc2(len,PetscBT,&table,(Mbs/PETSC_BITS_PER_BYTE+1)*len,char,&t_p);CHKERRQ(ierr);
for (i=0; i<len; i++) {
table[i] = t_p + (Mbs/PETSC_BITS_PER_BYTE+1)*i;
}
ierr = MPI_Allreduce(&is_max,&ois_max,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
/* 1. Send this processor's is[] to other processors */
/*---------------------------------------------------*/
/* allocate spaces */
ierr = PetscMalloc(is_max*sizeof(PetscInt),&n);CHKERRQ(ierr);
len = 0;
for (i=0; i<is_max; i++) {
ierr = ISGetLocalSize(is[i],&n[i]);CHKERRQ(ierr);
len += n[i];
}
if (!len) {
is_max = 0;
} else {
len += 1 + is_max; /* max length of data1 for one processor */
}
ierr = PetscMalloc((size*len+1)*sizeof(PetscInt),&data1);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(PetscInt*),&data1_start);CHKERRQ(ierr);
for (i=0; i<size; i++) data1_start[i] = data1 + i*len;
ierr = PetscMalloc4(size,PetscInt,&len_s,size,PetscInt,&btable,size,PetscInt,&iwork,size+1,PetscInt,&Bowners);CHKERRQ(ierr);
/* gather c->garray from all processors */
ierr = ISCreateGeneral(comm,Bnbs,c->garray,&garray_local);CHKERRQ(ierr);
ierr = ISAllGather(garray_local, &garray_gl);CHKERRQ(ierr);
ierr = ISDestroy(garray_local);CHKERRQ(ierr);
ierr = MPI_Allgather(&Bnbs,1,MPIU_INT,Bowners+1,1,MPIU_INT,comm);CHKERRQ(ierr);
Bowners[0] = 0;
for (i=0; i<size; i++) Bowners[i+1] += Bowners[i];
if (is_max){
/* hash table ctable which maps c->row to proc_id) */
ierr = PetscMalloc(Mbs*sizeof(PetscInt),&ctable);CHKERRQ(ierr);
for (proc_id=0,j=0; proc_id<size; proc_id++) {
for (; j<C->rmap->range[proc_id+1]/bs; j++) {
ctable[j] = proc_id;
}
}
/* hash tables marking c->garray */
ierr = ISGetIndices(garray_gl,&idx_i);
for (i=0; i<size; i++){
table_i = table[i];
ierr = PetscBTMemzero(Mbs,table_i);CHKERRQ(ierr);
for (j = Bowners[i]; j<Bowners[i+1]; j++){ /* go through B cols of proc[i]*/
ierr = PetscBTSet(table_i,idx_i[j]);CHKERRQ(ierr);
}
}
ierr = ISRestoreIndices(garray_gl,&idx_i);CHKERRQ(ierr);
} /* if (is_max) */
ierr = ISDestroy(garray_gl);CHKERRQ(ierr);
/* evaluate communication - mesg to who, length, and buffer space */
for (i=0; i<size; i++) len_s[i] = 0;
/* header of data1 */
for (proc_id=0; proc_id<size; proc_id++){
iwork[proc_id] = 0;
*data1_start[proc_id] = is_max;
data1_start[proc_id]++;
for (j=0; j<is_max; j++) {
if (proc_id == rank){
*data1_start[proc_id] = n[j];
} else {
*data1_start[proc_id] = 0;
}
data1_start[proc_id]++;
}
}
for (i=0; i<is_max; i++) {
ierr = ISGetIndices(is[i],&idx_i);CHKERRQ(ierr);
for (j=0; j<n[i]; j++){
idx = idx_i[j];
*data1_start[rank] = idx; data1_start[rank]++; /* for local proccessing */
proc_end = ctable[idx];
for (proc_id=0; proc_id<=proc_end; proc_id++){ /* for others to process */
if (proc_id == rank ) continue; /* done before this loop */
if (proc_id < proc_end && !PetscBTLookup(table[proc_id],idx))
continue; /* no need for sending idx to [proc_id] */
*data1_start[proc_id] = idx; data1_start[proc_id]++;
len_s[proc_id]++;
}
}
/* update header data */
for (proc_id=0; proc_id<size; proc_id++){
if (proc_id== rank) continue;
*(data1 + proc_id*len + 1 + i) = len_s[proc_id] - iwork[proc_id];
iwork[proc_id] = len_s[proc_id] ;
}
ierr = ISRestoreIndices(is[i],&idx_i);CHKERRQ(ierr);
}
nrqs = 0; nrqr = 0;
for (i=0; i<size; i++){
data1_start[i] = data1 + i*len;
if (len_s[i]){
nrqs++;
len_s[i] += 1 + is_max; /* add no. of header msg */
}
}
for (i=0; i<is_max; i++) {
ierr = ISDestroy(is[i]);CHKERRQ(ierr);
}
ierr = PetscFree(n);CHKERRQ(ierr);
ierr = PetscFree(ctable);CHKERRQ(ierr);
/* Determine the number of messages to expect, their lengths, from from-ids */
ierr = PetscGatherNumberOfMessages(comm,PETSC_NULL,len_s,&nrqr);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths(comm,nrqs,nrqr,len_s,&id_r1,&len_r1);CHKERRQ(ierr);
/* Now post the sends */
ierr = PetscMalloc2(size,MPI_Request,&s_waits1,size,MPI_Request,&s_waits2);CHKERRQ(ierr);
k = 0;
for (proc_id=0; proc_id<size; proc_id++){ /* send data1 to processor [proc_id] */
if (len_s[proc_id]){
ierr = MPI_Isend(data1_start[proc_id],len_s[proc_id],MPIU_INT,proc_id,tag1,comm,s_waits1+k);CHKERRQ(ierr);
k++;
}
}
/* 2. Receive other's is[] and process. Then send back */
/*-----------------------------------------------------*/
len = 0;
for (i=0; i<nrqr; i++){
if (len_r1[i] > len)len = len_r1[i];
}
ierr = PetscFree(len_r1);CHKERRQ(ierr);
ierr = PetscFree(id_r1);CHKERRQ(ierr);
for (proc_id=0; proc_id<size; proc_id++)
len_s[proc_id] = iwork[proc_id] = 0;
ierr = PetscMalloc((len+1)*sizeof(PetscInt),&odata1);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(PetscInt**),&odata2_ptr);CHKERRQ(ierr);
ierr = PetscBTCreate(Mbs,otable);CHKERRQ(ierr);
len_max = ois_max*(Mbs+1); /* max space storing all is[] for each receive */
len_est = 2*len_max; /* estimated space of storing is[] for all receiving messages */
ierr = PetscMalloc((len_est+1)*sizeof(PetscInt),&odata2);CHKERRQ(ierr);
nodata2 = 0; /* nodata2+1: num of PetscMalloc(,&odata2_ptr[]) called */
odata2_ptr[nodata2] = odata2;
len_unused = len_est; /* unused space in the array odata2_ptr[nodata2]-- needs to be >= len_max */
k = 0;
while (k < nrqr){
/* Receive messages */
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag1,comm,&flag,&r_status);CHKERRQ(ierr);
if (flag){
ierr = MPI_Get_count(&r_status,MPIU_INT,&len);CHKERRQ(ierr);
proc_id = r_status.MPI_SOURCE;
ierr = MPI_Irecv(odata1,len,MPIU_INT,proc_id,r_status.MPI_TAG,comm,&r_req);CHKERRQ(ierr);
ierr = MPI_Wait(&r_req,&r_status);CHKERRQ(ierr);
/* Process messages */
/* make sure there is enough unused space in odata2 array */
if (len_unused < len_max){ /* allocate more space for odata2 */
ierr = PetscMalloc((len_est+1)*sizeof(PetscInt),&odata2);CHKERRQ(ierr);
odata2_ptr[++nodata2] = odata2;
len_unused = len_est;
}
ierr = MatIncreaseOverlap_MPISBAIJ_Local(C,odata1,OTHER,odata2,&otable);CHKERRQ(ierr);
len = 1 + odata2[0];
for (i=0; i<odata2[0]; i++){
len += odata2[1 + i];
}
/* Send messages back */
ierr = MPI_Isend(odata2,len,MPIU_INT,proc_id,tag2,comm,s_waits2+k);CHKERRQ(ierr);
k++;
odata2 += len;
len_unused -= len;
len_s[proc_id] = len; /* num of messages sending back to [proc_id] by this proc */
}
}
ierr = PetscFree(odata1);CHKERRQ(ierr);
ierr = PetscBTDestroy(otable);CHKERRQ(ierr);
/* 3. Do local work on this processor's is[] */
/*-------------------------------------------*/
/* make sure there is enough unused space in odata2(=data) array */
len_max = is_max*(Mbs+1); /* max space storing all is[] for this processor */
if (len_unused < len_max){ /* allocate more space for odata2 */
ierr = PetscMalloc((len_est+1)*sizeof(PetscInt),&odata2);CHKERRQ(ierr);
odata2_ptr[++nodata2] = odata2;
len_unused = len_est;
}
data = odata2;
ierr = MatIncreaseOverlap_MPISBAIJ_Local(C,data1_start[rank],MINE,data,table);CHKERRQ(ierr);
ierr = PetscFree(data1_start);CHKERRQ(ierr);
/* 4. Receive work done on other processors, then merge */
/*------------------------------------------------------*/
/* get max number of messages that this processor expects to recv */
ierr = MPI_Allreduce(len_s,iwork,size,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
ierr = PetscMalloc((iwork[rank]+1)*sizeof(PetscInt),&data2);CHKERRQ(ierr);
ierr = PetscFree4(len_s,btable,iwork,Bowners);CHKERRQ(ierr);
k = 0;
while (k < nrqs){
/* Receive messages */
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag2,comm,&flag,&r_status);
if (flag){
ierr = MPI_Get_count(&r_status,MPIU_INT,&len);CHKERRQ(ierr);
proc_id = r_status.MPI_SOURCE;
ierr = MPI_Irecv(data2,len,MPIU_INT,proc_id,r_status.MPI_TAG,comm,&r_req);CHKERRQ(ierr);
ierr = MPI_Wait(&r_req,&r_status);CHKERRQ(ierr);
if (len > 1+is_max){ /* Add data2 into data */
data2_i = data2 + 1 + is_max;
for (i=0; i<is_max; i++){
table_i = table[i];
data_i = data + 1 + is_max + Mbs*i;
isz = data[1+i];
for (j=0; j<data2[1+i]; j++){
col = data2_i[j];
if (!PetscBTLookupSet(table_i,col)) {data_i[isz++] = col;}
}
data[1+i] = isz;
if (i < is_max - 1) data2_i += data2[1+i];
}
}
k++;
}
}
ierr = PetscFree(data2);CHKERRQ(ierr);
ierr = PetscFree2(table,t_p);CHKERRQ(ierr);
/* phase 1 sends are complete */
ierr = PetscMalloc(size*sizeof(MPI_Status),&s_status);CHKERRQ(ierr);
if (nrqs) {ierr = MPI_Waitall(nrqs,s_waits1,s_status);CHKERRQ(ierr);}
ierr = PetscFree(data1);CHKERRQ(ierr);
/* phase 2 sends are complete */
if (nrqr){ierr = MPI_Waitall(nrqr,s_waits2,s_status);CHKERRQ(ierr);}
ierr = PetscFree2(s_waits1,s_waits2);CHKERRQ(ierr);
ierr = PetscFree(s_status);CHKERRQ(ierr);
/* 5. Create new is[] */
/*--------------------*/
for (i=0; i<is_max; i++) {
data_i = data + 1 + is_max + Mbs*i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,data[1+i],data_i,is+i);CHKERRQ(ierr);
}
for (k=0; k<=nodata2; k++){
ierr = PetscFree(odata2_ptr[k]);CHKERRQ(ierr);
}
ierr = PetscFree(odata2_ptr);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_Redistribute(PC pc)
{
PC_Redistribute *red = (PC_Redistribute*)pc->data;
PetscErrorCode ierr;
MPI_Comm comm;
PetscInt rstart,rend,i,nz,cnt,*rows,ncnt,dcnt,*drows;
PetscLayout map,nmap;
PetscMPIInt size,imdex,tag,n;
PetscInt *source = PETSC_NULL;
PetscMPIInt *nprocs = PETSC_NULL,nrecvs;
PetscInt j,nsends;
PetscInt *owner = PETSC_NULL,*starts = PETSC_NULL,count,slen;
PetscInt *rvalues,*svalues,recvtotal;
PetscMPIInt *onodes1,*olengths1;
MPI_Request *send_waits = PETSC_NULL,*recv_waits = PETSC_NULL;
MPI_Status recv_status,*send_status;
Vec tvec,diag;
Mat tmat;
const PetscScalar *d;
PetscFunctionBegin;
if (pc->setupcalled) {
ierr = KSPGetOperators(red->ksp,PETSC_NULL,&tmat,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_REUSE_MATRIX,&tmat);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
PetscInt NN;
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)pc,&tag);CHKERRQ(ierr);
/* count non-diagonal rows on process */
ierr = MatGetOwnershipRange(pc->mat,&rstart,&rend);CHKERRQ(ierr);
cnt = 0;
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
if (nz > 1) cnt++;
ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
ierr = PetscMalloc(cnt*sizeof(PetscInt),&rows);CHKERRQ(ierr);
ierr = PetscMalloc((rend - rstart - cnt)*sizeof(PetscInt),&drows);CHKERRQ(ierr);
/* list non-diagonal rows on process */
cnt = 0; dcnt = 0;
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
if (nz > 1) rows[cnt++] = i;
else drows[dcnt++] = i - rstart;
ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
/* create PetscLayout for non-diagonal rows on each process */
ierr = PetscLayoutCreate(comm,&map);CHKERRQ(ierr);
ierr = PetscLayoutSetLocalSize(map,cnt);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(map,1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(map);CHKERRQ(ierr);
rstart = map->rstart;
rend = map->rend;
/* create PetscLayout for load-balanced non-diagonal rows on each process */
ierr = PetscLayoutCreate(comm,&nmap);CHKERRQ(ierr);
ierr = MPI_Allreduce(&cnt,&ncnt,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
ierr = PetscLayoutSetSize(nmap,ncnt);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(nmap,1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(nmap);CHKERRQ(ierr);
ierr = MatGetSize(pc->pmat,&NN,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscInfo2(pc,"Number of diagonal rows eliminated %d, percentage eliminated %g\n",NN-ncnt,((PetscReal)(NN-ncnt))/((PetscReal)(NN)));CHKERRQ(ierr);
/*
this code is taken from VecScatterCreate_PtoS()
Determines what rows need to be moved where to
load balance the non-diagonal rows
*/
/* count number of contributors to each processor */
ierr = PetscMalloc2(size,PetscMPIInt,&nprocs,cnt,PetscInt,&owner);CHKERRQ(ierr);
ierr = PetscMemzero(nprocs,size*sizeof(PetscMPIInt));CHKERRQ(ierr);
j = 0;
nsends = 0;
for (i=rstart; i<rend; i++) {
if (i < nmap->range[j]) j = 0;
for (; j<size; j++) {
if (i < nmap->range[j+1]) {
if (!nprocs[j]++) nsends++;
owner[i-rstart] = j;
break;
}
}
}
/* inform other processors of number of messages and max length*/
ierr = PetscGatherNumberOfMessages(comm,PETSC_NULL,nprocs,&nrecvs);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths(comm,nsends,nrecvs,nprocs,&onodes1,&olengths1);CHKERRQ(ierr);
ierr = PetscSortMPIIntWithArray(nrecvs,onodes1,olengths1);CHKERRQ(ierr);
recvtotal = 0; for (i=0; i<nrecvs; i++) recvtotal += olengths1[i];
/* post receives: rvalues - rows I will own; count - nu */
ierr = PetscMalloc3(recvtotal,PetscInt,&rvalues,nrecvs,PetscInt,&source,nrecvs,MPI_Request,&recv_waits);CHKERRQ(ierr);
count = 0;
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv((rvalues+count),olengths1[i],MPIU_INT,onodes1[i],tag,comm,recv_waits+i);CHKERRQ(ierr);
count += olengths1[i];
}
/* do sends:
1) starts[i] gives the starting index in svalues for stuff going to
the ith processor
*/
ierr = PetscMalloc3(cnt,PetscInt,&svalues,nsends,MPI_Request,&send_waits,size,PetscInt,&starts);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];}
for (i=0; i<cnt; i++) {
svalues[starts[owner[i]]++] = rows[i];
}
for (i=0; i<cnt; i++) rows[i] = rows[i] - rstart;
red->drows = drows;
red->dcnt = dcnt;
ierr = PetscFree(rows);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];}
count = 0;
for (i=0; i<size; i++) {
if (nprocs[i]) {
ierr = MPI_Isend(svalues+starts[i],nprocs[i],MPIU_INT,i,tag,comm,send_waits+count++);CHKERRQ(ierr);
}
}
/* wait on receives */
count = nrecvs;
slen = 0;
while (count) {
ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr);
/* unpack receives into our local space */
ierr = MPI_Get_count(&recv_status,MPIU_INT,&n);CHKERRQ(ierr);
slen += n;
count--;
}
if (slen != recvtotal) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Total message lengths %D not expected %D",slen,recvtotal);
ierr = ISCreateGeneral(comm,slen,rvalues,PETSC_COPY_VALUES,&red->is);CHKERRQ(ierr);
/* free up all work space */
ierr = PetscFree(olengths1);CHKERRQ(ierr);
ierr = PetscFree(onodes1);CHKERRQ(ierr);
ierr = PetscFree3(rvalues,source,recv_waits);CHKERRQ(ierr);
ierr = PetscFree2(nprocs,owner);CHKERRQ(ierr);
if (nsends) { /* wait on sends */
ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr);
ierr = PetscFree(send_status);CHKERRQ(ierr);
}
ierr = PetscFree3(svalues,send_waits,starts);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&map);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&nmap);CHKERRQ(ierr);
ierr = VecCreateMPI(comm,slen,PETSC_DETERMINE,&red->b);CHKERRQ(ierr);
ierr = VecDuplicate(red->b,&red->x);CHKERRQ(ierr);
ierr = MatGetVecs(pc->pmat,&tvec,PETSC_NULL);CHKERRQ(ierr);
ierr = VecScatterCreate(tvec,red->is,red->b,PETSC_NULL,&red->scatter);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDestroy(&tmat);CHKERRQ(ierr);
}
/* get diagonal portion of matrix */
ierr = PetscMalloc(red->dcnt*sizeof(PetscScalar),&red->diag);CHKERRQ(ierr);
ierr = MatGetVecs(pc->pmat,&diag,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetDiagonal(pc->pmat,diag);CHKERRQ(ierr);
ierr = VecGetArrayRead(diag,&d);CHKERRQ(ierr);
for (i=0; i<red->dcnt; i++) {
red->diag[i] = 1.0/d[red->drows[i]];
}
ierr = VecRestoreArrayRead(diag,&d);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
ierr = KSPSetUp(red->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatPtAPSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat P,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
Mat Cmpi;
Mat_PtAPMPI *ptap;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
Mat_MPIAIJ *a =(Mat_MPIAIJ*)A->data,*p=(Mat_MPIAIJ*)P->data,*c;
Mat_SeqAIJ *ad =(Mat_SeqAIJ*)(a->A)->data,*ao=(Mat_SeqAIJ*)(a->B)->data;
Mat_SeqAIJ *p_loc,*p_oth;
PetscInt *pi_loc,*pj_loc,*pi_oth,*pj_oth,*pdti,*pdtj,*poti,*potj,*ptJ;
PetscInt *adi=ad->i,*aj,*aoi=ao->i,nnz;
PetscInt *lnk,*owners_co,*coi,*coj,i,k,pnz,row;
PetscInt am=A->rmap->n,pN=P->cmap->N,pm=P->rmap->n,pn=P->cmap->n;
PetscBT lnkbt;
MPI_Comm comm;
PetscMPIInt size,rank,tagi,tagj,*len_si,*len_s,*len_ri,icompleted=0;
PetscInt **buf_rj,**buf_ri,**buf_ri_k;
PetscInt len,proc,*dnz,*onz,*owners;
PetscInt nzi,*pti,*ptj;
PetscInt nrows,*buf_s,*buf_si,*buf_si_i,**nextrow,**nextci;
MPI_Request *swaits,*rwaits;
MPI_Status *sstatus,rstatus;
Mat_Merge_SeqsToMPI *merge;
PetscInt *api,*apj,*Jptr,apnz,*prmap=p->garray,pon,nspacedouble=0,j,ap_rmax=0;
PetscReal afill=1.0,afill_tmp;
PetscInt rmax;
#if defined(PTAP_PROFILE)
PetscLogDouble t0,t1,t2,t3,t4;
#endif
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t0);CHKERRQ(ierr);
#endif
/* check if matrix local sizes are compatible */
if (A->rmap->rstart != P->rmap->rstart || A->rmap->rend != P->rmap->rend) {
SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Arow (%D, %D) != Prow (%D,%D)",A->rmap->rstart,A->rmap->rend,P->rmap->rstart,P->rmap->rend);
}
if (A->cmap->rstart != P->rmap->rstart || A->cmap->rend != P->rmap->rend) {
SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Acol (%D, %D) != Prow (%D,%D)",A->cmap->rstart,A->cmap->rend,P->rmap->rstart,P->rmap->rend);
}
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/* create struct Mat_PtAPMPI and attached it to C later */
ierr = PetscNew(&ptap);CHKERRQ(ierr);
ierr = PetscNew(&merge);CHKERRQ(ierr);
ptap->merge = merge;
ptap->reuse = MAT_INITIAL_MATRIX;
/* get P_oth by taking rows of P (= non-zero cols of local A) from other processors */
ierr = MatGetBrowsOfAoCols_MPIAIJ(A,P,MAT_INITIAL_MATRIX,&ptap->startsj_s,&ptap->startsj_r,&ptap->bufa,&ptap->P_oth);CHKERRQ(ierr);
/* get P_loc by taking all local rows of P */
ierr = MatMPIAIJGetLocalMat(P,MAT_INITIAL_MATRIX,&ptap->P_loc);CHKERRQ(ierr);
p_loc = (Mat_SeqAIJ*)(ptap->P_loc)->data;
p_oth = (Mat_SeqAIJ*)(ptap->P_oth)->data;
pi_loc = p_loc->i; pj_loc = p_loc->j;
pi_oth = p_oth->i; pj_oth = p_oth->j;
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t1);CHKERRQ(ierr);
#endif
/* first, compute symbolic AP = A_loc*P = A_diag*P_loc + A_off*P_oth */
/*-------------------------------------------------------------------*/
ierr = PetscMalloc1((am+1),&api);CHKERRQ(ierr);
api[0] = 0;
/* create and initialize a linked list */
ierr = PetscLLCondensedCreate(pN,pN,&lnk,&lnkbt);CHKERRQ(ierr);
/* Initial FreeSpace size is fill*(nnz(A) + nnz(P)) -OOM for ex56, np=8k on Intrepid! */
ierr = PetscFreeSpaceGet((PetscInt)(fill*(adi[am]+aoi[am]+pi_loc[pm])),&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<am; i++) {
/* diagonal portion of A */
nzi = adi[i+1] - adi[i];
aj = ad->j + adi[i];
for (j=0; j<nzi; j++) {
row = aj[j];
pnz = pi_loc[row+1] - pi_loc[row];
Jptr = pj_loc + pi_loc[row];
/* add non-zero cols of P into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
/* off-diagonal portion of A */
nzi = aoi[i+1] - aoi[i];
aj = ao->j + aoi[i];
for (j=0; j<nzi; j++) {
row = aj[j];
pnz = pi_oth[row+1] - pi_oth[row];
Jptr = pj_oth + pi_oth[row];
ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
apnz = lnk[0];
api[i+1] = api[i] + apnz;
if (ap_rmax < apnz) ap_rmax = apnz;
/* if free space is not available, double the total space in the list */
if (current_space->local_remaining<apnz) {
ierr = PetscFreeSpaceGet(apnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, then initialize lnk */
ierr = PetscLLCondensedClean(pN,apnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
current_space->array += apnz;
current_space->local_used += apnz;
current_space->local_remaining -= apnz;
}
/* Allocate space for apj, initialize apj, and */
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1((api[am]+1),&apj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,apj);CHKERRQ(ierr);
afill_tmp = (PetscReal)api[am]/(adi[am]+aoi[am]+pi_loc[pm]+1);
if (afill_tmp > afill) afill = afill_tmp;
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t2);CHKERRQ(ierr);
#endif
/* determine symbolic Co=(p->B)^T*AP - send to others */
/*----------------------------------------------------*/
ierr = MatGetSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr);
/* then, compute symbolic Co = (p->B)^T*AP */
pon = (p->B)->cmap->n; /* total num of rows to be sent to other processors
>= (num of nonzero rows of C_seq) - pn */
ierr = PetscMalloc1((pon+1),&coi);CHKERRQ(ierr);
coi[0] = 0;
/* set initial free space to be fill*(nnz(p->B) + nnz(AP)) */
nnz = fill*(poti[pon] + api[am]);
ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<pon; i++) {
pnz = poti[i+1] - poti[i];
ptJ = potj + poti[i];
for (j=0; j<pnz; j++) {
row = ptJ[j]; /* row of AP == col of Pot */
apnz = api[row+1] - api[row];
Jptr = apj + api[row];
/* add non-zero cols of AP into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
nnz = lnk[0];
/* If free space is not available, double the total space in the list */
if (current_space->local_remaining<nnz) {
ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, and zero out denserows */
ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
current_space->array += nnz;
current_space->local_used += nnz;
current_space->local_remaining -= nnz;
coi[i+1] = coi[i] + nnz;
}
ierr = PetscMalloc1((coi[pon]+1),&coj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,coj);CHKERRQ(ierr);
afill_tmp = (PetscReal)coi[pon]/(poti[pon] + api[am]+1);
if (afill_tmp > afill) afill = afill_tmp;
ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr);
/* send j-array (coj) of Co to other processors */
/*----------------------------------------------*/
/* determine row ownership */
ierr = PetscLayoutCreate(comm,&merge->rowmap);CHKERRQ(ierr);
merge->rowmap->n = pn;
merge->rowmap->bs = 1;
ierr = PetscLayoutSetUp(merge->rowmap);CHKERRQ(ierr);
owners = merge->rowmap->range;
/* determine the number of messages to send, their lengths */
ierr = PetscMalloc2(size,&len_si,size,&sstatus);CHKERRQ(ierr);
ierr = PetscMemzero(len_si,size*sizeof(PetscMPIInt));CHKERRQ(ierr);
ierr = PetscCalloc1(size,&merge->len_s);CHKERRQ(ierr);
len_s = merge->len_s;
merge->nsend = 0;
ierr = PetscMalloc1((size+2),&owners_co);CHKERRQ(ierr);
proc = 0;
for (i=0; i<pon; i++) {
while (prmap[i] >= owners[proc+1]) proc++;
len_si[proc]++; /* num of rows in Co to be sent to [proc] */
len_s[proc] += coi[i+1] - coi[i];
}
len = 0; /* max length of buf_si[] */
owners_co[0] = 0;
for (proc=0; proc<size; proc++) {
owners_co[proc+1] = owners_co[proc] + len_si[proc];
if (len_si[proc]) {
merge->nsend++;
len_si[proc] = 2*(len_si[proc] + 1);
len += len_si[proc];
}
}
/* determine the number and length of messages to receive for coi and coj */
ierr = PetscGatherNumberOfMessages(comm,NULL,len_s,&merge->nrecv);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths2(comm,merge->nsend,merge->nrecv,len_s,len_si,&merge->id_r,&merge->len_r,&len_ri);CHKERRQ(ierr);
/* post the Irecv and Isend of coj */
ierr = PetscCommGetNewTag(comm,&tagj);CHKERRQ(ierr);
ierr = PetscPostIrecvInt(comm,tagj,merge->nrecv,merge->id_r,merge->len_r,&buf_rj,&rwaits);CHKERRQ(ierr);
ierr = PetscMalloc1((merge->nsend+1),&swaits);CHKERRQ(ierr);
for (proc=0, k=0; proc<size; proc++) {
if (!len_s[proc]) continue;
i = owners_co[proc];
ierr = MPI_Isend(coj+coi[i],len_s[proc],MPIU_INT,proc,tagj,comm,swaits+k);CHKERRQ(ierr);
k++;
}
/* receives and sends of coj are complete */
for (i=0; i<merge->nrecv; i++) {
ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr);
}
ierr = PetscFree(rwaits);CHKERRQ(ierr);
if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);}
/* send and recv coi */
/*-------------------*/
ierr = PetscCommGetNewTag(comm,&tagi);CHKERRQ(ierr);
ierr = PetscPostIrecvInt(comm,tagi,merge->nrecv,merge->id_r,len_ri,&buf_ri,&rwaits);CHKERRQ(ierr);
ierr = PetscMalloc1((len+1),&buf_s);CHKERRQ(ierr);
buf_si = buf_s; /* points to the beginning of k-th msg to be sent */
for (proc=0,k=0; proc<size; proc++) {
if (!len_s[proc]) continue;
/* form outgoing message for i-structure:
buf_si[0]: nrows to be sent
[1:nrows]: row index (global)
[nrows+1:2*nrows+1]: i-structure index
*/
/*-------------------------------------------*/
nrows = len_si[proc]/2 - 1;
buf_si_i = buf_si + nrows+1;
buf_si[0] = nrows;
buf_si_i[0] = 0;
nrows = 0;
for (i=owners_co[proc]; i<owners_co[proc+1]; i++) {
nzi = coi[i+1] - coi[i];
buf_si_i[nrows+1] = buf_si_i[nrows] + nzi; /* i-structure */
buf_si[nrows+1] = prmap[i] -owners[proc]; /* local row index */
nrows++;
}
ierr = MPI_Isend(buf_si,len_si[proc],MPIU_INT,proc,tagi,comm,swaits+k);CHKERRQ(ierr);
k++;
buf_si += len_si[proc];
}
i = merge->nrecv;
while (i--) {
ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr);
}
ierr = PetscFree(rwaits);CHKERRQ(ierr);
if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);}
ierr = PetscFree2(len_si,sstatus);CHKERRQ(ierr);
ierr = PetscFree(len_ri);CHKERRQ(ierr);
ierr = PetscFree(swaits);CHKERRQ(ierr);
ierr = PetscFree(buf_s);CHKERRQ(ierr);
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t3);CHKERRQ(ierr);
#endif
/* compute the local portion of C (mpi mat) */
/*------------------------------------------*/
ierr = MatGetSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr);
/* allocate pti array and free space for accumulating nonzero column info */
ierr = PetscMalloc1((pn+1),&pti);CHKERRQ(ierr);
pti[0] = 0;
/* set initial free space to be fill*(nnz(P) + nnz(AP)) */
nnz = fill*(pi_loc[pm] + api[am]);
ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr);
current_space = free_space;
ierr = PetscMalloc3(merge->nrecv,&buf_ri_k,merge->nrecv,&nextrow,merge->nrecv,&nextci);CHKERRQ(ierr);
for (k=0; k<merge->nrecv; k++) {
buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */
nrows = *buf_ri_k[k];
nextrow[k] = buf_ri_k[k] + 1; /* next row number of k-th recved i-structure */
nextci[k] = buf_ri_k[k] + (nrows + 1); /* poins to the next i-structure of k-th recved i-structure */
}
ierr = MatPreallocateInitialize(comm,pn,pn,dnz,onz);CHKERRQ(ierr);
rmax = 0;
for (i=0; i<pn; i++) {
/* add pdt[i,:]*AP into lnk */
pnz = pdti[i+1] - pdti[i];
ptJ = pdtj + pdti[i];
for (j=0; j<pnz; j++) {
row = ptJ[j]; /* row of AP == col of Pt */
apnz = api[row+1] - api[row];
Jptr = apj + api[row];
/* add non-zero cols of AP into the sorted linked list lnk */
ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr);
}
/* add received col data into lnk */
for (k=0; k<merge->nrecv; k++) { /* k-th received message */
if (i == *nextrow[k]) { /* i-th row */
nzi = *(nextci[k]+1) - *nextci[k];
Jptr = buf_rj[k] + *nextci[k];
ierr = PetscLLCondensedAddSorted(nzi,Jptr,lnk,lnkbt);CHKERRQ(ierr);
nextrow[k]++; nextci[k]++;
}
}
nnz = lnk[0];
/* if free space is not available, make more free space */
if (current_space->local_remaining<nnz) {
ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* copy data into free space, then initialize lnk */
ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr);
ierr = MatPreallocateSet(i+owners[rank],nnz,current_space->array,dnz,onz);CHKERRQ(ierr);
current_space->array += nnz;
current_space->local_used += nnz;
current_space->local_remaining -= nnz;
pti[i+1] = pti[i] + nnz;
if (nnz > rmax) rmax = nnz;
}
ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr);
ierr = PetscFree3(buf_ri_k,nextrow,nextci);CHKERRQ(ierr);
ierr = PetscMalloc1((pti[pn]+1),&ptj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,ptj);CHKERRQ(ierr);
afill_tmp = (PetscReal)pti[pn]/(pi_loc[pm] + api[am]+1);
if (afill_tmp > afill) afill = afill_tmp;
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
/* create symbolic parallel matrix Cmpi */
/*--------------------------------------*/
ierr = MatCreate(comm,&Cmpi);CHKERRQ(ierr);
ierr = MatSetSizes(Cmpi,pn,pn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Cmpi,P->cmap->bs,P->cmap->bs);CHKERRQ(ierr);
ierr = MatSetType(Cmpi,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Cmpi,0,dnz,0,onz);CHKERRQ(ierr);
ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
merge->bi = pti; /* Cseq->i */
merge->bj = ptj; /* Cseq->j */
merge->coi = coi; /* Co->i */
merge->coj = coj; /* Co->j */
merge->buf_ri = buf_ri;
merge->buf_rj = buf_rj;
merge->owners_co = owners_co;
merge->destroy = Cmpi->ops->destroy;
merge->duplicate = Cmpi->ops->duplicate;
/* Cmpi is not ready for use - assembly will be done by MatPtAPNumeric() */
Cmpi->assembled = PETSC_FALSE;
Cmpi->ops->destroy = MatDestroy_MPIAIJ_PtAP;
Cmpi->ops->duplicate = MatDuplicate_MPIAIJ_MatPtAP;
/* attach the supporting struct to Cmpi for reuse */
c = (Mat_MPIAIJ*)Cmpi->data;
c->ptap = ptap;
ptap->api = api;
ptap->apj = apj;
ptap->rmax = ap_rmax;
*C = Cmpi;
/* flag 'scalable' determines which implementations to be used:
0: do dense axpy in MatPtAPNumeric() - fast, but requires storage of a nonscalable dense array apa;
1: do sparse axpy in MatPtAPNumeric() - might slow, uses a sparse array apa */
/* set default scalable */
ptap->scalable = PETSC_TRUE;
ierr = PetscOptionsGetBool(((PetscObject)Cmpi)->prefix,"-matptap_scalable",&ptap->scalable,NULL);CHKERRQ(ierr);
if (!ptap->scalable) { /* Do dense axpy */
ierr = PetscCalloc1(pN,&ptap->apa);CHKERRQ(ierr);
} else {
ierr = PetscCalloc1(ap_rmax+1,&ptap->apa);CHKERRQ(ierr);
}
#if defined(PTAP_PROFILE)
ierr = PetscTime(&t4);CHKERRQ(ierr);
if (rank==1) PetscPrintf(MPI_COMM_SELF," [%d] PtAPSymbolic %g/P + %g/AP + %g/comm + %g/PtAP = %g\n",rank,t1-t0,t2-t1,t3-t2,t4-t3,t4-t0);CHKERRQ(ierr);
#endif
#if defined(PETSC_USE_INFO)
if (pti[pn] != 0) {
ierr = PetscInfo3(Cmpi,"Reallocs %D; Fill ratio: given %G needed %G.\n",nspacedouble,fill,afill);CHKERRQ(ierr);
ierr = PetscInfo1(Cmpi,"Use MatPtAP(A,P,MatReuse,%G,&C) for best performance.\n",afill);CHKERRQ(ierr);
} else {
ierr = PetscInfo(Cmpi,"Empty matrix product\n");CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
