void PETSC_STDCALL petscsortmpiintwitharray_(PetscMPIInt *n,PetscMPIInt i[],PetscMPIInt Ii[], int *__ierr ){ *__ierr = PetscSortMPIIntWithArray(*n,i,Ii); }
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); }
/*@ ISBuildTwoSided - Takes an IS that describes where we will go. Generates an IS that contains new numbers from remote or local on the IS. Collective on IS Input Parameters . to - an IS describes where we will go. Negative target rank will be ignored . toindx - an IS describes what indices should send. NULL means sending natural numbering Output Parameter: . rows - contains new numbers from remote or local Level: advanced .seealso: MatPartitioningCreate(), ISPartitioningToNumbering(), ISPartitioningCount() @*/ PetscErrorCode ISBuildTwoSided(IS ito,IS toindx, IS *rows) { const PetscInt *ito_indices,*toindx_indices; PetscInt *send_indices,rstart,*recv_indices,nrecvs,nsends; PetscInt *tosizes,*fromsizes,i,j,*tosizes_tmp,*tooffsets_tmp,ito_ln; PetscMPIInt *toranks,*fromranks,size,target_rank,*fromperm_newtoold,nto,nfrom; PetscLayout isrmap; MPI_Comm comm; PetscSF sf; PetscSFNode *iremote; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)ito,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = ISGetLocalSize(ito,&ito_ln);CHKERRQ(ierr); /* why we do not have ISGetLayout? */ isrmap = ito->map; ierr = PetscLayoutGetRange(isrmap,&rstart,NULL);CHKERRQ(ierr); ierr = ISGetIndices(ito,&ito_indices);CHKERRQ(ierr); ierr = PetscCalloc2(size,&tosizes_tmp,size+1,&tooffsets_tmp);CHKERRQ(ierr); for(i=0; i<ito_ln; i++){ if(ito_indices[i]<0) continue; #if defined(PETSC_USE_DEBUG) if(ito_indices[i]>=size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"target rank %d is larger than communicator size %d ",ito_indices[i],size); #endif tosizes_tmp[ito_indices[i]]++; } nto = 0; for(i=0; i<size; i++){ tooffsets_tmp[i+1] = tooffsets_tmp[i]+tosizes_tmp[i]; if(tosizes_tmp[i]>0) nto++; } ierr = PetscCalloc2(nto,&toranks,2*nto,&tosizes);CHKERRQ(ierr); nto = 0; for(i=0; i<size; i++){ if(tosizes_tmp[i]>0){ toranks[nto] = i; tosizes[2*nto] = tosizes_tmp[i];/* size */ tosizes[2*nto+1] = tooffsets_tmp[i];/* offset */ nto++; } } nsends = tooffsets_tmp[size]; ierr = PetscCalloc1(nsends,&send_indices);CHKERRQ(ierr); if(toindx){ ierr = ISGetIndices(toindx,&toindx_indices);CHKERRQ(ierr); } for(i=0; i<ito_ln; i++){ if(ito_indices[i]<0) continue; target_rank = ito_indices[i]; send_indices[tooffsets_tmp[target_rank]] = toindx? toindx_indices[i]:(i+rstart); tooffsets_tmp[target_rank]++; } if(toindx){ ierr = ISRestoreIndices(toindx,&toindx_indices);CHKERRQ(ierr); } ierr = ISRestoreIndices(ito,&ito_indices);CHKERRQ(ierr); ierr = PetscFree2(tosizes_tmp,tooffsets_tmp);CHKERRQ(ierr); ierr = PetscCommBuildTwoSided(comm,2,MPIU_INT,nto,toranks,tosizes,&nfrom,&fromranks,&fromsizes);CHKERRQ(ierr); ierr = PetscFree2(toranks,tosizes);CHKERRQ(ierr); ierr = PetscCalloc1(nfrom,&fromperm_newtoold);CHKERRQ(ierr); for(i=0; i<nfrom; i++){ fromperm_newtoold[i] = i; } ierr = PetscSortMPIIntWithArray(nfrom,fromranks,fromperm_newtoold);CHKERRQ(ierr); nrecvs = 0; for(i=0; i<nfrom; i++){ nrecvs += fromsizes[i*2]; } ierr = PetscCalloc1(nrecvs,&recv_indices);CHKERRQ(ierr); ierr = PetscCalloc1(nrecvs,&iremote);CHKERRQ(ierr); nrecvs = 0; for(i=0; i<nfrom; i++){ for(j=0; j<fromsizes[2*fromperm_newtoold[i]]; j++){ iremote[nrecvs].rank = fromranks[i]; iremote[nrecvs++].index = fromsizes[2*fromperm_newtoold[i]+1]+j; } } ierr = PetscSFCreate(comm,&sf);CHKERRQ(ierr); ierr = PetscSFSetGraph(sf,nsends,nrecvs,NULL,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr); ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr); /* how to put a prefix ? */ ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr); ierr = PetscSFBcastBegin(sf,MPIU_INT,send_indices,recv_indices);CHKERRQ(ierr); ierr = PetscSFBcastEnd(sf,MPIU_INT,send_indices,recv_indices);CHKERRQ(ierr); ierr = PetscSFDestroy(&sf);CHKERRQ(ierr); ierr = PetscFree(fromranks);CHKERRQ(ierr); ierr = PetscFree(fromsizes);CHKERRQ(ierr); ierr = PetscFree(fromperm_newtoold);CHKERRQ(ierr); ierr = PetscFree(send_indices);CHKERRQ(ierr); if(rows){ ierr = PetscSortInt(nrecvs,recv_indices);CHKERRQ(ierr); ierr = ISCreateGeneral(comm, nrecvs,recv_indices,PETSC_OWN_POINTER,rows);CHKERRQ(ierr); }else{ ierr = PetscFree(recv_indices);CHKERRQ(ierr); } PetscFunctionReturn(0); }