1 2 #include <../src/vec/is/sf/impls/basic/gatherv/sfgatherv.h> 3 4 PETSC_INTERN PetscErrorCode PetscSFBcastAndOpBegin_Gatherv(PetscSF sf,MPI_Datatype unit,const void *rootdata,void *leafdata,MPI_Op op) 5 { 6 PetscErrorCode ierr; 7 PetscSFPack_Gatherv link; 8 PetscMPIInt rank,sendcount; 9 MPI_Comm comm; 10 void *recvbuf; 11 PetscSF_Gatherv *dat = (PetscSF_Gatherv*)sf->data; 12 13 PetscFunctionBegin; 14 ierr = PetscSFPackGet_Gatherv(sf,unit,rootdata,leafdata,&link);CHKERRQ(ierr); 15 ierr = PetscObjectGetComm((PetscObject)sf,&comm);CHKERRQ(ierr); 16 ierr = PetscMPIIntCast(sf->nroots,&sendcount);CHKERRQ(ierr); 17 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 18 19 if (op == MPIU_REPLACE) { 20 recvbuf = leafdata; 21 } else { 22 if (!link->leaf && !rank) {ierr = PetscMalloc(sf->nleaves*link->unitbytes,&link->leaf);CHKERRQ(ierr);} /* Alloate leafbuf on rank 0 */ 23 recvbuf = link->leaf; 24 } 25 26 ierr = MPIU_Igatherv(rootdata,sendcount,unit,recvbuf,dat->recvcounts,dat->displs,unit,0/*rank 0*/,comm,&link->request);CHKERRQ(ierr); 27 PetscFunctionReturn(0); 28 } 29 30 static PetscErrorCode PetscSFReduceBegin_Gatherv(PetscSF sf,MPI_Datatype unit,const void *leafdata,void *rootdata,MPI_Op op) 31 { 32 PetscErrorCode ierr; 33 PetscSFPack_Gatherv link; 34 PetscMPIInt recvcount; 35 MPI_Comm comm; 36 void *recvbuf; 37 PetscSF_Gatherv *dat = (PetscSF_Gatherv*)sf->data; 38 39 PetscFunctionBegin; 40 ierr = PetscSFPackGet_Gatherv(sf,unit,rootdata,leafdata,&link);CHKERRQ(ierr); 41 ierr = PetscObjectGetComm((PetscObject)sf,&comm);CHKERRQ(ierr); 42 43 if (op == MPIU_REPLACE) { 44 recvbuf = rootdata; 45 } else { 46 if (!link->root) {ierr = PetscMalloc(sf->nroots*link->unitbytes,&link->root);CHKERRQ(ierr);} 47 recvbuf = link->root; 48 } 49 50 ierr = PetscMPIIntCast(sf->nroots,&recvcount);CHKERRQ(ierr); 51 ierr = MPIU_Iscatterv(leafdata,dat->recvcounts,dat->displs,unit,recvbuf,recvcount,unit,0,comm,&link->request);CHKERRQ(ierr); 52 PetscFunctionReturn(0); 53 } 54 55 PETSC_INTERN PetscErrorCode PetscSFFetchAndOpBegin_Gatherv(PetscSF sf,MPI_Datatype unit,void *rootdata,const void *leafdata,void *leafupdate,MPI_Op op) 56 { 57 PetscErrorCode ierr; 58 59 PetscFunctionBegin; 60 /* In Gatherv, each root only has one leaf. So we just need to bcast rootdata to leafupdate and then reduce leafdata to rootdata */ 61 ierr = PetscSFBcastAndOpBegin(sf,unit,rootdata,leafupdate,MPIU_REPLACE);CHKERRQ(ierr); 62 ierr = PetscSFBcastAndOpEnd(sf,unit,rootdata,leafupdate,MPIU_REPLACE);CHKERRQ(ierr); 63 ierr = PetscSFReduceBegin(sf,unit,leafdata,rootdata,op);CHKERRQ(ierr); 64 PetscFunctionReturn(0); 65 } 66 67 PETSC_INTERN PetscErrorCode PetscSFCreate_Gatherv(PetscSF sf) 68 { 69 PetscErrorCode ierr; 70 PetscSF_Gatherv *dat = (PetscSF_Gatherv*)sf->data; 71 72 PetscFunctionBegin; 73 /* Inherit from Allgatherv */ 74 sf->ops->SetUp = PetscSFSetUp_Allgatherv; 75 sf->ops->Reset = PetscSFReset_Allgatherv; 76 sf->ops->Destroy = PetscSFDestroy_Allgatherv; 77 sf->ops->GetGraph = PetscSFGetGraph_Allgatherv; 78 sf->ops->GetLeafRanks = PetscSFGetLeafRanks_Allgatherv; 79 sf->ops->GetRootRanks = PetscSFGetRootRanks_Allgatherv; 80 sf->ops->BcastAndOpEnd = PetscSFBcastAndOpEnd_Allgatherv; 81 sf->ops->ReduceEnd = PetscSFReduceEnd_Allgatherv; 82 sf->ops->FetchAndOpEnd = PetscSFFetchAndOpEnd_Allgatherv; 83 sf->ops->CreateLocalSF = PetscSFCreateLocalSF_Allgatherv; 84 85 /* Gatherv stuff */ 86 sf->ops->BcastAndOpBegin = PetscSFBcastAndOpBegin_Gatherv; 87 sf->ops->ReduceBegin = PetscSFReduceBegin_Gatherv; 88 sf->ops->FetchAndOpBegin = PetscSFFetchAndOpBegin_Gatherv; 89 90 ierr = PetscNewLog(sf,&dat);CHKERRQ(ierr); 91 sf->data = (void*)dat; 92 PetscFunctionReturn(0); 93 } 94