int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,n,*indices;
PetscInt rank,size;
IS is,newis;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/*
Create IS
*/
n = 4 + rank;
ierr = PetscMalloc1(n,&indices);CHKERRQ(ierr);
for (i=0; i<n; i++) indices[i] = rank + i;
ierr = ISCreateGeneral(PETSC_COMM_WORLD,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
/*
Stick them together from all processors
*/
ierr = ISAllGather(is,&newis);CHKERRQ(ierr);
if (!rank) {
ierr = ISView(newis,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
ierr = ISDestroy(&newis);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode ISInvertPermutation_General(IS is,PetscInt nlocal,IS *isout)
{
IS_General *sub = (IS_General*)is->data;
PetscInt i,*ii,n,nstart;
const PetscInt *idx = sub->idx;
PetscMPIInt size;
IS istmp,nistmp;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLayoutGetLocalSize(is->map, &n);CHKERRQ(ierr);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);CHKERRQ(ierr);
if (size == 1) {
ierr = PetscMalloc1(n,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) ii[idx[i]] = i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ii,PETSC_OWN_POINTER,isout);CHKERRQ(ierr);
ierr = ISSetPermutation(*isout);CHKERRQ(ierr);
} else {
/* crude, nonscalable get entire IS on each processor */
if (nlocal == PETSC_DECIDE) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Do not yet support nlocal of PETSC_DECIDE");
ierr = ISAllGather(is,&istmp);CHKERRQ(ierr);
ierr = ISSetPermutation(istmp);CHKERRQ(ierr);
ierr = ISInvertPermutation(istmp,PETSC_DECIDE,&nistmp);CHKERRQ(ierr);
ierr = ISDestroy(&istmp);CHKERRQ(ierr);
/* get the part we need */
ierr = MPI_Scan(&nlocal,&nstart,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)is));CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
{
PetscInt N;
PetscMPIInt rank;
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)is),&rank);CHKERRQ(ierr);
ierr = PetscLayoutGetSize(is->map, &N);CHKERRQ(ierr);
if (rank == size-1) {
if (nstart != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Sum of nlocal lengths %d != total IS length %d",nstart,N);
}
}
#endif
nstart -= nlocal;
ierr = ISGetIndices(nistmp,&idx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)is),nlocal,idx+nstart,PETSC_COPY_VALUES,isout);CHKERRQ(ierr);
ierr = ISRestoreIndices(nistmp,&idx);CHKERRQ(ierr);
ierr = ISDestroy(&nistmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
* Increase overlap for the sub-matrix across sub communicator
* sub-matrix could be a graph or numerical matrix
* */
PetscErrorCode MatIncreaseOverlapSplit_Single(Mat mat,IS *is,PetscInt ov)
{
PetscInt i,nindx,*indices_sc,*indices_ov,localsize,*localsizes_sc,localsize_tmp;
PetscInt *indices_ov_rd,nroots,nleaves,*localoffsets,*indices_recv,*sources_sc,*sources_sc_rd;
const PetscInt *indices;
PetscMPIInt srank,ssize,issamecomm,k,grank;
IS is_sc,allis_sc,partitioning;
MPI_Comm gcomm,dcomm,scomm;
PetscSF sf;
PetscSFNode *remote;
Mat *smat;
MatPartitioning part;
PetscErrorCode ierr;
PetscFunctionBegin;
/* get a sub communicator before call individual MatIncreaseOverlap
* since the sub communicator may be changed.
* */
ierr = PetscObjectGetComm((PetscObject)(*is),&dcomm);CHKERRQ(ierr);
/*make a copy before the original one is deleted*/
ierr = PetscCommDuplicate(dcomm,&scomm,NULL);CHKERRQ(ierr);
/*get a global communicator, where mat should be a global matrix */
ierr = PetscObjectGetComm((PetscObject)mat,&gcomm);CHKERRQ(ierr);
/*increase overlap on each individual subdomain*/
ierr = (*mat->ops->increaseoverlap)(mat,1,is,ov);CHKERRQ(ierr);
/*compare communicators */
ierr = MPI_Comm_compare(gcomm,scomm,&issamecomm);CHKERRQ(ierr);
/* if the sub-communicator is the same as the global communicator,
* user does not want to use a sub-communicator
* */
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT) PetscFunctionReturn(0);
/* if the sub-communicator is petsc_comm_self,
* user also does not care the sub-communicator
* */
ierr = MPI_Comm_compare(scomm,PETSC_COMM_SELF,&issamecomm);CHKERRQ(ierr);
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT){PetscFunctionReturn(0);}
/*local rank, size in a sub-communicator */
ierr = MPI_Comm_rank(scomm,&srank);CHKERRQ(ierr);
ierr = MPI_Comm_size(scomm,&ssize);CHKERRQ(ierr);
ierr = MPI_Comm_rank(gcomm,&grank);CHKERRQ(ierr);
/*create a new IS based on sub-communicator
* since the old IS is often based on petsc_comm_self
* */
ierr = ISGetLocalSize(*is,&nindx);CHKERRQ(ierr);
ierr = PetscCalloc1(nindx,&indices_sc);CHKERRQ(ierr);
ierr = ISGetIndices(*is,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_sc,indices,sizeof(PetscInt)*nindx);CHKERRQ(ierr);
ierr = ISRestoreIndices(*is,&indices);CHKERRQ(ierr);
/*we do not need any more*/
ierr = ISDestroy(is);CHKERRQ(ierr);
/*create a index set based on the sub communicator */
ierr = ISCreateGeneral(scomm,nindx,indices_sc,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*gather all indices within the sub communicator*/
ierr = ISAllGather(is_sc,&allis_sc);CHKERRQ(ierr);
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
/* gather local sizes */
ierr = PetscMalloc1(ssize,&localsizes_sc);CHKERRQ(ierr);
/*get individual local sizes for all index sets*/
ierr = MPI_Gather(&nindx,1,MPIU_INT,localsizes_sc,1,MPIU_INT,0,scomm);CHKERRQ(ierr);
/*only root does these computations */
if(!srank){
/*get local size for the big index set*/
ierr = ISGetLocalSize(allis_sc,&localsize);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov,localsize,&sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov_rd,localsize,&sources_sc_rd);CHKERRQ(ierr);
ierr = ISGetIndices(allis_sc,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_ov,indices,sizeof(PetscInt)*localsize);CHKERRQ(ierr);
ierr = ISRestoreIndices(allis_sc,&indices);CHKERRQ(ierr);
/*we do not need it any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*assign corresponding sources */
localsize_tmp = 0;
for(k=0; k<ssize; k++){
for(i=0; i<localsizes_sc[k]; i++){
sources_sc[localsize_tmp++] = k;
}
}
/*record where indices come from */
ierr = PetscSortIntWithArray(localsize,indices_ov,sources_sc);CHKERRQ(ierr);
/*count local sizes for reduced indices */
ierr = PetscMemzero(localsizes_sc,sizeof(PetscInt)*ssize);CHKERRQ(ierr);
/*initialize the first entity*/
if(localsize){
indices_ov_rd[0] = indices_ov[0];
sources_sc_rd[0] = sources_sc[0];
localsizes_sc[sources_sc[0]]++;
}
localsize_tmp = 1;
/*remove duplicate integers */
for(i=1; i<localsize; i++){
if(indices_ov[i] != indices_ov[i-1]){
indices_ov_rd[localsize_tmp] = indices_ov[i];
sources_sc_rd[localsize_tmp++] = sources_sc[i];
localsizes_sc[sources_sc[i]]++;
}
}
ierr = PetscFree2(indices_ov,sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(ssize+1,&localoffsets);CHKERRQ(ierr);
for(k=0; k<ssize; k++){
localoffsets[k+1] = localoffsets[k] + localsizes_sc[k];
}
/*construct a star forest to send data back */
nleaves = localoffsets[ssize];
ierr = PetscMemzero(localoffsets,(ssize+1)*sizeof(PetscInt));CHKERRQ(ierr);
nroots = localsizes_sc[srank];
ierr = PetscCalloc1(nleaves,&remote);CHKERRQ(ierr);
for(i=0; i<nleaves; i++){
remote[i].rank = sources_sc_rd[i];
remote[i].index = localoffsets[sources_sc_rd[i]]++;
}
ierr = PetscFree(localoffsets);CHKERRQ(ierr);
}else{
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*Allocate a 'zero' pointer */
ierr = PetscCalloc1(0,&remote);CHKERRQ(ierr);
nleaves = 0;
indices_ov_rd = 0;
sources_sc_rd = 0;
}
/*scatter sizes to everybody */
ierr = MPI_Scatter(localsizes_sc,1, MPIU_INT,&nroots,1, MPIU_INT,0,scomm);CHKERRQ(ierr);
/*free memory */
ierr = PetscFree(localsizes_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(nroots,&indices_recv);CHKERRQ(ierr);
/*ierr = MPI_Comm_dup(scomm,&dcomm);CHKERRQ(ierr);*/
/*set data back to every body */
ierr = PetscSFCreate(scomm,&sf);CHKERRQ(ierr);
ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFReduceBegin(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
/* free memory */
ierr = PetscFree2(indices_ov_rd,sources_sc_rd);CHKERRQ(ierr);
/*create a index set*/
ierr = ISCreateGeneral(scomm,nroots,indices_recv,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*construct a parallel submatrix */
ierr = MatGetSubMatricesMPI(mat,1,&is_sc,&is_sc,MAT_INITIAL_MATRIX,&smat);CHKERRQ(ierr);
/* we do not need them any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*create a partitioner to repartition the sub-matrix*/
ierr = MatPartitioningCreate(scomm,&part);CHKERRQ(ierr);
ierr = MatPartitioningSetAdjacency(part,smat[0]);CHKERRQ(ierr);
#if PETSC_HAVE_PARMETIS
/* if there exists a ParMETIS installation, we try to use ParMETIS
* because a repartition routine possibly work better
* */
ierr = MatPartitioningSetType(part,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
/*try to use reparition function, instead of partition function */
ierr = MatPartitioningParmetisSetRepartition(part);CHKERRQ(ierr);
#else
/*we at least provide a default partitioner to rebalance the computation */
ierr = MatPartitioningSetType(part,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
#endif
/*user can pick up any partitioner by using an option*/
ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr);
/* apply partition */
ierr = MatPartitioningApply(part,&partitioning);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr);
ierr = MatDestroy(&(smat[0]));CHKERRQ(ierr);
ierr = PetscFree(smat);CHKERRQ(ierr);
/* get local rows including overlap */
ierr = ISBuildTwoSided(partitioning,is_sc,is);CHKERRQ(ierr);
/* destroy */
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
ierr = ISDestroy(&partitioning);CHKERRQ(ierr);
ierr = PetscCommDestroy(&scomm);CHKERRQ(ierr);
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 IPMInitializeBounds(Tao tao)
{
TAO_IPM *ipmP = (TAO_IPM*)tao->data;
Vec xtmp;
PetscInt xstart,xend;
PetscInt ucstart,ucend; /* user ci */
PetscInt ucestart,uceend; /* user ce */
PetscInt sstart,send;
PetscInt bigsize;
PetscInt i,counter,nloc;
PetscInt *cind,*xind,*ucind,*uceind,*stepind;
VecType vtype;
const PetscInt *xli,*xui;
PetscInt xl_offset,xu_offset;
IS bigxl,bigxu,isuc,isc,isx,sis,is1;
PetscErrorCode ierr;
MPI_Comm comm;
PetscFunctionBegin;
cind=xind=ucind=uceind=stepind=0;
ipmP->mi=0;
ipmP->nxlb=0;
ipmP->nxub=0;
ipmP->nb=0;
ipmP->nslack=0;
ierr = VecDuplicate(tao->solution,&xtmp);CHKERRQ(ierr);
if (!tao->XL && !tao->XU && tao->ops->computebounds) {
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
}
if (tao->XL) {
ierr = VecSet(xtmp,PETSC_NINFINITY);CHKERRQ(ierr);
ierr = VecWhichGreaterThan(tao->XL,xtmp,&ipmP->isxl);CHKERRQ(ierr);
ierr = ISGetSize(ipmP->isxl,&ipmP->nxlb);CHKERRQ(ierr);
} else {
ipmP->nxlb=0;
}
if (tao->XU) {
ierr = VecSet(xtmp,PETSC_INFINITY);CHKERRQ(ierr);
ierr = VecWhichLessThan(tao->XU,xtmp,&ipmP->isxu);CHKERRQ(ierr);
ierr = ISGetSize(ipmP->isxu,&ipmP->nxub);CHKERRQ(ierr);
} else {
ipmP->nxub=0;
}
ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
if (tao->constraints_inequality) {
ierr = VecGetSize(tao->constraints_inequality,&ipmP->mi);CHKERRQ(ierr);
} else {
ipmP->mi = 0;
}
ipmP->nb = ipmP->nxlb + ipmP->nxub + ipmP->mi;
comm = ((PetscObject)(tao->solution))->comm;
bigsize = ipmP->n+2*ipmP->nb+ipmP->me;
ierr = PetscMalloc1(bigsize,&stepind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->n,&xind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->me,&uceind);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(tao->solution,&xstart,&xend);CHKERRQ(ierr);
if (ipmP->nb > 0) {
ierr = VecCreate(comm,&ipmP->s);CHKERRQ(ierr);
ierr = VecSetSizes(ipmP->s,PETSC_DECIDE,ipmP->nb);CHKERRQ(ierr);
ierr = VecSetFromOptions(ipmP->s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->ds);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rhs_s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->complementarity);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->ci);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->dlamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rhs_lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->save_lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->save_s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rpi);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->Zero_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->Zero_nb,0.0);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->One_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->One_nb,1.0);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->Inf_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->Inf_nb,PETSC_INFINITY);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->nb,&cind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->mi,&ucind);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(ipmP->s,&sstart,&send);CHKERRQ(ierr);
if (ipmP->mi > 0) {
ierr = VecGetOwnershipRange(tao->constraints_inequality,&ucstart,&ucend);CHKERRQ(ierr);
counter=0;
for (i=ucstart;i<ucend;i++) {
cind[counter++] = i;
}
ierr = ISCreateGeneral(comm,counter,cind,PETSC_COPY_VALUES,&isuc);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,counter,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->constraints_inequality,isuc,ipmP->ci,isc,&ipmP->ci_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isuc);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
}
/* need to know how may xbound indices are on each process */
/* TODO better way */
if (ipmP->nxlb) {
ierr = ISAllGather(ipmP->isxl,&bigxl);CHKERRQ(ierr);
ierr = ISGetIndices(bigxl,&xli);CHKERRQ(ierr);
/* find offsets for this processor */
xl_offset = ipmP->mi;
for (i=0;i<ipmP->nxlb;i++) {
if (xli[i] < xstart) {
xl_offset++;
} else break;
}
ierr = ISRestoreIndices(bigxl,&xli);CHKERRQ(ierr);
ierr = ISGetIndices(ipmP->isxl,&xli);CHKERRQ(ierr);
ierr = ISGetLocalSize(ipmP->isxl,&nloc);CHKERRQ(ierr);
for (i=0;i<nloc;i++) {
xind[i] = xli[i];
cind[i] = xl_offset+i;
}
ierr = ISCreateGeneral(comm,nloc,xind,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,nloc,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->XL,isx,ipmP->ci,isc,&ipmP->xl_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
ierr = ISDestroy(&bigxl);CHKERRQ(ierr);
}
if (ipmP->nxub) {
ierr = ISAllGather(ipmP->isxu,&bigxu);CHKERRQ(ierr);
ierr = ISGetIndices(bigxu,&xui);CHKERRQ(ierr);
/* find offsets for this processor */
xu_offset = ipmP->mi + ipmP->nxlb;
for (i=0;i<ipmP->nxub;i++) {
if (xui[i] < xstart) {
xu_offset++;
} else break;
}
ierr = ISRestoreIndices(bigxu,&xui);CHKERRQ(ierr);
ierr = ISGetIndices(ipmP->isxu,&xui);CHKERRQ(ierr);
ierr = ISGetLocalSize(ipmP->isxu,&nloc);CHKERRQ(ierr);
for (i=0;i<nloc;i++) {
xind[i] = xui[i];
cind[i] = xu_offset+i;
}
ierr = ISCreateGeneral(comm,nloc,xind,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,nloc,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->XU,isx,ipmP->ci,isc,&ipmP->xu_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
ierr = ISDestroy(&bigxu);CHKERRQ(ierr);
}
}
ierr = VecCreate(comm,&ipmP->bigrhs);CHKERRQ(ierr);
ierr = VecGetType(tao->solution,&vtype);CHKERRQ(ierr);
ierr = VecSetType(ipmP->bigrhs,vtype);CHKERRQ(ierr);
ierr = VecSetSizes(ipmP->bigrhs,PETSC_DECIDE,bigsize);CHKERRQ(ierr);
ierr = VecSetFromOptions(ipmP->bigrhs);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->bigrhs,&ipmP->bigstep);CHKERRQ(ierr);
/* create scatters for step->x and x->rhs */
for (i=xstart;i<xend;i++) {
stepind[i-xstart] = i;
xind[i-xstart] = i;
}
ierr = ISCreateGeneral(comm,xend-xstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,xend-xstart,xind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,tao->solution,is1,&ipmP->step1);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->solution,is1,ipmP->bigrhs,sis,&ipmP->rhs1);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
if (ipmP->nb > 0) {
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i+ipmP->n;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,send-sstart,cind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,ipmP->s,is1,&ipmP->step2);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i+ipmP->n+ipmP->me;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->s,is1,ipmP->bigrhs,sis,&ipmP->rhs3);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
if (ipmP->me > 0) {
ierr = VecGetOwnershipRange(tao->constraints_equality,&ucestart,&uceend);CHKERRQ(ierr);
for (i=ucestart;i<uceend;i++) {
stepind[i-ucestart] = i + ipmP->n+ipmP->nb;
uceind[i-ucestart] = i;
}
ierr = ISCreateGeneral(comm,uceend-ucestart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,uceend-ucestart,uceind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,tao->constraints_equality,is1,&ipmP->step3);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
for (i=ucestart;i<uceend;i++) {
stepind[i-ucestart] = i + ipmP->n;
}
ierr = ISCreateGeneral(comm,uceend-ucestart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->constraints_equality,is1,ipmP->bigrhs,sis,&ipmP->rhs2);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
if (ipmP->nb > 0) {
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i + ipmP->n + ipmP->nb + ipmP->me;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,cind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,ipmP->s,is1,&ipmP->step4);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->s,is1,ipmP->bigrhs,sis,&ipmP->rhs4);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
ierr = PetscFree(stepind);CHKERRQ(ierr);
ierr = PetscFree(cind);CHKERRQ(ierr);
ierr = PetscFree(ucind);CHKERRQ(ierr);
ierr = PetscFree(uceind);CHKERRQ(ierr);
ierr = PetscFree(xind);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
