1 #include <petscsys.h> /*I "petscsys.h" I*/ 2 #include <petsc/private/petscimpl.h> 3 4 struct _n_PetscShmComm { 5 PetscMPIInt *globranks; /* global ranks of each rank in the shared memory communicator */ 6 PetscMPIInt shmsize; /* size of the shared memory communicator */ 7 MPI_Comm globcomm,shmcomm; /* global communicator and shared memory communicator (a sub-communicator of the former) */ 8 }; 9 10 /* 11 Private routine to delete internal tag/name shared memory communicator when a communicator is freed. 12 13 This is called by MPI, not by users. This is called by MPI_Comm_free() when the communicator that has this data as an attribute is freed. 14 15 Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval() 16 17 */ 18 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Shm(MPI_Comm comm,PetscMPIInt keyval,void *val,void *extra_state) 19 { 20 PetscErrorCode ierr; 21 PetscShmComm p = (PetscShmComm)val; 22 23 PetscFunctionBegin; 24 ierr = PetscInfo1(0,"Deleting shared memory subcommunicator in a MPI_Comm %ld\n",(long)comm);CHKERRMPI(ierr); 25 ierr = MPI_Comm_free(&p->shmcomm);CHKERRMPI(ierr); 26 ierr = PetscFree(p->globranks);CHKERRMPI(ierr); 27 ierr = PetscFree(val);CHKERRMPI(ierr); 28 PetscFunctionReturn(MPI_SUCCESS); 29 } 30 31 /*@C 32 PetscShmCommGet - Given a PETSc communicator returns a communicator of all ranks that share a common memory 33 34 35 Collective on comm. 36 37 Input Parameter: 38 . globcomm - MPI_Comm 39 40 Output Parameter: 41 . pshmcomm - the PETSc shared memory communicator object 42 43 Level: developer 44 45 Notes: 46 This should be called only with an PetscCommDuplicate() communictor 47 48 When used with MPICH, MPICH must be configured with --download-mpich-device=ch3:nemesis 49 50 Concepts: MPI subcomm^numbering 51 52 @*/ 53 PetscErrorCode PetscShmCommGet(MPI_Comm globcomm,PetscShmComm *pshmcomm) 54 { 55 #ifdef PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY 56 PetscErrorCode ierr; 57 MPI_Group globgroup,shmgroup; 58 PetscMPIInt *shmranks,i,flg; 59 PetscCommCounter *counter; 60 61 PetscFunctionBegin; 62 ierr = MPI_Comm_get_attr(globcomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 63 if (!flg) SETERRQ(globcomm,PETSC_ERR_ARG_CORRUPT,"Bad MPI communicator supplied; must be a PETSc communicator"); 64 65 ierr = MPI_Comm_get_attr(globcomm,Petsc_ShmComm_keyval,pshmcomm,&flg);CHKERRQ(ierr); 66 if (flg) PetscFunctionReturn(0); 67 68 ierr = PetscNew(pshmcomm);CHKERRQ(ierr); 69 (*pshmcomm)->globcomm = globcomm; 70 71 ierr = MPI_Comm_split_type(globcomm, MPI_COMM_TYPE_SHARED,0, MPI_INFO_NULL,&(*pshmcomm)->shmcomm);CHKERRQ(ierr); 72 73 ierr = MPI_Comm_size((*pshmcomm)->shmcomm,&(*pshmcomm)->shmsize);CHKERRQ(ierr); 74 ierr = MPI_Comm_group(globcomm, &globgroup);CHKERRQ(ierr); 75 ierr = MPI_Comm_group((*pshmcomm)->shmcomm, &shmgroup);CHKERRQ(ierr); 76 ierr = PetscMalloc1((*pshmcomm)->shmsize,&shmranks);CHKERRQ(ierr); 77 ierr = PetscMalloc1((*pshmcomm)->shmsize,&(*pshmcomm)->globranks);CHKERRQ(ierr); 78 for (i=0; i<(*pshmcomm)->shmsize; i++) shmranks[i] = i; 79 ierr = MPI_Group_translate_ranks(shmgroup, (*pshmcomm)->shmsize, shmranks, globgroup, (*pshmcomm)->globranks);CHKERRQ(ierr); 80 ierr = PetscFree(shmranks);CHKERRQ(ierr); 81 ierr = MPI_Group_free(&globgroup);CHKERRQ(ierr); 82 ierr = MPI_Group_free(&shmgroup);CHKERRQ(ierr); 83 84 for (i=0; i<(*pshmcomm)->shmsize; i++) { 85 ierr = PetscInfo2(NULL,"Shared memory rank %d global rank %d\n",i,(*pshmcomm)->globranks[i]);CHKERRQ(ierr); 86 } 87 ierr = MPI_Comm_set_attr(globcomm,Petsc_ShmComm_keyval,*pshmcomm);CHKERRQ(ierr); 88 PetscFunctionReturn(0); 89 #else 90 SETERRQ(globcomm, PETSC_ERR_SUP, "Shared memory communicators need MPI-3 package support.\nPlease upgrade your MPI or reconfigure with --download-mpich."); 91 #endif 92 } 93 94 /*@C 95 PetscShmCommGlobalToLocal - Given a global rank returns the local rank in the shared memory communicator 96 97 Input Parameters: 98 + pshmcomm - the shared memory communicator object 99 - grank - the global rank 100 101 Output Parameter: 102 . lrank - the local rank, or MPI_PROC_NULL if it does not exist 103 104 Level: developer 105 106 Developer Notes: 107 Assumes the pshmcomm->globranks[] is sorted 108 109 It may be better to rewrite this to map multiple global ranks to local in the same function call 110 111 Concepts: MPI subcomm^numbering 112 113 @*/ 114 PetscErrorCode PetscShmCommGlobalToLocal(PetscShmComm pshmcomm,PetscMPIInt grank,PetscMPIInt *lrank) 115 { 116 PetscMPIInt low,high,t,i; 117 PetscBool flg = PETSC_FALSE; 118 PetscErrorCode ierr; 119 120 PetscFunctionBegin; 121 *lrank = MPI_PROC_NULL; 122 if (grank < pshmcomm->globranks[0]) PetscFunctionReturn(0); 123 if (grank > pshmcomm->globranks[pshmcomm->shmsize-1]) PetscFunctionReturn(0); 124 ierr = PetscOptionsGetBool(NULL,NULL,"-noshared",&flg,NULL);CHKERRQ(ierr); 125 if (flg) PetscFunctionReturn(0); 126 low = 0; 127 high = pshmcomm->shmsize; 128 while (high-low > 5) { 129 t = (low+high)/2; 130 if (pshmcomm->globranks[t] > grank) high = t; 131 else low = t; 132 } 133 for (i=low; i<high; i++) { 134 if (pshmcomm->globranks[i] > grank) PetscFunctionReturn(0); 135 if (pshmcomm->globranks[i] == grank) { 136 *lrank = i; 137 PetscFunctionReturn(0); 138 } 139 } 140 PetscFunctionReturn(0); 141 } 142 143 /*@C 144 PetscShmCommLocalToGlobal - Given a local rank in the shared memory communicator returns the global rank 145 146 Input Parameters: 147 + pshmcomm - the shared memory communicator object 148 - lrank - the local rank in the shared memory communicator 149 150 Output Parameter: 151 . grank - the global rank in the global communicator where the shared memory communicator is built 152 153 Level: developer 154 155 Concepts: MPI subcomm^numbering 156 @*/ 157 PetscErrorCode PetscShmCommLocalToGlobal(PetscShmComm pshmcomm,PetscMPIInt lrank,PetscMPIInt *grank) 158 { 159 PetscFunctionBegin; 160 #ifdef PETSC_USE_DEBUG 161 { 162 PetscErrorCode ierr; 163 if (lrank < 0 || lrank >= pshmcomm->shmsize) { SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"No rank %D in the shared memory communicator",lrank);CHKERRQ(ierr); } 164 } 165 #endif 166 *grank = pshmcomm->globranks[lrank]; 167 PetscFunctionReturn(0); 168 } 169 170 /*@C 171 PetscShmCommGetMpiShmComm - Returns the MPI communicator that represents all processes with common shared memory 172 173 Input Parameter: 174 . pshmcomm - PetscShmComm object obtained with PetscShmCommGet() 175 176 Output Parameter: 177 . comm - the MPI communicator 178 179 Level: developer 180 181 @*/ 182 PetscErrorCode PetscShmCommGetMpiShmComm(PetscShmComm pshmcomm,MPI_Comm *comm) 183 { 184 PetscFunctionBegin; 185 *comm = pshmcomm->shmcomm; 186 PetscFunctionReturn(0); 187 } 188 189