PetscErrorCode AOView_MemoryScalable(AO ao,PetscViewer viewer) { PetscErrorCode ierr; PetscMPIInt rank,size; AO_MemoryScalable *aomems = (AO_MemoryScalable*)ao->data; PetscBool iascii; PetscMPIInt tag_app,tag_petsc; PetscLayout map = aomems->map; PetscInt *app,*app_loc,*petsc,*petsc_loc,len,i,j; MPI_Status status; PetscFunctionBegin; ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); if (!iascii) SETERRQ1(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Viewer type %s not supported for AO MemoryScalable",((PetscObject)viewer)->type_name); ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)ao),&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PetscObjectComm((PetscObject)ao),&size);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)ao,&tag_app);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)ao,&tag_petsc);CHKERRQ(ierr); if (!rank) { ierr = PetscViewerASCIIPrintf(viewer,"Number of elements in ordering %D\n",ao->N);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer, "PETSc->App App->PETSc\n");CHKERRQ(ierr); ierr = PetscMalloc2(map->N,&app,map->N,&petsc);CHKERRQ(ierr); len = map->n; /* print local AO */ ierr = PetscViewerASCIIPrintf(viewer,"Process [%D]\n",rank);CHKERRQ(ierr); for (i=0; i<len; i++) { ierr = PetscViewerASCIIPrintf(viewer,"%3D %3D %3D %3D\n",i,aomems->app_loc[i],i,aomems->petsc_loc[i]);CHKERRQ(ierr); } /* recv and print off-processor's AO */ for (i=1; i<size; i++) { len = map->range[i+1] - map->range[i]; app_loc = app + map->range[i]; petsc_loc = petsc+ map->range[i]; ierr = MPI_Recv(app_loc,(PetscMPIInt)len,MPIU_INT,i,tag_app,PetscObjectComm((PetscObject)ao),&status);CHKERRQ(ierr); ierr = MPI_Recv(petsc_loc,(PetscMPIInt)len,MPIU_INT,i,tag_petsc,PetscObjectComm((PetscObject)ao),&status);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer,"Process [%D]\n",i);CHKERRQ(ierr); for (j=0; j<len; j++) { ierr = PetscViewerASCIIPrintf(viewer,"%3D %3D %3D %3D\n",map->range[i]+j,app_loc[j],map->range[i]+j,petsc_loc[j]);CHKERRQ(ierr); } } ierr = PetscFree2(app,petsc);CHKERRQ(ierr); } else { /* send values */ ierr = MPI_Send((void*)aomems->app_loc,map->n,MPIU_INT,0,tag_app,PetscObjectComm((PetscObject)ao));CHKERRQ(ierr); ierr = MPI_Send((void*)aomems->petsc_loc,map->n,MPIU_INT,0,tag_petsc,PetscObjectComm((PetscObject)ao));CHKERRQ(ierr); } ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode VecView_MPI_Draw_DA1d(Vec xin,PetscViewer v) { DM da; PetscErrorCode ierr; PetscMPIInt rank,size,tag1,tag2; PetscInt i,n,N,step,istart,isize,j,nbounds; MPI_Status status; PetscReal coors[4],ymin,ymax,min,max,xmin = 0.0,xmax = 0.0,tmp = 0.0,xgtmp = 0.0; const PetscScalar *array,*xg; PetscDraw draw; PetscBool isnull,showpoints = PETSC_FALSE; MPI_Comm comm; PetscDrawAxis axis; Vec xcoor; DMBoundaryType bx; const PetscReal *bounds; PetscInt *displayfields; PetscInt k,ndisplayfields; PetscBool hold; PetscFunctionBegin; ierr = PetscViewerDrawGetDraw(v,0,&draw);CHKERRQ(ierr); ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0); ierr = PetscViewerDrawGetBounds(v,&nbounds,&bounds);CHKERRQ(ierr); ierr = VecGetDM(xin,&da);CHKERRQ(ierr); if (!da) SETERRQ(PetscObjectComm((PetscObject)xin),PETSC_ERR_ARG_WRONG,"Vector not generated from a DMDA"); ierr = PetscOptionsGetBool(NULL,"-draw_vec_mark_points",&showpoints,NULL);CHKERRQ(ierr); ierr = DMDAGetInfo(da,0,&N,0,0,0,0,0,&step,0,&bx,0,0,0);CHKERRQ(ierr); ierr = DMDAGetCorners(da,&istart,0,0,&isize,0,0);CHKERRQ(ierr); ierr = VecGetArrayRead(xin,&array);CHKERRQ(ierr); ierr = VecGetLocalSize(xin,&n);CHKERRQ(ierr); n = n/step; /* get coordinates of nodes */ ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr); if (!xcoor) { ierr = DMDASetUniformCoordinates(da,0.0,1.0,0.0,0.0,0.0,0.0);CHKERRQ(ierr); ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr); } ierr = VecGetArrayRead(xcoor,&xg);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)xin,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); /* Determine the min and max x coordinate in plot */ if (!rank) { xmin = PetscRealPart(xg[0]); } if (rank == size-1) { xmax = PetscRealPart(xg[n-1]); } ierr = MPI_Bcast(&xmin,1,MPIU_REAL,0,comm);CHKERRQ(ierr); ierr = MPI_Bcast(&xmax,1,MPIU_REAL,size-1,comm);CHKERRQ(ierr); ierr = DMDASelectFields(da,&ndisplayfields,&displayfields);CHKERRQ(ierr); for (k=0; k<ndisplayfields; k++) { j = displayfields[k]; ierr = PetscViewerDrawGetDraw(v,k,&draw);CHKERRQ(ierr); ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr); /* Determine the min and max y coordinate in plot */ min = 1.e20; max = -1.e20; for (i=0; i<n; i++) { if (PetscRealPart(array[j+i*step]) < min) min = PetscRealPart(array[j+i*step]); if (PetscRealPart(array[j+i*step]) > max) max = PetscRealPart(array[j+i*step]); } if (min + 1.e-10 > max) { min -= 1.e-5; max += 1.e-5; } if (j < nbounds) { min = PetscMin(min,bounds[2*j]); max = PetscMax(max,bounds[2*j+1]); } ierr = MPI_Reduce(&min,&ymin,1,MPIU_REAL,MPIU_MIN,0,comm);CHKERRQ(ierr); ierr = MPI_Reduce(&max,&ymax,1,MPIU_REAL,MPIU_MAX,0,comm);CHKERRQ(ierr); ierr = PetscViewerDrawGetHold(v,&hold);CHKERRQ(ierr); if (!hold) { ierr = PetscDrawSynchronizedClear(draw);CHKERRQ(ierr); } ierr = PetscViewerDrawGetDrawAxis(v,k,&axis);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)draw,(PetscObject)axis);CHKERRQ(ierr); if (!rank) { const char *title; ierr = PetscDrawAxisSetLimits(axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr); ierr = PetscDrawAxisDraw(axis);CHKERRQ(ierr); ierr = PetscDrawGetCoordinates(draw,coors,coors+1,coors+2,coors+3);CHKERRQ(ierr); ierr = DMDAGetFieldName(da,j,&title);CHKERRQ(ierr); if (title) {ierr = PetscDrawSetTitle(draw,title);CHKERRQ(ierr);} } ierr = MPI_Bcast(coors,4,MPIU_REAL,0,comm);CHKERRQ(ierr); if (rank) { ierr = PetscDrawSetCoordinates(draw,coors[0],coors[1],coors[2],coors[3]);CHKERRQ(ierr); } /* draw local part of vector */ ierr = PetscObjectGetNewTag((PetscObject)xin,&tag1);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)xin,&tag2);CHKERRQ(ierr); if (rank < size-1) { /*send value to right */ ierr = MPI_Send((void*)&array[j+(n-1)*step],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr); ierr = MPI_Send((void*)&xg[n-1],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr); } if (!rank && bx == DM_BOUNDARY_PERIODIC && size > 1) { /* first processor sends first value to last */ ierr = MPI_Send((void*)&array[j],1,MPIU_REAL,size-1,tag2,comm);CHKERRQ(ierr); } for (i=1; i<n; i++) { ierr = PetscDrawLine(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PetscRealPart(xg[i]),PetscRealPart(array[j+step*i]),PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr); } } if (rank) { /* receive value from left */ ierr = MPI_Recv(&tmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr); ierr = MPI_Recv(&xgtmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr); ierr = PetscDrawLine(draw,xgtmp,tmp,PetscRealPart(xg[0]),PetscRealPart(array[j]),PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,xgtmp,tmp,PETSC_DRAW_BLACK);CHKERRQ(ierr); } } if (rank == size-1 && bx == DM_BOUNDARY_PERIODIC && size > 1) { ierr = MPI_Recv(&tmp,1,MPIU_REAL,0,tag2,comm,&status);CHKERRQ(ierr); /* If the mesh is not uniform we do not know the mesh spacing between the last point on the right and the first ghost point */ ierr = PetscDrawLine(draw,PetscRealPart(xg[n-1]),PetscRealPart(array[j+step*(n-1)]),PetscRealPart(xg[n-1]+(xg[n-1]-xg[n-2])),tmp,PETSC_DRAW_RED);CHKERRQ(ierr); if (showpoints) { ierr = PetscDrawPoint(draw,PetscRealPart(xg[n-2]),PetscRealPart(array[j+step*(n-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr); } } ierr = PetscDrawSynchronizedFlush(draw);CHKERRQ(ierr); ierr = PetscDrawPause(draw);CHKERRQ(ierr); } ierr = PetscFree(displayfields);CHKERRQ(ierr); ierr = VecRestoreArrayRead(xcoor,&xg);CHKERRQ(ierr); ierr = VecRestoreArrayRead(xin,&array);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode AOCreateMemoryScalable_private(MPI_Comm comm,PetscInt napp,const PetscInt from_array[],const PetscInt to_array[],AO ao, PetscInt *aomap_loc) { PetscErrorCode ierr; AO_MemoryScalable *aomems = (AO_MemoryScalable*)ao->data; PetscLayout map = aomems->map; PetscInt n_local = map->n,i,j; PetscMPIInt rank,size,tag; PetscInt *owner,*start,*nprocs,nsends,nreceives; PetscInt nmax,count,*sindices,*rindices,idx,lastidx; PetscInt *owners = aomems->map->range; MPI_Request *send_waits,*recv_waits; MPI_Status recv_status; PetscMPIInt nindices,widx; PetscInt *rbuf; PetscInt n=napp,ip,ia; MPI_Status *send_status; PetscFunctionBegin; ierr = PetscMemzero(aomap_loc,n_local*sizeof(PetscInt)); CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank); CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size); CHKERRQ(ierr); /* first count number of contributors (of from_array[]) to each processor */ ierr = PetscMalloc(2*size*sizeof(PetscInt),&nprocs); CHKERRQ(ierr); ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt)); CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscInt),&owner); CHKERRQ(ierr); j = 0; lastidx = -1; for (i=0; i<n; i++) { /* if indices are NOT locally sorted, need to start search at the beginning */ if (lastidx > (idx = from_array[i])) j = 0; lastidx = idx; for (; j<size; j++) { if (idx >= owners[j] && idx < owners[j+1]) { nprocs[2*j] += 2; /* num of indices to be sent - in pairs (ip,ia) */ nprocs[2*j+1] = 1; /* send to proc[j] */ owner[i] = j; break; } } } nprocs[2*rank]=nprocs[2*rank+1]=0; /* do not receive from self! */ nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1]; /* inform other processors of number of messages and max length*/ ierr = PetscMaxSum(comm,nprocs,&nmax,&nreceives); CHKERRQ(ierr); /* allocate arrays */ ierr = PetscObjectGetNewTag((PetscObject)ao,&tag); CHKERRQ(ierr); ierr = PetscMalloc2(nreceives*nmax,PetscInt,&rindices,nreceives,MPI_Request,&recv_waits); CHKERRQ(ierr); ierr = PetscMalloc3(2*n,PetscInt,&sindices,nsends,MPI_Request,&send_waits,nsends,MPI_Status,&send_status); CHKERRQ(ierr); ierr = PetscMalloc(size*sizeof(PetscInt),&start); CHKERRQ(ierr); /* post receives: */ for (i=0; i<nreceives; i++) { ierr = MPI_Irecv(rindices+nmax*i,nmax,MPIU_INT,MPI_ANY_SOURCE,tag,comm,recv_waits+i); CHKERRQ(ierr); } /* do sends: 1) starts[i] gives the starting index in svalues for stuff going to the ith processor */ start[0] = 0; for (i=1; i<size; i++) start[i] = start[i-1] + nprocs[2*i-2]; for (i=0; i<n; i++) { j = owner[i]; if (j != rank) { ip = from_array[i]; ia = to_array[i]; sindices[start[j]++] = ip; sindices[start[j]++] = ia; } else { /* compute my own map */ ip = from_array[i] - owners[rank]; ia = to_array[i]; aomap_loc[ip] = ia; } } start[0] = 0; for (i=1; i<size; i++) start[i] = start[i-1] + nprocs[2*i-2]; for (i=0,count=0; i<size; i++) { if (nprocs[2*i+1]) { ierr = MPI_Isend(sindices+start[i],nprocs[2*i],MPIU_INT,i,tag,comm,send_waits+count); CHKERRQ(ierr); count++; } } if (nsends != count) SETERRQ2(comm,PETSC_ERR_SUP,"nsends %d != count %d",nsends,count); /* wait on sends */ if (nsends) { ierr = MPI_Waitall(nsends,send_waits,send_status); CHKERRQ(ierr); } /* recvs */ count=0; for (j= nreceives; j>0; j--) { ierr = MPI_Waitany(nreceives,recv_waits,&widx,&recv_status); CHKERRQ(ierr); ierr = MPI_Get_count(&recv_status,MPIU_INT,&nindices); CHKERRQ(ierr); rbuf = rindices+nmax*widx; /* global index */ /* compute local mapping */ for (i=0; i<nindices; i+=2) { /* pack aomap_loc */ ip = rbuf[i] - owners[rank]; /* local index */ ia = rbuf[i+1]; aomap_loc[ip] = ia; } count++; } ierr = PetscFree(start); CHKERRQ(ierr); ierr = PetscFree3(sindices,send_waits,send_status); CHKERRQ(ierr); ierr = PetscFree2(rindices,recv_waits); CHKERRQ(ierr); ierr = PetscFree(owner); CHKERRQ(ierr); ierr = PetscFree(nprocs); CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode AOMap_MemoryScalable_private(AO ao,PetscInt n,PetscInt *ia,PetscInt *maploc) { PetscErrorCode ierr; AO_MemoryScalable *aomems = (AO_MemoryScalable*)ao->data; MPI_Comm comm; PetscMPIInt rank,size,tag1,tag2; PetscInt *owner,*start,*nprocs,nsends,nreceives; PetscInt nmax,count,*sindices,*rindices,i,j,idx,lastidx,*sindices2,*rindices2; PetscInt *owners = aomems->map->range; MPI_Request *send_waits,*recv_waits,*send_waits2,*recv_waits2; MPI_Status recv_status; PetscMPIInt nindices,source,widx; PetscInt *rbuf,*sbuf; MPI_Status *send_status,*send_status2; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)ao,&comm); CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank); CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size); CHKERRQ(ierr); /* first count number of contributors to each processor */ ierr = PetscMalloc2(2*size,PetscInt,&nprocs,size,PetscInt,&start); CHKERRQ(ierr); ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt)); CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscInt),&owner); CHKERRQ(ierr); ierr = PetscMemzero(owner,n*sizeof(PetscInt)); CHKERRQ(ierr); j = 0; lastidx = -1; for (i=0; i<n; i++) { /* if indices are NOT locally sorted, need to start search at the beginning */ if (lastidx > (idx = ia[i])) j = 0; lastidx = idx; for (; j<size; j++) { if (idx >= owners[j] && idx < owners[j+1]) { nprocs[2*j]++; /* num of indices to be sent */ nprocs[2*j+1] = 1; /* send to proc[j] */ owner[i] = j; break; } } } nprocs[2*rank]=nprocs[2*rank+1]=0; /* do not receive from self! */ nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1]; /* inform other processors of number of messages and max length*/ ierr = PetscMaxSum(comm,nprocs,&nmax,&nreceives); CHKERRQ(ierr); /* allocate arrays */ ierr = PetscObjectGetNewTag((PetscObject)ao,&tag1); CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)ao,&tag2); CHKERRQ(ierr); ierr = PetscMalloc2(nreceives*nmax,PetscInt,&rindices,nreceives,MPI_Request,&recv_waits); CHKERRQ(ierr); ierr = PetscMalloc2(nsends*nmax,PetscInt,&rindices2,nsends,MPI_Request,&recv_waits2); CHKERRQ(ierr); ierr = PetscMalloc3(n,PetscInt,&sindices,nsends,MPI_Request,&send_waits,nsends,MPI_Status,&send_status); CHKERRQ(ierr); ierr = PetscMalloc3(n,PetscInt,&sindices2,nreceives,MPI_Request,&send_waits2,nreceives,MPI_Status,&send_status2); CHKERRQ(ierr); /* post 1st receives: receive others requests since we don't know how long each individual message is we allocate the largest needed buffer for each receive. Potentially this is a lot of wasted space. */ for (i=0,count=0; i<nreceives; i++) { ierr = MPI_Irecv(rindices+nmax*i,nmax,MPIU_INT,MPI_ANY_SOURCE,tag1,comm,recv_waits+count++); CHKERRQ(ierr); } /* do 1st sends: 1) starts[i] gives the starting index in svalues for stuff going to the ith processor */ start[0] = 0; for (i=1; i<size; i++) start[i] = start[i-1] + nprocs[2*i-2]; for (i=0; i<n; i++) { j = owner[i]; if (j != rank) { sindices[start[j]++] = ia[i]; } else { /* compute my own map */ if (ia[i] >= owners[rank] && ia[i] < owners[rank+1]) { ia[i] = maploc[ia[i]-owners[rank]]; } else { ia[i] = -1; /* ia[i] is not in the range of 0 and N-1, maps it to -1 */ } } } start[0] = 0; for (i=1; i<size; i++) start[i] = start[i-1] + nprocs[2*i-2]; for (i=0,count=0; i<size; i++) { if (nprocs[2*i+1]) { /* send my request to others */ ierr = MPI_Isend(sindices+start[i],nprocs[2*i],MPIU_INT,i,tag1,comm,send_waits+count); CHKERRQ(ierr); /* post receive for the answer of my request */ ierr = MPI_Irecv(sindices2+start[i],nprocs[2*i],MPIU_INT,i,tag2,comm,recv_waits2+count); CHKERRQ(ierr); count++; } } if (nsends != count) SETERRQ2(comm,PETSC_ERR_SUP,"nsends %d != count %d",nsends,count); /* wait on 1st sends */ if (nsends) { ierr = MPI_Waitall(nsends,send_waits,send_status); CHKERRQ(ierr); } /* 1st recvs: other's requests */ for (j=0; j< nreceives; j++) { ierr = MPI_Waitany(nreceives,recv_waits,&widx,&recv_status); CHKERRQ(ierr); /* idx: index of handle for operation that completed */ ierr = MPI_Get_count(&recv_status,MPIU_INT,&nindices); CHKERRQ(ierr); rbuf = rindices+nmax*widx; /* global index */ source = recv_status.MPI_SOURCE; /* compute mapping */ sbuf = rbuf; for (i=0; i<nindices; i++) sbuf[i] = maploc[rbuf[i]-owners[rank]]; /* send mapping back to the sender */ ierr = MPI_Isend(sbuf,nindices,MPIU_INT,source,tag2,comm,send_waits2+widx); CHKERRQ(ierr); } /* wait on 2nd sends */ if (nreceives) { ierr = MPI_Waitall(nreceives,send_waits2,send_status2); CHKERRQ(ierr); } /* 2nd recvs: for the answer of my request */ for (j=0; j< nsends; j++) { ierr = MPI_Waitany(nsends,recv_waits2,&widx,&recv_status); CHKERRQ(ierr); ierr = MPI_Get_count(&recv_status,MPIU_INT,&nindices); CHKERRQ(ierr); source = recv_status.MPI_SOURCE; /* pack output ia[] */ rbuf = sindices2+start[source]; count = 0; for (i=0; i<n; i++) { if (source == owner[i]) ia[i] = rbuf[count++]; } } /* free arrays */ ierr = PetscFree2(nprocs,start); CHKERRQ(ierr); ierr = PetscFree(owner); CHKERRQ(ierr); ierr = PetscFree2(rindices,recv_waits); CHKERRQ(ierr); ierr = PetscFree2(rindices2,recv_waits2); CHKERRQ(ierr); ierr = PetscFree3(sindices,send_waits,send_status); CHKERRQ(ierr); ierr = PetscFree3(sindices2,send_waits2,send_status2); CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode VecLoad_Binary(Vec vec, PetscViewer viewer) { PetscMPIInt size,rank,tag; int fd; PetscInt i,rows = 0,n,*range,N,bs; PetscErrorCode ierr; PetscBool flag; PetscScalar *avec,*avecwork; MPI_Comm comm; MPI_Request request; MPI_Status status; #if defined(PETSC_HAVE_MPIIO) PetscBool useMPIIO; #endif PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr); ierr = PetscViewerBinaryReadVecHeader_Private(viewer,&rows);CHKERRQ(ierr); /* Set Vec sizes,blocksize,and type if not already set. Block size first so that local sizes will be compatible. */ ierr = PetscOptionsGetInt(((PetscObject)vec)->prefix, "-vecload_block_size", &bs, &flag);CHKERRQ(ierr); if (flag) { ierr = VecSetBlockSize(vec, bs);CHKERRQ(ierr); } if (vec->map->n < 0 && vec->map->N < 0) { ierr = VecSetSizes(vec,PETSC_DECIDE,rows);CHKERRQ(ierr); } /* If sizes and type already set,check if the vector global size is correct */ ierr = VecGetSize(vec, &N);CHKERRQ(ierr); if (N != rows) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Vector in file different length (%d) then input vector (%d)", rows, N); #if defined(PETSC_HAVE_MPIIO) ierr = PetscViewerBinaryGetMPIIO(viewer,&useMPIIO);CHKERRQ(ierr); if (useMPIIO) { ierr = VecLoad_Binary_MPIIO(vec, viewer);CHKERRQ(ierr); PetscFunctionReturn(0); } #endif ierr = VecGetLocalSize(vec,&n);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)viewer,&tag);CHKERRQ(ierr); ierr = VecGetArray(vec,&avec);CHKERRQ(ierr); if (!rank) { ierr = PetscBinaryRead(fd,avec,n,PETSC_SCALAR);CHKERRQ(ierr); if (size > 1) { /* read in other chuncks and send to other processors */ /* determine maximum chunck owned by other */ range = vec->map->range; n = 1; for (i=1; i<size; i++) n = PetscMax(n,range[i+1] - range[i]); ierr = PetscMalloc(n*sizeof(PetscScalar),&avecwork);CHKERRQ(ierr); for (i=1; i<size; i++) { n = range[i+1] - range[i]; ierr = PetscBinaryRead(fd,avecwork,n,PETSC_SCALAR);CHKERRQ(ierr); ierr = MPI_Isend(avecwork,n,MPIU_SCALAR,i,tag,comm,&request);CHKERRQ(ierr); ierr = MPI_Wait(&request,&status);CHKERRQ(ierr); } ierr = PetscFree(avecwork);CHKERRQ(ierr); } } else { ierr = MPI_Recv(avec,n,MPIU_SCALAR,0,tag,comm,&status);CHKERRQ(ierr); } ierr = VecRestoreArray(vec,&avec);CHKERRQ(ierr); ierr = VecAssemblyBegin(vec);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec);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 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); }
/*@C ISLocalToGlobalMappingGetInfo - Gets the neighbor information for each processor and each index shared by more than one processor Collective on ISLocalToGlobalMapping Input Parameters: . mapping - the mapping from local to global indexing Output Parameter: + nproc - number of processors that are connected to this one . proc - neighboring processors . numproc - number of indices for each subdomain (processor) - indices - indices of nodes (in local numbering) shared with neighbors (sorted by global numbering) Level: advanced Concepts: mapping^local to global Fortran Usage: $ ISLocalToGlobalMpngGetInfoSize(ISLocalToGlobalMapping,PetscInt nproc,PetscInt numprocmax,ierr) followed by $ ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping,PetscInt nproc, PetscInt procs[nproc],PetscInt numprocs[nproc], PetscInt indices[nproc][numprocmax],ierr) There is no ISLocalToGlobalMappingRestoreInfo() in Fortran. You must make sure that procs[], numprocs[] and indices[][] are large enough arrays, either by allocating them dynamically or defining static ones large enough. .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(), ISLocalToGlobalMappingRestoreInfo() @*/ PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping mapping,PetscInt *nproc,PetscInt *procs[],PetscInt *numprocs[],PetscInt **indices[]) { PetscErrorCode ierr; PetscMPIInt size,rank,tag1,tag2,tag3,*len,*source,imdex; PetscInt i,n = mapping->n,Ng,ng,max = 0,*lindices = mapping->indices; PetscInt *nprocs,*owner,nsends,*sends,j,*starts,nmax,nrecvs,*recvs,proc; PetscInt cnt,scale,*ownedsenders,*nownedsenders,rstart,nowned; PetscInt node,nownedm,nt,*sends2,nsends2,*starts2,*lens2,*dest,nrecvs2,*starts3,*recvs2,k,*bprocs,*tmp; PetscInt first_procs,first_numprocs,*first_indices; MPI_Request *recv_waits,*send_waits; MPI_Status recv_status,*send_status,*recv_statuses; MPI_Comm comm = ((PetscObject)mapping)->comm; PetscTruth debug = PETSC_FALSE; PetscFunctionBegin; PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE,1); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); if (size == 1) { *nproc = 0; *procs = PETSC_NULL; ierr = PetscMalloc(sizeof(PetscInt),numprocs);CHKERRQ(ierr); (*numprocs)[0] = 0; ierr = PetscMalloc(sizeof(PetscInt*),indices);CHKERRQ(ierr); (*indices)[0] = PETSC_NULL; PetscFunctionReturn(0); } ierr = PetscOptionsGetTruth(PETSC_NULL,"-islocaltoglobalmappinggetinfo_debug",&debug,PETSC_NULL);CHKERRQ(ierr); /* Notes on ISLocalToGlobalMappingGetInfo globally owned node - the nodes that have been assigned to this processor in global numbering, just for this routine. nontrivial globally owned node - node assigned to this processor that is on a subdomain boundary (i.e. is has more than one local owner) locally owned node - node that exists on this processors subdomain nontrivial locally owned node - node that is not in the interior (i.e. has more than one local subdomain */ ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag1);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag2);CHKERRQ(ierr); ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag3);CHKERRQ(ierr); for (i=0; i<n; i++) { if (lindices[i] > max) max = lindices[i]; } ierr = MPI_Allreduce(&max,&Ng,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr); Ng++; ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); scale = Ng/size + 1; ng = scale; if (rank == size-1) ng = Ng - scale*(size-1); ng = PetscMax(1,ng); rstart = scale*rank; /* determine ownership ranges of global indices */ ierr = PetscMalloc(2*size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt));CHKERRQ(ierr); /* determine owners of each local node */ ierr = PetscMalloc(n*sizeof(PetscInt),&owner);CHKERRQ(ierr); for (i=0; i<n; i++) { proc = lindices[i]/scale; /* processor that globally owns this index */ nprocs[2*proc+1] = 1; /* processor globally owns at least one of ours */ owner[i] = proc; nprocs[2*proc]++; /* count of how many that processor globally owns of ours */ } nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1]; ierr = PetscInfo1(mapping,"Number of global owners for my local data %d\n",nsends);CHKERRQ(ierr); /* inform other processors of number of messages and max length*/ ierr = PetscMaxSum(comm,nprocs,&nmax,&nrecvs);CHKERRQ(ierr); ierr = PetscInfo1(mapping,"Number of local owners for my global data %d\n",nrecvs);CHKERRQ(ierr); /* post receives for owned rows */ ierr = PetscMalloc((2*nrecvs+1)*(nmax+1)*sizeof(PetscInt),&recvs);CHKERRQ(ierr); ierr = PetscMalloc((nrecvs+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); for (i=0; i<nrecvs; i++) { ierr = MPI_Irecv(recvs+2*nmax*i,2*nmax,MPIU_INT,MPI_ANY_SOURCE,tag1,comm,recv_waits+i);CHKERRQ(ierr); } /* pack messages containing lists of local nodes to owners */ ierr = PetscMalloc((2*n+1)*sizeof(PetscInt),&sends);CHKERRQ(ierr); ierr = PetscMalloc((size+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr); starts[0] = 0; for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];} for (i=0; i<n; i++) { sends[starts[owner[i]]++] = lindices[i]; sends[starts[owner[i]]++] = i; } ierr = PetscFree(owner);CHKERRQ(ierr); starts[0] = 0; for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];} /* send the messages */ ierr = PetscMalloc((nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr); ierr = PetscMalloc((nsends+1)*sizeof(PetscInt),&dest);CHKERRQ(ierr); cnt = 0; for (i=0; i<size; i++) { if (nprocs[2*i]) { ierr = MPI_Isend(sends+starts[i],2*nprocs[2*i],MPIU_INT,i,tag1,comm,send_waits+cnt);CHKERRQ(ierr); dest[cnt] = i; cnt++; } } ierr = PetscFree(starts);CHKERRQ(ierr); /* wait on receives */ ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&source);CHKERRQ(ierr); ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&len);CHKERRQ(ierr); cnt = nrecvs; ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&nownedsenders);CHKERRQ(ierr); ierr = PetscMemzero(nownedsenders,ng*sizeof(PetscInt));CHKERRQ(ierr); while (cnt) { 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,&len[imdex]);CHKERRQ(ierr); source[imdex] = recv_status.MPI_SOURCE; len[imdex] = len[imdex]/2; /* count how many local owners for each of my global owned indices */ for (i=0; i<len[imdex]; i++) nownedsenders[recvs[2*imdex*nmax+2*i]-rstart]++; cnt--; } ierr = PetscFree(recv_waits);CHKERRQ(ierr); /* count how many globally owned indices are on an edge multiplied by how many processors own them. */ nowned = 0; nownedm = 0; for (i=0; i<ng; i++) { if (nownedsenders[i] > 1) {nownedm += nownedsenders[i]; nowned++;} } /* create single array to contain rank of all local owners of each globally owned index */ ierr = PetscMalloc((nownedm+1)*sizeof(PetscInt),&ownedsenders);CHKERRQ(ierr); ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr); starts[0] = 0; for (i=1; i<ng; i++) { if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; else starts[i] = starts[i-1]; } /* for each nontrival globally owned node list all arriving processors */ for (i=0; i<nrecvs; i++) { for (j=0; j<len[i]; j++) { node = recvs[2*i*nmax+2*j]-rstart; if (nownedsenders[node] > 1) { ownedsenders[starts[node]++] = source[i]; } } } if (debug) { /* ----------------------------------- */ starts[0] = 0; for (i=1; i<ng; i++) { if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; else starts[i] = starts[i-1]; } for (i=0; i<ng; i++) { if (nownedsenders[i] > 1) { ierr = PetscSynchronizedPrintf(comm,"[%d] global node %d local owner processors: ",rank,i+rstart);CHKERRQ(ierr); for (j=0; j<nownedsenders[i]; j++) { ierr = PetscSynchronizedPrintf(comm,"%d ",ownedsenders[starts[i]+j]);CHKERRQ(ierr); } ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); } } ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); }/* ----------------------------------- */ /* wait on original sends */ if (nsends) { 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 = PetscFree(send_waits);CHKERRQ(ierr); ierr = PetscFree(sends);CHKERRQ(ierr); ierr = PetscFree(nprocs);CHKERRQ(ierr); /* pack messages to send back to local owners */ starts[0] = 0; for (i=1; i<ng; i++) { if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1]; else starts[i] = starts[i-1]; } nsends2 = nrecvs; ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); /* length of each message */ for (i=0; i<nrecvs; i++) { nprocs[i] = 1; for (j=0; j<len[i]; j++) { node = recvs[2*i*nmax+2*j]-rstart; if (nownedsenders[node] > 1) { nprocs[i] += 2 + nownedsenders[node]; } } } nt = 0; for (i=0; i<nsends2; i++) nt += nprocs[i]; ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&sends2);CHKERRQ(ierr); ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&starts2);CHKERRQ(ierr); starts2[0] = 0; for (i=1; i<nsends2; i++) starts2[i] = starts2[i-1] + nprocs[i-1]; /* Each message is 1 + nprocs[i] long, and consists of (0) the number of nodes being sent back (1) the local node number, (2) the number of processors sharing it, (3) the processors sharing it */ for (i=0; i<nsends2; i++) { cnt = 1; sends2[starts2[i]] = 0; for (j=0; j<len[i]; j++) { node = recvs[2*i*nmax+2*j]-rstart; if (nownedsenders[node] > 1) { sends2[starts2[i]]++; sends2[starts2[i]+cnt++] = recvs[2*i*nmax+2*j+1]; sends2[starts2[i]+cnt++] = nownedsenders[node]; ierr = PetscMemcpy(&sends2[starts2[i]+cnt],&ownedsenders[starts[node]],nownedsenders[node]*sizeof(PetscInt));CHKERRQ(ierr); cnt += nownedsenders[node]; } } } /* receive the message lengths */ nrecvs2 = nsends; ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&lens2);CHKERRQ(ierr); ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&starts3);CHKERRQ(ierr); ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); for (i=0; i<nrecvs2; i++) { ierr = MPI_Irecv(&lens2[i],1,MPIU_INT,dest[i],tag2,comm,recv_waits+i);CHKERRQ(ierr); } /* send the message lengths */ for (i=0; i<nsends2; i++) { ierr = MPI_Send(&nprocs[i],1,MPIU_INT,source[i],tag2,comm);CHKERRQ(ierr); } /* wait on receives of lens */ if (nrecvs2) { ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr); ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr); ierr = PetscFree(recv_statuses);CHKERRQ(ierr); } ierr = PetscFree(recv_waits); starts3[0] = 0; nt = 0; for (i=0; i<nrecvs2-1; i++) { starts3[i+1] = starts3[i] + lens2[i]; nt += lens2[i]; } nt += lens2[nrecvs2-1]; ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&recvs2);CHKERRQ(ierr); ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); for (i=0; i<nrecvs2; i++) { ierr = MPI_Irecv(recvs2+starts3[i],lens2[i],MPIU_INT,dest[i],tag3,comm,recv_waits+i);CHKERRQ(ierr); } /* send the messages */ ierr = PetscMalloc((nsends2+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr); for (i=0; i<nsends2; i++) { ierr = MPI_Isend(sends2+starts2[i],nprocs[i],MPIU_INT,source[i],tag3,comm,send_waits+i);CHKERRQ(ierr); } /* wait on receives */ if (nrecvs2) { ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr); ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr); ierr = PetscFree(recv_statuses);CHKERRQ(ierr); } ierr = PetscFree(recv_waits);CHKERRQ(ierr); ierr = PetscFree(nprocs);CHKERRQ(ierr); if (debug) { /* ----------------------------------- */ cnt = 0; for (i=0; i<nrecvs2; i++) { nt = recvs2[cnt++]; for (j=0; j<nt; j++) { ierr = PetscSynchronizedPrintf(comm,"[%d] local node %d number of subdomains %d: ",rank,recvs2[cnt],recvs2[cnt+1]);CHKERRQ(ierr); for (k=0; k<recvs2[cnt+1]; k++) { ierr = PetscSynchronizedPrintf(comm,"%d ",recvs2[cnt+2+k]);CHKERRQ(ierr); } cnt += 2 + recvs2[cnt+1]; ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); } } ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); } /* ----------------------------------- */ /* count number subdomains for each local node */ ierr = PetscMalloc(size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); ierr = PetscMemzero(nprocs,size*sizeof(PetscInt));CHKERRQ(ierr); cnt = 0; for (i=0; i<nrecvs2; i++) { nt = recvs2[cnt++]; for (j=0; j<nt; j++) { for (k=0; k<recvs2[cnt+1]; k++) { nprocs[recvs2[cnt+2+k]]++; } cnt += 2 + recvs2[cnt+1]; } } nt = 0; for (i=0; i<size; i++) nt += (nprocs[i] > 0); *nproc = nt; ierr = PetscMalloc((nt+1)*sizeof(PetscInt),procs);CHKERRQ(ierr); ierr = PetscMalloc((nt+1)*sizeof(PetscInt),numprocs);CHKERRQ(ierr); ierr = PetscMalloc((nt+1)*sizeof(PetscInt*),indices);CHKERRQ(ierr); ierr = PetscMalloc(size*sizeof(PetscInt),&bprocs);CHKERRQ(ierr); cnt = 0; for (i=0; i<size; i++) { if (nprocs[i] > 0) { bprocs[i] = cnt; (*procs)[cnt] = i; (*numprocs)[cnt] = nprocs[i]; ierr = PetscMalloc(nprocs[i]*sizeof(PetscInt),&(*indices)[cnt]);CHKERRQ(ierr); cnt++; } } /* make the list of subdomains for each nontrivial local node */ ierr = PetscMemzero(*numprocs,nt*sizeof(PetscInt));CHKERRQ(ierr); cnt = 0; for (i=0; i<nrecvs2; i++) { nt = recvs2[cnt++]; for (j=0; j<nt; j++) { for (k=0; k<recvs2[cnt+1]; k++) { (*indices)[bprocs[recvs2[cnt+2+k]]][(*numprocs)[bprocs[recvs2[cnt+2+k]]]++] = recvs2[cnt]; } cnt += 2 + recvs2[cnt+1]; } } ierr = PetscFree(bprocs);CHKERRQ(ierr); ierr = PetscFree(recvs2);CHKERRQ(ierr); /* sort the node indexing by their global numbers */ nt = *nproc; for (i=0; i<nt; i++) { ierr = PetscMalloc(((*numprocs)[i])*sizeof(PetscInt),&tmp);CHKERRQ(ierr); for (j=0; j<(*numprocs)[i]; j++) { tmp[j] = lindices[(*indices)[i][j]]; } ierr = PetscSortIntWithArray((*numprocs)[i],tmp,(*indices)[i]);CHKERRQ(ierr); ierr = PetscFree(tmp);CHKERRQ(ierr); } if (debug) { /* ----------------------------------- */ nt = *nproc; for (i=0; i<nt; i++) { ierr = PetscSynchronizedPrintf(comm,"[%d] subdomain %d number of indices %d: ",rank,(*procs)[i],(*numprocs)[i]);CHKERRQ(ierr); for (j=0; j<(*numprocs)[i]; j++) { ierr = PetscSynchronizedPrintf(comm,"%d ",(*indices)[i][j]);CHKERRQ(ierr); } ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr); } ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr); } /* ----------------------------------- */ /* wait on sends */ if (nsends2) { ierr = PetscMalloc(nsends2*sizeof(MPI_Status),&send_status);CHKERRQ(ierr); ierr = MPI_Waitall(nsends2,send_waits,send_status);CHKERRQ(ierr); ierr = PetscFree(send_status);CHKERRQ(ierr); } ierr = PetscFree(starts3);CHKERRQ(ierr); ierr = PetscFree(dest);CHKERRQ(ierr); ierr = PetscFree(send_waits);CHKERRQ(ierr); ierr = PetscFree(nownedsenders);CHKERRQ(ierr); ierr = PetscFree(ownedsenders);CHKERRQ(ierr); ierr = PetscFree(starts);CHKERRQ(ierr); ierr = PetscFree(starts2);CHKERRQ(ierr); ierr = PetscFree(lens2);CHKERRQ(ierr); ierr = PetscFree(source);CHKERRQ(ierr); ierr = PetscFree(len);CHKERRQ(ierr); ierr = PetscFree(recvs);CHKERRQ(ierr); ierr = PetscFree(nprocs);CHKERRQ(ierr); ierr = PetscFree(sends2);CHKERRQ(ierr); /* put the information about myself as the first entry in the list */ first_procs = (*procs)[0]; first_numprocs = (*numprocs)[0]; first_indices = (*indices)[0]; for (i=0; i<*nproc; i++) { if ((*procs)[i] == rank) { (*procs)[0] = (*procs)[i]; (*numprocs)[0] = (*numprocs)[i]; (*indices)[0] = (*indices)[i]; (*procs)[i] = first_procs; (*numprocs)[i] = first_numprocs; (*indices)[i] = first_indices; break; } } PetscFunctionReturn(0); }
PetscErrorCode MatGetSubMatrices_MPIDense_Local(Mat C,PetscInt ismax,const IS isrow[],const IS iscol[],MatReuse scall,Mat *submats) { Mat_MPIDense *c = (Mat_MPIDense*)C->data; Mat A = c->A; Mat_SeqDense *a = (Mat_SeqDense*)A->data,*mat; PetscErrorCode ierr; PetscMPIInt rank,size,tag0,tag1,idex,end,i; PetscInt N = C->cmap->N,rstart = C->rmap->rstart,count; const PetscInt **irow,**icol,*irow_i; PetscInt *nrow,*ncol,*w1,*w3,*w4,*rtable,start; PetscInt **sbuf1,m,j,k,l,ct1,**rbuf1,row,proc; PetscInt nrqs,msz,**ptr,*ctr,*pa,*tmp,bsz,nrqr; PetscInt is_no,jmax,**rmap,*rmap_i; PetscInt ctr_j,*sbuf1_j,*rbuf1_i; MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2; MPI_Status *r_status1,*r_status2,*s_status1,*s_status2; MPI_Comm comm; PetscScalar **rbuf2,**sbuf2; PetscBool sorted; PetscFunctionBegin; comm = ((PetscObject)C)->comm; tag0 = ((PetscObject)C)->tag; size = c->size; rank = c->rank; m = C->rmap->N; /* Get some new tags to keep the communication clean */ ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr); /* Check if the col indices are sorted */ for (i=0; i<ismax; i++) { ierr = ISSorted(isrow[i],&sorted);CHKERRQ(ierr); if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"ISrow is not sorted"); ierr = ISSorted(iscol[i],&sorted);CHKERRQ(ierr); if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"IScol is not sorted"); } ierr = PetscMalloc5(ismax,const PetscInt*,&irow,ismax,const PetscInt*,&icol,ismax,PetscInt,&nrow,ismax,PetscInt,&ncol,m,PetscInt,&rtable);CHKERRQ(ierr); for (i=0; i<ismax; i++) { ierr = ISGetIndices(isrow[i],&irow[i]);CHKERRQ(ierr); ierr = ISGetIndices(iscol[i],&icol[i]);CHKERRQ(ierr); ierr = ISGetLocalSize(isrow[i],&nrow[i]);CHKERRQ(ierr); ierr = ISGetLocalSize(iscol[i],&ncol[i]);CHKERRQ(ierr); } /* Create hash table for the mapping :row -> proc*/ for (i=0,j=0; i<size; i++) { jmax = C->rmap->range[i+1]; for (; j<jmax; j++) { rtable[j] = i; } } /* evaluate communication - mesg to who,length of mesg, and buffer space required. Based on this, buffers are allocated, and data copied into them*/ ierr = PetscMalloc3(2*size,PetscInt,&w1,size,PetscInt,&w3,size,PetscInt,&w4);CHKERRQ(ierr); ierr = PetscMemzero(w1,size*2*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/ ierr = PetscMemzero(w3,size*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/ for (i=0; i<ismax; i++) { ierr = PetscMemzero(w4,size*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/ jmax = nrow[i]; irow_i = irow[i]; for (j=0; j<jmax; j++) { row = irow_i[j]; proc = rtable[row]; w4[proc]++; } for (j=0; j<size; j++) { if (w4[j]) { w1[2*j] += w4[j]; w3[j]++;} } } nrqs = 0; /* no of outgoing messages */ msz = 0; /* total mesg length (for all procs) */ w1[2*rank] = 0; /* no mesg sent to self */ w3[rank] = 0; for (i=0; i<size; i++) { if (w1[2*i]) { w1[2*i+1] = 1; nrqs++;} /* there exists a message to proc i */ } ierr = PetscMalloc((nrqs+1)*sizeof(PetscInt),&pa);CHKERRQ(ierr); /*(proc -array)*/ for (i=0,j=0; i<size; i++) { if (w1[2*i]) { pa[j] = i; j++; } } /* Each message would have a header = 1 + 2*(no of IS) + data */ for (i=0; i<nrqs; i++) { j = pa[i]; w1[2*j] += w1[2*j+1] + 2* w3[j]; msz += w1[2*j]; } /* Do a global reduction to determine how many messages to expect*/ ierr = PetscMaxSum(comm,w1,&bsz,&nrqr);CHKERRQ(ierr); /* Allocate memory for recv buffers . Make sure rbuf1[0] exists by adding 1 to the buffer length */ ierr = PetscMalloc((nrqr+1)*sizeof(PetscInt*),&rbuf1);CHKERRQ(ierr); ierr = PetscMalloc(nrqr*bsz*sizeof(PetscInt),&rbuf1[0]);CHKERRQ(ierr); for (i=1; i<nrqr; ++i) rbuf1[i] = rbuf1[i-1] + bsz; /* Post the receives */ ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Request),&r_waits1);CHKERRQ(ierr); for (i=0; i<nrqr; ++i) { ierr = MPI_Irecv(rbuf1[i],bsz,MPIU_INT,MPI_ANY_SOURCE,tag0,comm,r_waits1+i);CHKERRQ(ierr); } /* Allocate Memory for outgoing messages */ ierr = PetscMalloc4(size,PetscInt*,&sbuf1,size,PetscInt*,&ptr,2*msz,PetscInt,&tmp,size,PetscInt,&ctr);CHKERRQ(ierr); ierr = PetscMemzero(sbuf1,size*sizeof(PetscInt*));CHKERRQ(ierr); ierr = PetscMemzero(ptr,size*sizeof(PetscInt*));CHKERRQ(ierr); { PetscInt *iptr = tmp,ict = 0; for (i=0; i<nrqs; i++) { j = pa[i]; iptr += ict; sbuf1[j] = iptr; ict = w1[2*j]; } } /* Form the outgoing messages */ /* Initialize the header space */ for (i=0; i<nrqs; i++) { j = pa[i]; sbuf1[j][0] = 0; ierr = PetscMemzero(sbuf1[j]+1,2*w3[j]*sizeof(PetscInt));CHKERRQ(ierr); ptr[j] = sbuf1[j] + 2*w3[j] + 1; } /* Parse the isrow and copy data into outbuf */ for (i=0; i<ismax; i++) { ierr = PetscMemzero(ctr,size*sizeof(PetscInt));CHKERRQ(ierr); irow_i = irow[i]; jmax = nrow[i]; for (j=0; j<jmax; j++) { /* parse the indices of each IS */ row = irow_i[j]; proc = rtable[row]; 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; j<size; j++) { /* Can Optimise this loop too */ if ((ctr_j = ctr[j])) { sbuf1_j = sbuf1[j]; k = ++sbuf1_j[0]; sbuf1_j[2*k] = ctr_j; sbuf1_j[2*k-1] = i; } } } /* Now post the sends */ ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Request),&s_waits1);CHKERRQ(ierr); for (i=0; i<nrqs; ++i) { j = pa[i]; ierr = MPI_Isend(sbuf1[j],w1[2*j],MPIU_INT,j,tag0,comm,s_waits1+i);CHKERRQ(ierr); } /* Post recieves to capture the row_data from other procs */ ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits2);CHKERRQ(ierr); ierr = PetscMalloc((nrqs+1)*sizeof(PetscScalar*),&rbuf2);CHKERRQ(ierr); for (i=0; i<nrqs; i++) { j = pa[i]; count = (w1[2*j] - (2*sbuf1[j][0] + 1))*N; ierr = PetscMalloc((count+1)*sizeof(PetscScalar),&rbuf2[i]);CHKERRQ(ierr); ierr = MPI_Irecv(rbuf2[i],count,MPIU_SCALAR,j,tag1,comm,r_waits2+i);CHKERRQ(ierr); } /* Receive messages(row_nos) and then, pack and send off the rowvalues to the correct processors */ ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits2);CHKERRQ(ierr); ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Status),&r_status1);CHKERRQ(ierr); ierr = PetscMalloc((nrqr+1)*sizeof(PetscScalar*),&sbuf2);CHKERRQ(ierr); { PetscScalar *sbuf2_i,*v_start; PetscInt s_proc; for (i=0; i<nrqr; ++i) { ierr = MPI_Waitany(nrqr,r_waits1,&idex,r_status1+i);CHKERRQ(ierr); s_proc = r_status1[i].MPI_SOURCE; /* send processor */ rbuf1_i = rbuf1[idex]; /* Actual message from s_proc */ /* no of rows = end - start; since start is array idex[], 0idex, whel end is length of the buffer - which is 1idex */ start = 2*rbuf1_i[0] + 1; ierr = MPI_Get_count(r_status1+i,MPIU_INT,&end);CHKERRQ(ierr); /* allocate memory sufficinet to hold all the row values */ ierr = PetscMalloc((end-start)*N*sizeof(PetscScalar),&sbuf2[idex]);CHKERRQ(ierr); sbuf2_i = sbuf2[idex]; /* Now pack the data */ for (j=start; j<end; j++) { row = rbuf1_i[j] - rstart; v_start = a->v + row; for (k=0; k<N; k++) { sbuf2_i[0] = v_start[0]; sbuf2_i++; v_start += C->rmap->n; } } /* Now send off the data */ ierr = MPI_Isend(sbuf2[idex],(end-start)*N,MPIU_SCALAR,s_proc,tag1,comm,s_waits2+i);CHKERRQ(ierr); } } /* End Send-Recv of IS + row_numbers */ ierr = PetscFree(r_status1);CHKERRQ(ierr); ierr = PetscFree(r_waits1);CHKERRQ(ierr); ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Status),&s_status1);CHKERRQ(ierr); if (nrqs) {ierr = MPI_Waitall(nrqs,s_waits1,s_status1);CHKERRQ(ierr);} ierr = PetscFree(s_status1);CHKERRQ(ierr); ierr = PetscFree(s_waits1);CHKERRQ(ierr); /* Create the submatrices */ if (scall == MAT_REUSE_MATRIX) { for (i=0; i<ismax; i++) { mat = (Mat_SeqDense *)(submats[i]->data); if ((submats[i]->rmap->n != nrow[i]) || (submats[i]->cmap->n != ncol[i])) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size"); ierr = PetscMemzero(mat->v,submats[i]->rmap->n*submats[i]->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr); submats[i]->factortype = C->factortype; } } else { for (i=0; i<ismax; i++) { ierr = MatCreate(PETSC_COMM_SELF,submats+i);CHKERRQ(ierr); ierr = MatSetSizes(submats[i],nrow[i],ncol[i],nrow[i],ncol[i]);CHKERRQ(ierr); ierr = MatSetType(submats[i],((PetscObject)A)->type_name);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(submats[i],PETSC_NULL);CHKERRQ(ierr); } } /* Assemble the matrices */ { PetscInt col; PetscScalar *imat_v,*mat_v,*imat_vi,*mat_vi; for (i=0; i<ismax; i++) { mat = (Mat_SeqDense*)submats[i]->data; mat_v = a->v; imat_v = mat->v; irow_i = irow[i]; m = nrow[i]; for (j=0; j<m; j++) { row = irow_i[j] ; proc = rtable[row]; if (proc == rank) { row = row - rstart; mat_vi = mat_v + row; imat_vi = imat_v + j; for (k=0; k<ncol[i]; k++) { col = icol[i][k]; imat_vi[k*m] = mat_vi[col*C->rmap->n]; } } } } } /* Create row map-> This maps c->row to submat->row for each submat*/ /* this is a very expensive operation wrt memory usage */ ierr = PetscMalloc(ismax*sizeof(PetscInt*),&rmap);CHKERRQ(ierr); ierr = PetscMalloc(ismax*C->rmap->N*sizeof(PetscInt),&rmap[0]);CHKERRQ(ierr); ierr = PetscMemzero(rmap[0],ismax*C->rmap->N*sizeof(PetscInt));CHKERRQ(ierr); for (i=1; i<ismax; i++) { rmap[i] = rmap[i-1] + C->rmap->N;} for (i=0; i<ismax; i++) { rmap_i = rmap[i]; irow_i = irow[i]; jmax = nrow[i]; for (j=0; j<jmax; j++) { rmap_i[irow_i[j]] = j; } } /* Now Receive the row_values and assemble the rest of the matrix */ ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status2);CHKERRQ(ierr); { PetscInt is_max,tmp1,col,*sbuf1_i,is_sz; PetscScalar *rbuf2_i,*imat_v,*imat_vi; for (tmp1=0; tmp1<nrqs; tmp1++) { /* For each message */ ierr = MPI_Waitany(nrqs,r_waits2,&i,r_status2+tmp1);CHKERRQ(ierr); /* Now dig out the corresponding sbuf1, which contains the IS data_structure */ sbuf1_i = sbuf1[pa[i]]; is_max = sbuf1_i[0]; ct1 = 2*is_max+1; rbuf2_i = rbuf2[i]; for (j=1; j<=is_max; j++) { /* For each IS belonging to the message */ is_no = sbuf1_i[2*j-1]; is_sz = sbuf1_i[2*j]; mat = (Mat_SeqDense*)submats[is_no]->data; imat_v = mat->v; rmap_i = rmap[is_no]; m = nrow[is_no]; for (k=0; k<is_sz; k++,rbuf2_i+=N) { /* For each row */ row = sbuf1_i[ct1]; ct1++; row = rmap_i[row]; imat_vi = imat_v + row; for (l=0; l<ncol[is_no]; l++) { /* For each col */ col = icol[is_no][l]; imat_vi[l*m] = rbuf2_i[col]; } } } } } /* End Send-Recv of row_values */ ierr = PetscFree(r_status2);CHKERRQ(ierr); ierr = PetscFree(r_waits2);CHKERRQ(ierr); ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status2);CHKERRQ(ierr); if (nrqr) {ierr = MPI_Waitall(nrqr,s_waits2,s_status2);CHKERRQ(ierr);} ierr = PetscFree(s_status2);CHKERRQ(ierr); ierr = PetscFree(s_waits2);CHKERRQ(ierr); /* Restore the indices */ for (i=0; i<ismax; i++) { ierr = ISRestoreIndices(isrow[i],irow+i);CHKERRQ(ierr); ierr = ISRestoreIndices(iscol[i],icol+i);CHKERRQ(ierr); } /* Destroy allocated memory */ ierr = PetscFree5(irow,icol,nrow,ncol,rtable);CHKERRQ(ierr); ierr = PetscFree3(w1,w3,w4);CHKERRQ(ierr); ierr = PetscFree(pa);CHKERRQ(ierr); for (i=0; i<nrqs; ++i) { ierr = PetscFree(rbuf2[i]);CHKERRQ(ierr); } ierr = PetscFree(rbuf2);CHKERRQ(ierr); ierr = PetscFree4(sbuf1,ptr,tmp,ctr);CHKERRQ(ierr); ierr = PetscFree(rbuf1[0]);CHKERRQ(ierr); ierr = PetscFree(rbuf1);CHKERRQ(ierr); for (i=0; i<nrqr; ++i) { ierr = PetscFree(sbuf2[i]);CHKERRQ(ierr); } ierr = PetscFree(sbuf2);CHKERRQ(ierr); ierr = PetscFree(rmap[0]);CHKERRQ(ierr); ierr = PetscFree(rmap);CHKERRQ(ierr); for (i=0; i<ismax; i++) { ierr = MatAssemblyBegin(submats[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(submats[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PETSC_EXTERN PetscErrorCode KSPCreate_AGMRES(KSP ksp) { KSP_AGMRES *agmres; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscNewLog(ksp,&agmres);CHKERRQ(ierr); ksp->data = (void*)agmres; ierr = KSPSetSupportedNorm(ksp,KSP_NORM_PRECONDITIONED,PC_LEFT,3);CHKERRQ(ierr); ierr = KSPSetSupportedNorm(ksp,KSP_NORM_UNPRECONDITIONED,PC_RIGHT,2);CHKERRQ(ierr); ksp->ops->buildsolution = KSPBuildSolution_AGMRES; ksp->ops->setup = KSPSetUp_AGMRES; ksp->ops->solve = KSPSolve_AGMRES; ksp->ops->destroy = KSPDestroy_AGMRES; ksp->ops->view = KSPView_AGMRES; ksp->ops->setfromoptions = KSPSetFromOptions_AGMRES; ksp->guess_zero = PETSC_TRUE; ksp->ops->computeextremesingularvalues = KSPComputeExtremeSingularValues_GMRES; ksp->ops->computeeigenvalues = KSPComputeEigenvalues_GMRES; ierr = PetscObjectComposeFunction((PetscObject) ksp,"KSPGMRESSetPreAllocateVectors_C",KSPGMRESSetPreAllocateVectors_GMRES);CHKERRQ(ierr); ierr = PetscObjectComposeFunction((PetscObject) ksp,"KSPGMRESSetOrthogonalization_C",KSPGMRESSetOrthogonalization_GMRES);CHKERRQ(ierr); ierr = PetscObjectComposeFunction((PetscObject) ksp,"KSPGMRESSetRestart_C",KSPGMRESSetRestart_GMRES);CHKERRQ(ierr); ierr = PetscObjectComposeFunction((PetscObject) ksp,"KSPGMRESSetHapTol_C",KSPGMRESSetHapTol_GMRES);CHKERRQ(ierr); ierr = PetscObjectComposeFunction((PetscObject) ksp,"KSPGMRESSetCGSRefinementType_C",KSPGMRESSetCGSRefinementType_GMRES);CHKERRQ(ierr); /* -- New functions defined in DGMRES -- */ ierr=PetscObjectComposeFunction((PetscObject) ksp, "KSPDGMRESSetEigen_C",KSPDGMRESSetEigen_DGMRES);CHKERRQ(ierr); ierr=PetscObjectComposeFunction((PetscObject) ksp, "KSPDGMRESComputeSchurForm_C",KSPDGMRESComputeSchurForm_DGMRES);CHKERRQ(ierr); ierr=PetscObjectComposeFunction((PetscObject) ksp, "KSPDGMRESComputeDeflationData_C",KSPDGMRESComputeDeflationData_DGMRES);CHKERRQ(ierr); ierr=PetscObjectComposeFunction((PetscObject) ksp, "KSPDGMRESApplyDeflation_C",KSPDGMRESApplyDeflation_DGMRES);CHKERRQ(ierr); ierr = PetscLogEventRegister("AGMRESComputeDefl", KSP_CLASSID, &KSP_AGMRESComputeDeflationData);CHKERRQ(ierr); ierr = PetscLogEventRegister("AGMRESBuildBasis", KSP_CLASSID, &KSP_AGMRESBuildBasis);CHKERRQ(ierr); ierr = PetscLogEventRegister("AGMRESCompShifts", KSP_CLASSID, &KSP_AGMRESComputeShifts);CHKERRQ(ierr); ierr = PetscLogEventRegister("AGMRESOrthog", KSP_CLASSID, &KSP_AGMRESRoddec);CHKERRQ(ierr); agmres->haptol = 1.0e-30; agmres->q_preallocate = 0; agmres->delta_allocate = AGMRES_DELTA_DIRECTIONS; agmres->orthog = KSPGMRESClassicalGramSchmidtOrthogonalization; agmres->nrs = 0; agmres->sol_temp = 0; agmres->max_k = AGMRES_DEFAULT_MAXK; agmres->Rsvd = 0; agmres->cgstype = KSP_GMRES_CGS_REFINE_NEVER; agmres->orthogwork = 0; /* Default values for the deflation */ agmres->r = 0; agmres->neig = 0; agmres->max_neig = 0; agmres->lambdaN = 0.0; agmres->smv = SMV; agmres->bgv = 1; agmres->force = PETSC_FALSE; agmres->matvecs = 0; agmres->improve = PETSC_FALSE; agmres->HasShifts = PETSC_FALSE; agmres->r = 0; agmres->HasSchur = PETSC_FALSE; agmres->DeflPrecond = PETSC_FALSE; ierr = PetscObjectGetNewTag((PetscObject)ksp,&agmres->tag);CHKERRQ(ierr); PetscFunctionReturn(0); }
EXTERN_C_END /* -------------------------------------------------------------------------- */ /* PCNNCreateCoarseMatrix - */ #undef __FUNCT__ #define __FUNCT__ "PCNNCreateCoarseMatrix" PetscErrorCode PCNNCreateCoarseMatrix (PC pc) { MPI_Request *send_request, *recv_request; PetscErrorCode ierr; PetscInt i, j, k; PetscScalar* mat; /* Sub-matrix with this subdomain's contribution to the coarse matrix */ PetscScalar** DZ_OUT; /* proc[k].DZ_OUT[i][] = bit of vector to be sent from processor k to processor i */ /* aliasing some names */ PC_IS* pcis = (PC_IS*)(pc->data); PC_NN* pcnn = (PC_NN*)pc->data; PetscInt n_neigh = pcis->n_neigh; PetscInt* neigh = pcis->neigh; PetscInt* n_shared = pcis->n_shared; PetscInt** shared = pcis->shared; PetscScalar** DZ_IN; /* Must be initialized after memory allocation. */ PetscFunctionBegin; /* Allocate memory for mat (the +1 is to handle the case n_neigh equal to zero) */ ierr = PetscMalloc((n_neigh*n_neigh+1)*sizeof(PetscScalar),&mat);CHKERRQ(ierr); /* Allocate memory for DZ */ /* Notice that DZ_OUT[0] is allocated some space that is never used. */ /* This is just in order to DZ_OUT and DZ_IN to have exactly the same form. */ { PetscInt size_of_Z = 0; ierr = PetscMalloc ((n_neigh+1)*sizeof(PetscScalar*),&pcnn->DZ_IN);CHKERRQ(ierr); DZ_IN = pcnn->DZ_IN; ierr = PetscMalloc ((n_neigh+1)*sizeof(PetscScalar*),&DZ_OUT);CHKERRQ(ierr); for (i=0; i<n_neigh; i++) { size_of_Z += n_shared[i]; } ierr = PetscMalloc ((size_of_Z+1)*sizeof(PetscScalar),&DZ_IN[0]);CHKERRQ(ierr); ierr = PetscMalloc ((size_of_Z+1)*sizeof(PetscScalar),&DZ_OUT[0]);CHKERRQ(ierr); } for (i=1; i<n_neigh; i++) { DZ_IN[i] = DZ_IN [i-1] + n_shared[i-1]; DZ_OUT[i] = DZ_OUT[i-1] + n_shared[i-1]; } /* Set the values of DZ_OUT, in order to send this info to the neighbours */ /* First, set the auxiliary array pcis->work_N. */ ierr = PCISScatterArrayNToVecB(pcis->work_N,pcis->D,INSERT_VALUES,SCATTER_REVERSE,pc);CHKERRQ(ierr); for (i=1; i<n_neigh; i++){ for (j=0; j<n_shared[i]; j++) { DZ_OUT[i][j] = pcis->work_N[shared[i][j]]; } } /* Non-blocking send/receive the common-interface chunks of scaled nullspaces */ /* Notice that send_request[] and recv_request[] could have one less element. */ /* We make them longer to have request[i] corresponding to neigh[i]. */ { PetscMPIInt tag; ierr = PetscObjectGetNewTag((PetscObject)pc,&tag);CHKERRQ(ierr); ierr = PetscMalloc((2*(n_neigh)+1)*sizeof(MPI_Request),&send_request);CHKERRQ(ierr); recv_request = send_request + (n_neigh); for (i=1; i<n_neigh; i++) { ierr = MPI_Isend((void*)(DZ_OUT[i]),n_shared[i],MPIU_SCALAR,neigh[i],tag,((PetscObject)pc)->comm,&(send_request[i]));CHKERRQ(ierr); ierr = MPI_Irecv((void*)(DZ_IN [i]),n_shared[i],MPIU_SCALAR,neigh[i],tag,((PetscObject)pc)->comm,&(recv_request[i]));CHKERRQ(ierr); } } /* Set DZ_IN[0][] (recall that neigh[0]==rank, always) */ for(j=0; j<n_shared[0]; j++) { DZ_IN[0][j] = pcis->work_N[shared[0][j]]; } /* Start computing with local D*Z while communication goes on. */ /* Apply Schur complement. The result is "stored" in vec (more */ /* precisely, vec points to the result, stored in pc_nn->vec1_B) */ /* and also scattered to pcnn->work_N. */ ierr = PCNNApplySchurToChunk(pc,n_shared[0],shared[0],DZ_IN[0],pcis->work_N,pcis->vec1_B, pcis->vec2_B,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); /* Compute the first column, while completing the receiving. */ for (i=0; i<n_neigh; i++) { MPI_Status stat; PetscMPIInt ind=0; if (i>0) { ierr = MPI_Waitany(n_neigh-1,recv_request+1,&ind,&stat);CHKERRQ(ierr); ind++;} mat[ind*n_neigh+0] = 0.0; for (k=0; k<n_shared[ind]; k++) { mat[ind*n_neigh+0] += DZ_IN[ind][k] * pcis->work_N[shared[ind][k]]; } } /* Compute the remaining of the columns */ for (j=1; j<n_neigh; j++) { ierr = PCNNApplySchurToChunk(pc,n_shared[j],shared[j],DZ_IN[j],pcis->work_N,pcis->vec1_B, pcis->vec2_B,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); for (i=0; i<n_neigh; i++) { mat[i*n_neigh+j] = 0.0; for (k=0; k<n_shared[i]; k++) { mat[i*n_neigh+j] += DZ_IN[i][k] * pcis->work_N[shared[i][k]]; } } } /* Complete the sending. */ if (n_neigh>1) { MPI_Status *stat; ierr = PetscMalloc((n_neigh-1)*sizeof(MPI_Status),&stat);CHKERRQ(ierr); if (n_neigh-1) {ierr = MPI_Waitall(n_neigh-1,&(send_request[1]),stat);CHKERRQ(ierr);} ierr = PetscFree(stat);CHKERRQ(ierr); } /* Free the memory for the MPI requests */ ierr = PetscFree(send_request);CHKERRQ(ierr); /* Free the memory for DZ_OUT */ if (DZ_OUT) { ierr = PetscFree(DZ_OUT[0]);CHKERRQ(ierr); ierr = PetscFree(DZ_OUT);CHKERRQ(ierr); } { PetscMPIInt size; ierr = MPI_Comm_size(((PetscObject)pc)->comm,&size);CHKERRQ(ierr); /* Create the global coarse vectors (rhs and solution). */ ierr = VecCreateMPI(((PetscObject)pc)->comm,1,size,&(pcnn->coarse_b));CHKERRQ(ierr); ierr = VecDuplicate(pcnn->coarse_b,&(pcnn->coarse_x));CHKERRQ(ierr); /* Create and set the global coarse AIJ matrix. */ ierr = MatCreate(((PetscObject)pc)->comm,&(pcnn->coarse_mat));CHKERRQ(ierr); ierr = MatSetSizes(pcnn->coarse_mat,1,1,size,size);CHKERRQ(ierr); ierr = MatSetType(pcnn->coarse_mat,MATAIJ);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(pcnn->coarse_mat,1,PETSC_NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(pcnn->coarse_mat,1,PETSC_NULL,1,PETSC_NULL);CHKERRQ(ierr); ierr = MatSetValues(pcnn->coarse_mat,n_neigh,neigh,n_neigh,neigh,mat,ADD_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(pcnn->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd (pcnn->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } { PetscMPIInt rank; PetscScalar one = 1.0; ierr = MPI_Comm_rank(((PetscObject)pc)->comm,&rank);CHKERRQ(ierr); /* "Zero out" rows of not-purely-Neumann subdomains */ if (pcis->pure_neumann) { /* does NOT zero the row; create an empty index set. The reason is that MatZeroRows() is collective. */ ierr = MatZeroRows(pcnn->coarse_mat,0,PETSC_NULL,one,0,0);CHKERRQ(ierr); } else { /* here it DOES zero the row, since it's not a floating subdomain. */ PetscInt row = (PetscInt) rank; ierr = MatZeroRows(pcnn->coarse_mat,1,&row,one,0,0);CHKERRQ(ierr); } } /* Create the coarse linear solver context */ { PC pc_ctx, inner_pc; KSP inner_ksp; ierr = KSPCreate(((PetscObject)pc)->comm,&pcnn->ksp_coarse);CHKERRQ(ierr); ierr = PetscObjectIncrementTabLevel((PetscObject)pcnn->ksp_coarse,(PetscObject)pc,2);CHKERRQ(ierr); ierr = KSPSetOperators(pcnn->ksp_coarse,pcnn->coarse_mat,pcnn->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); ierr = KSPGetPC(pcnn->ksp_coarse,&pc_ctx);CHKERRQ(ierr); ierr = PCSetType(pc_ctx,PCREDUNDANT);CHKERRQ(ierr); ierr = KSPSetType(pcnn->ksp_coarse,KSPPREONLY);CHKERRQ(ierr); ierr = PCRedundantGetKSP(pc_ctx,&inner_ksp);CHKERRQ(ierr); ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr); ierr = PCSetType(inner_pc,PCLU);CHKERRQ(ierr); ierr = KSPSetOptionsPrefix(pcnn->ksp_coarse,"nn_coarse_");CHKERRQ(ierr); ierr = KSPSetFromOptions(pcnn->ksp_coarse);CHKERRQ(ierr); /* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */ ierr = KSPSetUp(pcnn->ksp_coarse);CHKERRQ(ierr); } /* Free the memory for mat */ ierr = PetscFree(mat);CHKERRQ(ierr); /* for DEBUGGING, save the coarse matrix to a file. */ { PetscBool flg = PETSC_FALSE; ierr = PetscOptionsGetBool(PETSC_NULL,"-pc_nn_save_coarse_matrix",&flg,PETSC_NULL);CHKERRQ(ierr); if (flg) { PetscViewer viewer; ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"coarse.m",&viewer);CHKERRQ(ierr); ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); ierr = MatView(pcnn->coarse_mat,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } } /* Set the variable pcnn->factor_coarse_rhs. */ pcnn->factor_coarse_rhs = (pcis->pure_neumann) ? 1.0 : 0.0; /* See historical note 02, at the bottom of this file. */ PetscFunctionReturn(0); }