1 2 /* 3 Provides utility routines for split MPI communicator. 4 */ 5 #include <petscsys.h> /*I "petscsys.h" I*/ 6 #include <petscviewer.h> 7 8 const char *const PetscSubcommTypes[] = {"GENERAL","CONTIGUOUS","INTERLACED","PetscSubcommType","PETSC_SUBCOMM_",0}; 9 10 static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm); 11 static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm); 12 13 /*@C 14 PetscSubcommSetFromOptions - Allows setting options from a PetscSubcomm 15 16 Collective on PetscSubcomm 17 18 Input Parameter: 19 . psubcomm - PetscSubcomm context 20 21 Level: beginner 22 23 @*/ 24 PetscErrorCode PetscSubcommSetFromOptions(PetscSubcomm psubcomm) 25 { 26 PetscErrorCode ierr; 27 PetscSubcommType type; 28 PetscBool flg; 29 30 PetscFunctionBegin; 31 if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Must call PetscSubcommCreate firt"); 32 33 ierr = PetscOptionsBegin(psubcomm->parent,psubcomm->subcommprefix,"Options for PetscSubcomm",NULL);CHKERRQ(ierr); 34 ierr = PetscOptionsEnum("-psubcomm_type",NULL,NULL,PetscSubcommTypes,(PetscEnum)psubcomm->type,(PetscEnum*)&type,&flg);CHKERRQ(ierr); 35 if (flg && psubcomm->type != type) { 36 /* free old structures */ 37 ierr = PetscCommDestroy(&(psubcomm)->dupparent);CHKERRQ(ierr); 38 ierr = PetscCommDestroy(&(psubcomm)->child);CHKERRQ(ierr); 39 ierr = PetscFree((psubcomm)->subsize);CHKERRQ(ierr); 40 switch (type) { 41 case PETSC_SUBCOMM_GENERAL: 42 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Runtime option PETSC_SUBCOMM_GENERAL is not supported, use PetscSubcommSetTypeGeneral()"); 43 case PETSC_SUBCOMM_CONTIGUOUS: 44 ierr = PetscSubcommCreate_contiguous(psubcomm);CHKERRQ(ierr); 45 break; 46 case PETSC_SUBCOMM_INTERLACED: 47 ierr = PetscSubcommCreate_interlaced(psubcomm);CHKERRQ(ierr); 48 break; 49 default: 50 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"PetscSubcommType %s is not supported yet",PetscSubcommTypes[type]); 51 } 52 } 53 54 ierr = PetscOptionsName("-psubcomm_view","Triggers display of PetscSubcomm context","PetscSubcommView",&flg);CHKERRQ(ierr); 55 if (flg) { 56 ierr = PetscSubcommView(psubcomm,PETSC_VIEWER_STDOUT_(psubcomm->parent));CHKERRQ(ierr); 57 } 58 ierr = PetscOptionsEnd();CHKERRQ(ierr); 59 PetscFunctionReturn(0); 60 } 61 62 /*@C 63 PetscSubcommSetOptionsPrefix - Sets the prefix used for searching for all 64 PetscSubcomm items in the options database. 65 66 Logically collective on PetscSubcomm. 67 68 Level: Intermediate 69 70 Input Parameters: 71 + psubcomm - PetscSubcomm context 72 - prefix - the prefix to prepend all PetscSubcomm item names with. 73 74 @*/ 75 PetscErrorCode PetscSubcommSetOptionsPrefix(PetscSubcomm psubcomm,const char pre[]) 76 { 77 PetscErrorCode ierr; 78 79 PetscFunctionBegin; 80 if (!pre) { 81 ierr = PetscFree(psubcomm->subcommprefix);CHKERRQ(ierr); 82 } else { 83 if (pre[0] == '-') SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Options prefix should not begin with a hypen"); 84 ierr = PetscFree(psubcomm->subcommprefix);CHKERRQ(ierr); 85 ierr = PetscStrallocpy(pre,&(psubcomm->subcommprefix));CHKERRQ(ierr); 86 } 87 PetscFunctionReturn(0); 88 } 89 90 /*@C 91 PetscSubcommView - Views a PetscSubcomm of values as either ASCII text or a binary file 92 93 Collective on PetscSubcomm 94 95 Input Parameter: 96 + psubcomm - PetscSubcomm context 97 - viewer - location to view the values 98 99 Level: beginner 100 @*/ 101 PetscErrorCode PetscSubcommView(PetscSubcomm psubcomm,PetscViewer viewer) 102 { 103 PetscErrorCode ierr; 104 PetscBool iascii; 105 PetscViewerFormat format; 106 107 PetscFunctionBegin; 108 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 109 if (iascii) { 110 ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); 111 if (format == PETSC_VIEWER_DEFAULT) { 112 MPI_Comm comm=psubcomm->parent; 113 PetscMPIInt rank,size,subsize,subrank,duprank; 114 115 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 116 ierr = PetscViewerASCIIPrintf(viewer,"PetscSubcomm type %s with total %d MPI processes:\n",PetscSubcommTypes[psubcomm->type],size);CHKERRQ(ierr); 117 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 118 ierr = MPI_Comm_size(psubcomm->child,&subsize);CHKERRQ(ierr); 119 ierr = MPI_Comm_rank(psubcomm->child,&subrank);CHKERRQ(ierr); 120 ierr = MPI_Comm_rank(psubcomm->dupparent,&duprank);CHKERRQ(ierr); 121 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr); 122 ierr = PetscViewerASCIISynchronizedPrintf(viewer," [%d], color %d, sub-size %d, sub-rank %d, duprank %d\n",rank,psubcomm->color,subsize,subrank,duprank);CHKERRQ(ierr); 123 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr); 124 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 125 } 126 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not supported yet"); 127 PetscFunctionReturn(0); 128 } 129 130 /*@C 131 PetscSubcommSetNumber - Set total number of subcommunicators. 132 133 Collective on MPI_Comm 134 135 Input Parameter: 136 + psubcomm - PetscSubcomm context 137 - nsubcomm - the total number of subcommunicators in psubcomm 138 139 Level: advanced 140 141 .keywords: communicator 142 143 .seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetType(),PetscSubcommSetTypeGeneral() 144 @*/ 145 PetscErrorCode PetscSubcommSetNumber(PetscSubcomm psubcomm,PetscInt nsubcomm) 146 { 147 PetscErrorCode ierr; 148 MPI_Comm comm=psubcomm->parent; 149 PetscMPIInt msub,size; 150 151 PetscFunctionBegin; 152 if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate() first"); 153 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 154 ierr = PetscMPIIntCast(nsubcomm,&msub);CHKERRQ(ierr); 155 if (msub < 1 || msub > size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Num of subcommunicators %d cannot be < 1 or > input comm size %d",msub,size); 156 157 psubcomm->n = msub; 158 PetscFunctionReturn(0); 159 } 160 161 /*@C 162 PetscSubcommSetType - Set type of subcommunicators. 163 164 Collective on MPI_Comm 165 166 Input Parameter: 167 + psubcomm - PetscSubcomm context 168 - subcommtype - subcommunicator type, PETSC_SUBCOMM_CONTIGUOUS,PETSC_SUBCOMM_INTERLACED 169 170 Level: advanced 171 172 .keywords: communicator 173 174 .seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetTypeGeneral() 175 @*/ 176 PetscErrorCode PetscSubcommSetType(PetscSubcomm psubcomm,PetscSubcommType subcommtype) 177 { 178 PetscErrorCode ierr; 179 180 PetscFunctionBegin; 181 if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()"); 182 if (psubcomm->n < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()",psubcomm->n); 183 184 if (subcommtype == PETSC_SUBCOMM_CONTIGUOUS) { 185 ierr = PetscSubcommCreate_contiguous(psubcomm);CHKERRQ(ierr); 186 } else if (subcommtype == PETSC_SUBCOMM_INTERLACED) { 187 ierr = PetscSubcommCreate_interlaced(psubcomm);CHKERRQ(ierr); 188 } else SETERRQ1(psubcomm->parent,PETSC_ERR_SUP,"PetscSubcommType %s is not supported yet",PetscSubcommTypes[subcommtype]); 189 PetscFunctionReturn(0); 190 } 191 192 /*@C 193 PetscSubcommSetTypeGeneral - Set a PetscSubcomm from user's specifications 194 195 Collective on MPI_Comm 196 197 Input Parameter: 198 + psubcomm - PetscSubcomm context 199 . color - control of subset assignment (nonnegative integer). Processes with the same color are in the same subcommunicator. 200 - subrank - rank in the subcommunicator 201 202 Level: advanced 203 204 .keywords: communicator, create 205 206 .seealso: PetscSubcommCreate(),PetscSubcommDestroy(),PetscSubcommSetNumber(),PetscSubcommSetType() 207 @*/ 208 PetscErrorCode PetscSubcommSetTypeGeneral(PetscSubcomm psubcomm,PetscMPIInt color,PetscMPIInt subrank) 209 { 210 PetscErrorCode ierr; 211 MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent; 212 PetscMPIInt size,icolor,duprank,*recvbuf,sendbuf[3],mysubsize,rank,*subsize; 213 PetscMPIInt i,nsubcomm=psubcomm->n; 214 215 PetscFunctionBegin; 216 if (!psubcomm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"PetscSubcomm is not created. Call PetscSubcommCreate()"); 217 if (nsubcomm < 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"number of subcommunicators %d is incorrect. Call PetscSubcommSetNumber()",nsubcomm); 218 219 ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr); 220 221 /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */ 222 /* TODO: this can be done in an ostensibly scalale way (i.e., without allocating an array of size 'size') as is done in PetscObjectsCreateGlobalOrdering(). */ 223 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 224 ierr = PetscMalloc1(2*size,&recvbuf);CHKERRQ(ierr); 225 226 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 227 ierr = MPI_Comm_size(subcomm,&mysubsize);CHKERRQ(ierr); 228 229 sendbuf[0] = color; 230 sendbuf[1] = mysubsize; 231 ierr = MPI_Allgather(sendbuf,2,MPI_INT,recvbuf,2,MPI_INT,comm);CHKERRQ(ierr); 232 233 ierr = PetscCalloc1(nsubcomm,&subsize);CHKERRQ(ierr); 234 for (i=0; i<2*size; i+=2) { 235 subsize[recvbuf[i]] = recvbuf[i+1]; 236 } 237 ierr = PetscFree(recvbuf);CHKERRQ(ierr); 238 239 duprank = 0; 240 for (icolor=0; icolor<nsubcomm; icolor++) { 241 if (icolor != color) { /* not color of this process */ 242 duprank += subsize[icolor]; 243 } else { 244 duprank += subrank; 245 break; 246 } 247 } 248 ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr); 249 250 ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr); 251 ierr = PetscCommDuplicate(subcomm,&psubcomm->child,NULL);CHKERRQ(ierr); 252 ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr); 253 ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr); 254 255 psubcomm->color = color; 256 psubcomm->subsize = subsize; 257 psubcomm->type = PETSC_SUBCOMM_GENERAL; 258 PetscFunctionReturn(0); 259 } 260 261 /*@C 262 PetscSubcommDestroy - Destroys a PetscSubcomm object 263 264 Collective on PetscSubcomm 265 266 Input Parameter: 267 . psubcomm - the PetscSubcomm context 268 269 Level: advanced 270 271 .seealso: PetscSubcommCreate(),PetscSubcommSetType() 272 @*/ 273 PetscErrorCode PetscSubcommDestroy(PetscSubcomm *psubcomm) 274 { 275 PetscErrorCode ierr; 276 277 PetscFunctionBegin; 278 if (!*psubcomm) PetscFunctionReturn(0); 279 ierr = PetscCommDestroy(&(*psubcomm)->dupparent);CHKERRQ(ierr); 280 ierr = PetscCommDestroy(&(*psubcomm)->child);CHKERRQ(ierr); 281 ierr = PetscFree((*psubcomm)->subsize);CHKERRQ(ierr); 282 if ((*psubcomm)->subcommprefix) { ierr = PetscFree((*psubcomm)->subcommprefix);CHKERRQ(ierr); } 283 ierr = PetscFree((*psubcomm));CHKERRQ(ierr); 284 PetscFunctionReturn(0); 285 } 286 287 /*@C 288 PetscSubcommCreate - Create a PetscSubcomm context. 289 290 Collective on MPI_Comm 291 292 Input Parameter: 293 . comm - MPI communicator 294 295 Output Parameter: 296 . psubcomm - location to store the PetscSubcomm context 297 298 Level: advanced 299 300 .keywords: communicator, create 301 302 .seealso: PetscSubcommDestroy() 303 @*/ 304 PetscErrorCode PetscSubcommCreate(MPI_Comm comm,PetscSubcomm *psubcomm) 305 { 306 PetscErrorCode ierr; 307 PetscMPIInt rank,size; 308 309 PetscFunctionBegin; 310 ierr = PetscNew(psubcomm);CHKERRQ(ierr); 311 312 /* set defaults */ 313 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 314 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 315 316 (*psubcomm)->parent = comm; 317 (*psubcomm)->dupparent = comm; 318 (*psubcomm)->child = PETSC_COMM_SELF; 319 (*psubcomm)->n = size; 320 (*psubcomm)->color = rank; 321 (*psubcomm)->subsize = NULL; 322 (*psubcomm)->type = PETSC_SUBCOMM_INTERLACED; 323 PetscFunctionReturn(0); 324 } 325 326 static PetscErrorCode PetscSubcommCreate_contiguous(PetscSubcomm psubcomm) 327 { 328 PetscErrorCode ierr; 329 PetscMPIInt rank,size,*subsize,duprank=-1,subrank=-1; 330 PetscMPIInt np_subcomm,nleftover,i,color=-1,rankstart,nsubcomm=psubcomm->n; 331 MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent; 332 333 PetscFunctionBegin; 334 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 335 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 336 337 /* get size of each subcommunicator */ 338 ierr = PetscMalloc1(1+nsubcomm,&subsize);CHKERRQ(ierr); 339 340 np_subcomm = size/nsubcomm; 341 nleftover = size - nsubcomm*np_subcomm; 342 for (i=0; i<nsubcomm; i++) { 343 subsize[i] = np_subcomm; 344 if (i<nleftover) subsize[i]++; 345 } 346 347 /* get color and subrank of this proc */ 348 rankstart = 0; 349 for (i=0; i<nsubcomm; i++) { 350 if (rank >= rankstart && rank < rankstart+subsize[i]) { 351 color = i; 352 subrank = rank - rankstart; 353 duprank = rank; 354 break; 355 } else rankstart += subsize[i]; 356 } 357 358 ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr); 359 360 /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */ 361 ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr); 362 ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr); 363 ierr = PetscCommDuplicate(subcomm,&psubcomm->child,NULL);CHKERRQ(ierr); 364 ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr); 365 ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr); 366 367 psubcomm->color = color; 368 psubcomm->subsize = subsize; 369 psubcomm->type = PETSC_SUBCOMM_CONTIGUOUS; 370 PetscFunctionReturn(0); 371 } 372 373 /* 374 Note: 375 In PCREDUNDANT, to avoid data scattering from subcomm back to original comm, we create subcommunicators 376 by iteratively taking a process into a subcommunicator. 377 Example: size=4, nsubcomm=(*psubcomm)->n=3 378 comm=(*psubcomm)->parent: 379 rank: [0] [1] [2] [3] 380 color: 0 1 2 0 381 382 subcomm=(*psubcomm)->comm: 383 subrank: [0] [0] [0] [1] 384 385 dupcomm=(*psubcomm)->dupparent: 386 duprank: [0] [2] [3] [1] 387 388 Here, subcomm[color = 0] has subsize=2, owns process [0] and [3] 389 subcomm[color = 1] has subsize=1, owns process [1] 390 subcomm[color = 2] has subsize=1, owns process [2] 391 dupcomm has same number of processes as comm, and its duprank maps 392 processes in subcomm contiguously into a 1d array: 393 duprank: [0] [1] [2] [3] 394 rank: [0] [3] [1] [2] 395 subcomm[0] subcomm[1] subcomm[2] 396 */ 397 398 static PetscErrorCode PetscSubcommCreate_interlaced(PetscSubcomm psubcomm) 399 { 400 PetscErrorCode ierr; 401 PetscMPIInt rank,size,*subsize,duprank,subrank; 402 PetscMPIInt np_subcomm,nleftover,i,j,color,nsubcomm=psubcomm->n; 403 MPI_Comm subcomm=0,dupcomm=0,comm=psubcomm->parent; 404 405 PetscFunctionBegin; 406 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 407 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 408 409 /* get size of each subcommunicator */ 410 ierr = PetscMalloc1(1+nsubcomm,&subsize);CHKERRQ(ierr); 411 412 np_subcomm = size/nsubcomm; 413 nleftover = size - nsubcomm*np_subcomm; 414 for (i=0; i<nsubcomm; i++) { 415 subsize[i] = np_subcomm; 416 if (i<nleftover) subsize[i]++; 417 } 418 419 /* find color for this proc */ 420 color = rank%nsubcomm; 421 subrank = rank/nsubcomm; 422 423 ierr = MPI_Comm_split(comm,color,subrank,&subcomm);CHKERRQ(ierr); 424 425 j = 0; duprank = 0; 426 for (i=0; i<nsubcomm; i++) { 427 if (j == color) { 428 duprank += subrank; 429 break; 430 } 431 duprank += subsize[i]; j++; 432 } 433 434 /* create dupcomm with same size as comm, but its rank, duprank, maps subcomm's contiguously into dupcomm */ 435 ierr = MPI_Comm_split(comm,0,duprank,&dupcomm);CHKERRQ(ierr); 436 ierr = PetscCommDuplicate(dupcomm,&psubcomm->dupparent,NULL);CHKERRQ(ierr); 437 ierr = PetscCommDuplicate(subcomm,&psubcomm->child,NULL);CHKERRQ(ierr); 438 ierr = MPI_Comm_free(&dupcomm);CHKERRQ(ierr); 439 ierr = MPI_Comm_free(&subcomm);CHKERRQ(ierr); 440 441 psubcomm->color = color; 442 psubcomm->subsize = subsize; 443 psubcomm->type = PETSC_SUBCOMM_INTERLACED; 444 PetscFunctionReturn(0); 445 } 446 447 448