1 #define PETSC_DESIRE_COMPLEX 2 #include <petsc-private/sfimpl.h> /*I "petscsf.h" I*/ 3 4 typedef struct _n_PetscSFBasicPack *PetscSFBasicPack; 5 struct _n_PetscSFBasicPack { 6 void (*Pack)(PetscInt,const PetscInt*,const void*,void*); 7 void (*UnpackInsert)(PetscInt,const PetscInt*,void*,const void*); 8 void (*UnpackAdd)(PetscInt,const PetscInt*,void*,const void*); 9 void (*UnpackMin)(PetscInt,const PetscInt*,void*,const void*); 10 void (*UnpackMax)(PetscInt,const PetscInt*,void*,const void*); 11 void (*UnpackMinloc)(PetscInt,const PetscInt*,void*,const void*); 12 void (*UnpackMaxloc)(PetscInt,const PetscInt*,void*,const void*); 13 void (*FetchAndInsert)(PetscInt,const PetscInt*,void*,void*); 14 void (*FetchAndAdd)(PetscInt,const PetscInt*,void*,void*); 15 void (*FetchAndMin)(PetscInt,const PetscInt*,void*,void*); 16 void (*FetchAndMax)(PetscInt,const PetscInt*,void*,void*); 17 void (*FetchAndMinloc)(PetscInt,const PetscInt*,void*,void*); 18 void (*FetchAndMaxloc)(PetscInt,const PetscInt*,void*,void*); 19 20 MPI_Datatype unit; 21 size_t unitbytes; /* Number of bytes in a unit */ 22 const void *key; /* Array used as key for operation */ 23 char *root; /* Packed root data, contiguous by leaf rank */ 24 char *leaf; /* Packed leaf data, contiguous by root rank */ 25 MPI_Request *requests; /* Array of root requests followed by leaf requests */ 26 PetscSFBasicPack next; 27 }; 28 29 typedef struct { 30 PetscMPIInt tag; 31 PetscInt niranks; /* Number of incoming ranks (ranks accessing my roots) */ 32 PetscMPIInt *iranks; /* Array of ranks that reference my roots */ 33 PetscInt itotal; /* Total number of graph edges referencing my roots */ 34 PetscInt *ioffset; /* Array of length niranks+1 holding offset in irootloc[] for each rank */ 35 PetscInt *irootloc; /* Incoming roots referenced by ranks starting at ioffset[rank] */ 36 PetscSFBasicPack avail; /* One or more entries per MPI Datatype, lazily constructed */ 37 PetscSFBasicPack inuse; /* Buffers being used for transactions that have not yet completed */ 38 } PetscSF_Basic; 39 40 #if !defined(PETSC_HAVE_MPI_TYPE_DUP) /* Danger: type is not reference counted; subject to ABA problem */ 41 PETSC_STATIC_INLINE PetscErrorCode MPI_Type_dup(MPI_Datatype datatype,MPI_Datatype *newtype) 42 { 43 *newtype = datatype; 44 return 0; 45 } 46 #endif 47 48 /* 49 * MPI_Reduce_local is not really useful because it can't handle sparse data and it vectorizes "in the wrong direction", 50 * therefore we pack data types manually. This section defines packing routines for the standard data types. 51 */ 52 53 #define CPPJoin2_exp(a,b) a ## b 54 #define CPPJoin2(a,b) CPPJoin2_exp(a,b) 55 #define CPPJoin3_exp_(a,b,c) a ## b ## _ ## c 56 #define CPPJoin3_(a,b,c) CPPJoin3_exp_(a,b,c) 57 58 /* Basic types without addition */ 59 #define DEF_PackNoInit(type) \ 60 static void CPPJoin2(Pack_,type)(PetscInt n,const PetscInt *idx,const void *unpacked,void *packed) { \ 61 const type *u = (const type*)unpacked; \ 62 type *p = (type*)packed; \ 63 PetscInt i; \ 64 for (i=0; i<n; i++) p[i] = u[idx[i]]; \ 65 } \ 66 static void CPPJoin2(UnpackInsert_,type)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 67 type *u = (type*)unpacked; \ 68 const type *p = (const type*)packed; \ 69 PetscInt i; \ 70 for (i=0; i<n; i++) u[idx[i]] = p[i]; \ 71 } \ 72 static void CPPJoin2(FetchAndInsert_,type)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 73 type *u = (type*)unpacked; \ 74 type *p = (type*)packed; \ 75 PetscInt i; \ 76 for (i=0; i<n; i++) { \ 77 PetscInt j = idx[i]; \ 78 type t = u[j]; \ 79 u[j] = p[i]; \ 80 p[i] = t; \ 81 } \ 82 } 83 84 /* Basic types defining addition */ 85 #define DEF_PackAddNoInit(type) \ 86 DEF_PackNoInit(type) \ 87 static void CPPJoin2(UnpackAdd_,type)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 88 type *u = (type*)unpacked; \ 89 const type *p = (const type*)packed; \ 90 PetscInt i; \ 91 for (i=0; i<n; i++) u[idx[i]] += p[i]; \ 92 } \ 93 static void CPPJoin2(FetchAndAdd_,type)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 94 type *u = (type*)unpacked; \ 95 type *p = (type*)packed; \ 96 PetscInt i; \ 97 for (i=0; i<n; i++) { \ 98 PetscInt j = idx[i]; \ 99 type t = u[j]; \ 100 u[j] = t + p[i]; \ 101 p[i] = t; \ 102 } \ 103 } 104 #define DEF_Pack(type) \ 105 DEF_PackAddNoInit(type) \ 106 static void CPPJoin2(PackInit_,type)(PetscSFBasicPack link) { \ 107 link->Pack = CPPJoin2(Pack_,type); \ 108 link->UnpackInsert = CPPJoin2(UnpackInsert_,type); \ 109 link->UnpackAdd = CPPJoin2(UnpackAdd_,type); \ 110 link->FetchAndInsert = CPPJoin2(FetchAndInsert_,type); \ 111 link->FetchAndAdd = CPPJoin2(FetchAndAdd_,type); \ 112 link->unitbytes = sizeof(type); \ 113 } 114 /* Comparable types */ 115 #define DEF_PackCmp(type) \ 116 DEF_PackAddNoInit(type) \ 117 static void CPPJoin2(UnpackMax_,type)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 118 type *u = (type*)unpacked; \ 119 const type *p = (const type*)packed; \ 120 PetscInt i; \ 121 for (i=0; i<n; i++) { \ 122 type v = u[idx[i]]; \ 123 u[idx[i]] = PetscMax(v,p[i]); \ 124 } \ 125 } \ 126 static void CPPJoin2(UnpackMin_,type)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 127 type *u = (type*)unpacked; \ 128 const type *p = (const type*)packed; \ 129 PetscInt i; \ 130 for (i=0; i<n; i++) { \ 131 type v = u[idx[i]]; \ 132 u[idx[i]] = PetscMin(v,p[i]); \ 133 } \ 134 } \ 135 static void CPPJoin2(FetchAndMax_,type)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 136 type *u = (type*)unpacked; \ 137 type *p = (type*)packed; \ 138 PetscInt i; \ 139 for (i=0; i<n; i++) { \ 140 PetscInt j = idx[i]; \ 141 type v = u[j]; \ 142 u[j] = PetscMax(v,p[i]); \ 143 p[i] = v; \ 144 } \ 145 } \ 146 static void CPPJoin2(FetchAndMin_,type)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 147 type *u = (type*)unpacked; \ 148 type *p = (type*)packed; \ 149 PetscInt i; \ 150 for (i=0; i<n; i++) { \ 151 PetscInt j = idx[i]; \ 152 type v = u[j]; \ 153 u[j] = PetscMin(v,p[i]); \ 154 p[i] = v; \ 155 } \ 156 } \ 157 static void CPPJoin2(PackInit_,type)(PetscSFBasicPack link) { \ 158 link->Pack = CPPJoin2(Pack_,type); \ 159 link->UnpackInsert = CPPJoin2(UnpackInsert_,type); \ 160 link->UnpackAdd = CPPJoin2(UnpackAdd_,type); \ 161 link->UnpackMax = CPPJoin2(UnpackMax_,type); \ 162 link->UnpackMin = CPPJoin2(UnpackMin_,type); \ 163 link->FetchAndInsert = CPPJoin2(FetchAndInsert_,type); \ 164 link->FetchAndAdd = CPPJoin2(FetchAndAdd_ ,type); \ 165 link->FetchAndMax = CPPJoin2(FetchAndMax_ ,type); \ 166 link->FetchAndMin = CPPJoin2(FetchAndMin_ ,type); \ 167 link->unitbytes = sizeof(type); \ 168 } 169 170 /* Pair types */ 171 #define CPPJoinloc_exp(base,op,t1,t2) base ## op ## loc_ ## t1 ## _ ## t2 172 #define CPPJoinloc(base,op,t1,t2) CPPJoinloc_exp(base,op,t1,t2) 173 #define PairType(type1,type2) CPPJoin3_(_pairtype_,type1,type2) 174 #define DEF_UnpackXloc(type1,type2,locname,op) \ 175 static void CPPJoinloc(Unpack,locname,type1,type2)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 176 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 177 const PairType(type1,type2) *p = (const PairType(type1,type2)*)packed; \ 178 PetscInt i; \ 179 for (i=0; i<n; i++) { \ 180 PetscInt j = idx[i]; \ 181 if (p[i].a op u[j].a) { \ 182 u[j].a = p[i].a; \ 183 u[j].b = p[i].b; \ 184 } else if (u[j].a == p[i].a) { \ 185 u[j].b = PetscMin(u[j].b,p[i].b); \ 186 } \ 187 } \ 188 } \ 189 static void CPPJoinloc(FetchAnd,locname,type1,type2)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 190 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 191 PairType(type1,type2) *p = (PairType(type1,type2)*)packed; \ 192 PetscInt i; \ 193 for (i=0; i<n; i++) { \ 194 PetscInt j = idx[i]; \ 195 PairType(type1,type2) v; \ 196 v.a = u[j].a; \ 197 v.b = u[j].b; \ 198 if (p[i].a op u[j].a) { \ 199 u[j].a = p[i].a; \ 200 u[j].b = p[i].b; \ 201 } else if (u[j].a == p[i].a) { \ 202 u[j].b = PetscMin(u[j].b,p[i].b); \ 203 } \ 204 p[i].a = v.a; \ 205 p[i].b = v.b; \ 206 } \ 207 } 208 #define DEF_PackPair(type1,type2) \ 209 typedef struct {type1 a; type2 b;} PairType(type1,type2); \ 210 static void CPPJoin3_(Pack_,type1,type2)(PetscInt n,const PetscInt *idx,const void *unpacked,void *packed) { \ 211 const PairType(type1,type2) *u = (const PairType(type1,type2)*)unpacked; \ 212 PairType(type1,type2) *p = (PairType(type1,type2)*)packed; \ 213 PetscInt i; \ 214 for (i=0; i<n; i++) { \ 215 p[i].a = u[idx[i]].a; \ 216 p[i].b = u[idx[i]].b; \ 217 } \ 218 } \ 219 static void CPPJoin3_(UnpackInsert_,type1,type2)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 220 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 221 const PairType(type1,type2) *p = (const PairType(type1,type2)*)packed; \ 222 PetscInt i; \ 223 for (i=0; i<n; i++) { \ 224 u[idx[i]].a = p[i].a; \ 225 u[idx[i]].b = p[i].b; \ 226 } \ 227 } \ 228 static void CPPJoin3_(UnpackAdd_,type1,type2)(PetscInt n,const PetscInt *idx,void *unpacked,const void *packed) { \ 229 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 230 const PairType(type1,type2) *p = (const PairType(type1,type2)*)packed; \ 231 PetscInt i; \ 232 for (i=0; i<n; i++) { \ 233 u[idx[i]].a += p[i].a; \ 234 u[idx[i]].b += p[i].b; \ 235 } \ 236 } \ 237 static void CPPJoin3_(FetchAndInsert_,type1,type2)(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 238 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 239 PairType(type1,type2) *p = (PairType(type1,type2)*)packed; \ 240 PetscInt i; \ 241 for (i=0; i<n; i++) { \ 242 PetscInt j = idx[i]; \ 243 PairType(type1,type2) v; \ 244 v.a = u[j].a; \ 245 v.b = u[j].b; \ 246 u[j].a = p[i].a; \ 247 u[j].b = p[i].b; \ 248 p[i].a = v.a; \ 249 p[i].b = v.b; \ 250 } \ 251 } \ 252 static void FetchAndAdd_ ## type1 ## _ ## type2(PetscInt n,const PetscInt *idx,void *unpacked,void *packed) { \ 253 PairType(type1,type2) *u = (PairType(type1,type2)*)unpacked; \ 254 PairType(type1,type2) *p = (PairType(type1,type2)*)packed; \ 255 PetscInt i; \ 256 for (i=0; i<n; i++) { \ 257 PetscInt j = idx[i]; \ 258 PairType(type1,type2) v; \ 259 v.a = u[j].a; \ 260 v.b = u[j].b; \ 261 u[j].a = v.a + p[i].a; \ 262 u[j].b = v.b + p[i].b; \ 263 p[i].a = v.a; \ 264 p[i].b = v.b; \ 265 } \ 266 } \ 267 DEF_UnpackXloc(type1,type2,Max,>) \ 268 DEF_UnpackXloc(type1,type2,Min,<) \ 269 static void CPPJoin3_(PackInit_,type1,type2)(PetscSFBasicPack link) { \ 270 link->Pack = CPPJoin3_(Pack_,type1,type2); \ 271 link->UnpackInsert = CPPJoin3_(UnpackInsert_,type1,type2); \ 272 link->UnpackAdd = CPPJoin3_(UnpackAdd_,type1,type2); \ 273 link->UnpackMaxloc = CPPJoin3_(UnpackMaxloc_,type1,type2); \ 274 link->UnpackMinloc = CPPJoin3_(UnpackMinloc_,type1,type2); \ 275 link->FetchAndInsert = CPPJoin3_(FetchAndInsert_,type1,type2); \ 276 link->FetchAndAdd = CPPJoin3_(FetchAndAdd_,type1,type2); \ 277 link->FetchAndMaxloc = CPPJoin3_(FetchAndMaxloc_,type1,type2); \ 278 link->FetchAndMinloc = CPPJoin3_(FetchAndMinloc_,type1,type2); \ 279 link->unitbytes = sizeof(PairType(type1,type2)); \ 280 } 281 282 /* Currently only dumb blocks of data */ 283 #define BlockType(unit,count) CPPJoin3_(_blocktype_,unit,count) 284 #define DEF_Block(unit,count) \ 285 typedef struct {unit v[count];} BlockType(unit,count); \ 286 DEF_PackNoInit(BlockType(unit,count)) \ 287 static void CPPJoin3_(PackInit_block_,unit,count)(PetscSFBasicPack link) { \ 288 link->Pack = CPPJoin2(Pack_,BlockType(unit,count)); \ 289 link->UnpackInsert = CPPJoin2(UnpackInsert_,BlockType(unit,count)); \ 290 link->FetchAndInsert = CPPJoin2(FetchAndInsert_,BlockType(unit,count)); \ 291 link->unitbytes = sizeof(BlockType(unit,count)); \ 292 } 293 294 DEF_PackCmp(int) 295 DEF_PackCmp(PetscInt) 296 DEF_PackCmp(PetscReal) 297 #if defined(PETSC_HAVE_COMPLEX) 298 DEF_Pack(PetscComplex) 299 #endif 300 DEF_PackPair(int,int) 301 DEF_PackPair(PetscInt,PetscInt) 302 DEF_Block(int,1) 303 DEF_Block(int,2) 304 DEF_Block(int,3) 305 DEF_Block(int,4) 306 DEF_Block(int,5) 307 DEF_Block(int,6) 308 DEF_Block(int,7) 309 DEF_Block(int,8) 310 311 #undef __FUNCT__ 312 #define __FUNCT__ "PetscSFSetUp_Basic" 313 static PetscErrorCode PetscSFSetUp_Basic(PetscSF sf) 314 { 315 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 316 PetscErrorCode ierr; 317 PetscInt *rlengths,*ilengths,i; 318 MPI_Comm comm; 319 MPI_Request *rootreqs,*leafreqs; 320 321 PetscFunctionBegin; 322 ierr = PetscObjectGetComm((PetscObject)sf,&comm);CHKERRQ(ierr); 323 ierr = PetscObjectGetNewTag((PetscObject)sf,&bas->tag);CHKERRQ(ierr); 324 /* 325 * Inform roots about how many leaves and from which ranks 326 */ 327 ierr = PetscMalloc(sf->nranks*sizeof(PetscInt),&rlengths);CHKERRQ(ierr); 328 /* Determine number, sending ranks, and length of incoming */ 329 for (i=0; i<sf->nranks; i++) { 330 rlengths[i] = sf->roffset[i+1] - sf->roffset[i]; /* Number of roots referenced by my leaves; for rank sf->ranks[i] */ 331 } 332 ierr = PetscCommBuildTwoSided(comm,1,MPIU_INT,sf->nranks,sf->ranks,rlengths,&bas->niranks,&bas->iranks,(void**)&ilengths);CHKERRQ(ierr); 333 ierr = PetscFree(rlengths);CHKERRQ(ierr); 334 335 /* Send leaf identities to roots */ 336 for (i=0,bas->itotal=0; i<bas->niranks; i++) bas->itotal += ilengths[i]; 337 ierr = PetscMalloc2(bas->niranks+1,PetscInt,&bas->ioffset,bas->itotal,PetscInt,&bas->irootloc);CHKERRQ(ierr); 338 ierr = PetscMalloc2(bas->niranks,MPI_Request,&rootreqs,sf->nranks,MPI_Request,&leafreqs);CHKERRQ(ierr); 339 bas->ioffset[0] = 0; 340 for (i=0; i<bas->niranks; i++) { 341 bas->ioffset[i+1] = bas->ioffset[i] + ilengths[i]; 342 ierr = MPI_Irecv(bas->irootloc+bas->ioffset[i],ilengths[i],MPIU_INT,bas->iranks[i],bas->tag,comm,&rootreqs[i]);CHKERRQ(ierr); 343 } 344 for (i=0; i<sf->nranks; i++) { 345 PetscMPIInt npoints; 346 ierr = PetscMPIIntCast(sf->roffset[i+1] - sf->roffset[i],&npoints);CHKERRQ(ierr); 347 ierr = MPI_Isend(sf->rremote+sf->roffset[i],npoints,MPIU_INT,sf->ranks[i],bas->tag,comm,&leafreqs[i]);CHKERRQ(ierr); 348 } 349 ierr = MPI_Waitall(bas->niranks,rootreqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 350 ierr = MPI_Waitall(sf->nranks,leafreqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 351 ierr = PetscFree(ilengths);CHKERRQ(ierr); 352 ierr = PetscFree2(rootreqs,leafreqs);CHKERRQ(ierr); 353 PetscFunctionReturn(0); 354 } 355 356 #undef __FUNCT__ 357 #define __FUNCT__ "PetscSFBasicPackTypeSetup" 358 static PetscErrorCode PetscSFBasicPackTypeSetup(PetscSFBasicPack link,MPI_Datatype unit) 359 { 360 PetscErrorCode ierr; 361 PetscBool isInt,isPetscInt,isPetscReal,is2Int,is2PetscInt; 362 #if defined(PETSC_HAVE_COMPLEX) 363 PetscBool isPetscComplex; 364 #endif 365 366 PetscFunctionBegin; 367 ierr = MPIPetsc_Type_compare(unit,MPI_INT,&isInt);CHKERRQ(ierr); 368 ierr = MPIPetsc_Type_compare(unit,MPIU_INT,&isPetscInt);CHKERRQ(ierr); 369 ierr = MPIPetsc_Type_compare(unit,MPIU_REAL,&isPetscReal);CHKERRQ(ierr); 370 #if defined(PETSC_HAVE_COMPLEX) 371 ierr = MPIPetsc_Type_compare(unit,MPIU_COMPLEX,&isPetscComplex);CHKERRQ(ierr); 372 #endif 373 ierr = MPIPetsc_Type_compare(unit,MPI_2INT,&is2Int);CHKERRQ(ierr); 374 ierr = MPIPetsc_Type_compare(unit,MPIU_2INT,&is2PetscInt);CHKERRQ(ierr); 375 if (isInt) PackInit_int(link); 376 else if (isPetscInt) PackInit_PetscInt(link); 377 else if (isPetscReal) PackInit_PetscReal(link); 378 #if defined(PETSC_HAVE_COMPLEX) 379 else if (isPetscComplex) PackInit_PetscComplex(link); 380 #endif 381 else if (is2Int) PackInit_int_int(link); 382 else if (is2PetscInt) PackInit_PetscInt_PetscInt(link); 383 else { 384 PetscMPIInt bytes; 385 ierr = MPI_Type_size(unit,&bytes);CHKERRQ(ierr); 386 if (bytes % sizeof(int)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for type size not divisible by %D",sizeof(int)); 387 switch (bytes / sizeof(int)) { 388 case 1: PackInit_block_int_1(link); break; 389 case 2: PackInit_block_int_2(link); break; 390 case 3: PackInit_block_int_3(link); break; 391 case 4: PackInit_block_int_4(link); break; 392 case 5: PackInit_block_int_5(link); break; 393 case 6: PackInit_block_int_6(link); break; 394 case 7: PackInit_block_int_7(link); break; 395 case 8: PackInit_block_int_8(link); break; 396 default: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for arbitrary block sizes"); 397 } 398 } 399 ierr = MPI_Type_dup(unit,&link->unit);CHKERRQ(ierr); 400 PetscFunctionReturn(0); 401 } 402 403 #undef __FUNCT__ 404 #define __FUNCT__ "PetscSFBasicPackGetUnpackOp" 405 static PetscErrorCode PetscSFBasicPackGetUnpackOp(PetscSF sf,PetscSFBasicPack link,MPI_Op op,void (**UnpackOp)(PetscInt,const PetscInt*,void*,const void*)) 406 { 407 PetscFunctionBegin; 408 *UnpackOp = NULL; 409 if (op == MPIU_REPLACE) *UnpackOp = link->UnpackInsert; 410 else if (op == MPI_SUM || op == MPIU_SUM) *UnpackOp = link->UnpackAdd; 411 else if (op == MPI_MAX || op == MPIU_MAX) *UnpackOp = link->UnpackMax; 412 else if (op == MPI_MIN || op == MPIU_MIN) *UnpackOp = link->UnpackMin; 413 else if (op == MPI_MAXLOC) *UnpackOp = link->UnpackMaxloc; 414 else if (op == MPI_MINLOC) *UnpackOp = link->UnpackMinloc; 415 else SETERRQ(PetscObjectComm((PetscObject)sf),PETSC_ERR_SUP,"No support for MPI_Op"); 416 PetscFunctionReturn(0); 417 } 418 #undef __FUNCT__ 419 #define __FUNCT__ "PetscSFBasicPackGetFetchAndOp" 420 static PetscErrorCode PetscSFBasicPackGetFetchAndOp(PetscSF sf,PetscSFBasicPack link,MPI_Op op,void (**FetchAndOp)(PetscInt,const PetscInt*,void*,void*)) 421 { 422 PetscFunctionBegin; 423 *FetchAndOp = NULL; 424 if (op == MPIU_REPLACE) *FetchAndOp = link->FetchAndInsert; 425 else if (op == MPI_SUM || op == MPIU_SUM) *FetchAndOp = link->FetchAndAdd; 426 else if (op == MPI_MAX || op == MPIU_MAX) *FetchAndOp = link->FetchAndMax; 427 else if (op == MPI_MIN || op == MPIU_MIN) *FetchAndOp = link->FetchAndMin; 428 else if (op == MPI_MAXLOC) *FetchAndOp = link->FetchAndMaxloc; 429 else if (op == MPI_MINLOC) *FetchAndOp = link->FetchAndMinloc; 430 else SETERRQ(PetscObjectComm((PetscObject)sf),PETSC_ERR_SUP,"No support for MPI_Op"); 431 PetscFunctionReturn(0); 432 } 433 434 #undef __FUNCT__ 435 #define __FUNCT__ "PetscSFBasicPackGetReqs" 436 static PetscErrorCode PetscSFBasicPackGetReqs(PetscSF sf,PetscSFBasicPack link,MPI_Request **rootreqs,MPI_Request **leafreqs) 437 { 438 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 439 440 PetscFunctionBegin; 441 if (rootreqs) *rootreqs = link->requests; 442 if (leafreqs) *leafreqs = link->requests + bas->niranks; 443 PetscFunctionReturn(0); 444 } 445 446 #undef __FUNCT__ 447 #define __FUNCT__ "PetscSFBasicPackWaitall" 448 static PetscErrorCode PetscSFBasicPackWaitall(PetscSF sf,PetscSFBasicPack link) 449 { 450 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 451 PetscErrorCode ierr; 452 453 PetscFunctionBegin; 454 ierr = MPI_Waitall(bas->niranks+sf->nranks,link->requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 455 PetscFunctionReturn(0); 456 } 457 458 #undef __FUNCT__ 459 #define __FUNCT__ "PetscSFBasicGetRootInfo" 460 static PetscErrorCode PetscSFBasicGetRootInfo(PetscSF sf,PetscInt *nrootranks,const PetscMPIInt **rootranks,const PetscInt **rootoffset,const PetscInt **rootloc) 461 { 462 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 463 464 PetscFunctionBegin; 465 if (nrootranks) *nrootranks = bas->niranks; 466 if (rootranks) *rootranks = bas->iranks; 467 if (rootoffset) *rootoffset = bas->ioffset; 468 if (rootloc) *rootloc = bas->irootloc; 469 PetscFunctionReturn(0); 470 } 471 472 #undef __FUNCT__ 473 #define __FUNCT__ "PetscSFBasicGetLeafInfo" 474 static PetscErrorCode PetscSFBasicGetLeafInfo(PetscSF sf,PetscInt *nleafranks,const PetscMPIInt **leafranks,const PetscInt **leafoffset,const PetscInt **leafloc) 475 { 476 PetscFunctionBegin; 477 if (nleafranks) *nleafranks = sf->nranks; 478 if (leafranks) *leafranks = sf->ranks; 479 if (leafoffset) *leafoffset = sf->roffset; 480 if (leafloc) *leafloc = sf->rmine; 481 PetscFunctionReturn(0); 482 } 483 484 #undef __FUNCT__ 485 #define __FUNCT__ "PetscSFBasicGetPack" 486 static PetscErrorCode PetscSFBasicGetPack(PetscSF sf,MPI_Datatype unit,const void *key,PetscSFBasicPack *mylink) 487 { 488 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 489 PetscErrorCode ierr; 490 PetscSFBasicPack link,*p; 491 PetscInt nrootranks,nleafranks; 492 const PetscInt *rootoffset,*leafoffset; 493 494 PetscFunctionBegin; 495 /* Look for types in cache */ 496 for (p=&bas->avail; (link=*p); p=&link->next) { 497 PetscBool match; 498 ierr = MPIPetsc_Type_compare(unit,link->unit,&match);CHKERRQ(ierr); 499 if (match) { 500 *p = link->next; /* Remove from available list */ 501 goto found; 502 } 503 } 504 505 /* Create new composite types for each send rank */ 506 ierr = PetscSFBasicGetRootInfo(sf,&nrootranks,NULL,&rootoffset,NULL);CHKERRQ(ierr); 507 ierr = PetscSFBasicGetLeafInfo(sf,&nleafranks,NULL,&leafoffset,NULL);CHKERRQ(ierr); 508 ierr = PetscNew(struct _n_PetscSFBasicPack,&link);CHKERRQ(ierr); 509 ierr = PetscSFBasicPackTypeSetup(link,unit);CHKERRQ(ierr); 510 ierr = PetscMalloc2(rootoffset[nrootranks]*link->unitbytes,char,&link->root,leafoffset[nleafranks]*link->unitbytes,char,&link->leaf);CHKERRQ(ierr); 511 ierr = PetscMalloc((nrootranks+nleafranks)*sizeof(MPI_Request),&link->requests);CHKERRQ(ierr); 512 513 found: 514 link->key = key; 515 link->next = bas->inuse; 516 bas->inuse = link; 517 518 *mylink = link; 519 PetscFunctionReturn(0); 520 } 521 522 #undef __FUNCT__ 523 #define __FUNCT__ "PetscSFBasicGetPackInUse" 524 static PetscErrorCode PetscSFBasicGetPackInUse(PetscSF sf,MPI_Datatype unit,const void *key,PetscCopyMode cmode,PetscSFBasicPack *mylink) 525 { 526 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 527 PetscErrorCode ierr; 528 PetscSFBasicPack link,*p; 529 530 PetscFunctionBegin; 531 /* Look for types in cache */ 532 for (p=&bas->inuse; (link=*p); p=&link->next) { 533 PetscBool match; 534 ierr = MPIPetsc_Type_compare(unit,link->unit,&match);CHKERRQ(ierr); 535 if (match) { 536 switch (cmode) { 537 case PETSC_OWN_POINTER: *p = link->next; break; /* Remove from inuse list */ 538 case PETSC_USE_POINTER: break; 539 default: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"invalid cmode"); 540 } 541 *mylink = link; 542 PetscFunctionReturn(0); 543 } 544 } 545 SETERRQ(PetscObjectComm((PetscObject)sf),PETSC_ERR_ARG_WRONGSTATE,"Could not find pack"); 546 PetscFunctionReturn(0); 547 } 548 549 #undef __FUNCT__ 550 #define __FUNCT__ "PetscSFBasicReclaimPack" 551 static PetscErrorCode PetscSFBasicReclaimPack(PetscSF sf,PetscSFBasicPack *link) 552 { 553 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 554 555 PetscFunctionBegin; 556 (*link)->key = NULL; 557 (*link)->next = bas->avail; 558 bas->avail = *link; 559 *link = NULL; 560 PetscFunctionReturn(0); 561 } 562 563 #undef __FUNCT__ 564 #define __FUNCT__ "PetscSFSetFromOptions_Basic" 565 static PetscErrorCode PetscSFSetFromOptions_Basic(PetscSF sf) 566 { 567 PetscErrorCode ierr; 568 569 PetscFunctionBegin; 570 ierr = PetscOptionsHead("PetscSF Basic options");CHKERRQ(ierr); 571 ierr = PetscOptionsTail();CHKERRQ(ierr); 572 PetscFunctionReturn(0); 573 } 574 575 #undef __FUNCT__ 576 #define __FUNCT__ "PetscSFReset_Basic" 577 static PetscErrorCode PetscSFReset_Basic(PetscSF sf) 578 { 579 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 580 PetscErrorCode ierr; 581 PetscSFBasicPack link,next; 582 583 PetscFunctionBegin; 584 ierr = PetscFree(bas->iranks);CHKERRQ(ierr); 585 ierr = PetscFree2(bas->ioffset,bas->irootloc);CHKERRQ(ierr); 586 if (bas->inuse) SETERRQ(PetscObjectComm((PetscObject)sf),PETSC_ERR_ARG_WRONGSTATE,"Outstanding operation has not been completed"); 587 for (link=bas->avail; link; link=next) { 588 next = link->next; 589 #if defined(PETSC_HAVE_MPI_TYPE_DUP) 590 ierr = MPI_Type_free(&link->unit);CHKERRQ(ierr); 591 #endif 592 ierr = PetscFree2(link->root,link->leaf);CHKERRQ(ierr); 593 ierr = PetscFree(link->requests);CHKERRQ(ierr); 594 ierr = PetscFree(link);CHKERRQ(ierr); 595 } 596 bas->avail = NULL; 597 PetscFunctionReturn(0); 598 } 599 600 #undef __FUNCT__ 601 #define __FUNCT__ "PetscSFDestroy_Basic" 602 static PetscErrorCode PetscSFDestroy_Basic(PetscSF sf) 603 { 604 PetscErrorCode ierr; 605 606 PetscFunctionBegin; 607 ierr = PetscSFReset_Basic(sf);CHKERRQ(ierr); 608 ierr = PetscFree(sf->data);CHKERRQ(ierr); 609 PetscFunctionReturn(0); 610 } 611 612 #undef __FUNCT__ 613 #define __FUNCT__ "PetscSFView_Basic" 614 static PetscErrorCode PetscSFView_Basic(PetscSF sf,PetscViewer viewer) 615 { 616 /* PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; */ 617 PetscErrorCode ierr; 618 PetscBool iascii; 619 620 PetscFunctionBegin; 621 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 622 if (iascii) { 623 ierr = PetscViewerASCIIPrintf(viewer," sort=%s\n",sf->rankorder ? "rank-order" : "unordered");CHKERRQ(ierr); 624 } 625 PetscFunctionReturn(0); 626 } 627 628 #undef __FUNCT__ 629 #define __FUNCT__ "PetscSFBcastBegin_Basic" 630 /* Send from roots to leaves */ 631 static PetscErrorCode PetscSFBcastBegin_Basic(PetscSF sf,MPI_Datatype unit,const void *rootdata,void *leafdata) 632 { 633 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 634 PetscErrorCode ierr; 635 PetscSFBasicPack link; 636 PetscInt i,nrootranks,nleafranks; 637 const PetscInt *rootoffset,*leafoffset,*rootloc,*leafloc; 638 const PetscMPIInt *rootranks,*leafranks; 639 MPI_Request *rootreqs,*leafreqs; 640 size_t unitbytes; 641 642 PetscFunctionBegin; 643 ierr = PetscSFBasicGetRootInfo(sf,&nrootranks,&rootranks,&rootoffset,&rootloc);CHKERRQ(ierr); 644 ierr = PetscSFBasicGetLeafInfo(sf,&nleafranks,&leafranks,&leafoffset,&leafloc);CHKERRQ(ierr); 645 ierr = PetscSFBasicGetPack(sf,unit,rootdata,&link);CHKERRQ(ierr); 646 647 unitbytes = link->unitbytes; 648 649 ierr = PetscSFBasicPackGetReqs(sf,link,&rootreqs,&leafreqs);CHKERRQ(ierr); 650 /* Eagerly post leaf receives */ 651 for (i=0; i<nleafranks; i++) { 652 PetscMPIInt n = leafoffset[i+1] - leafoffset[i]; 653 ierr = MPI_Irecv(link->leaf+leafoffset[i]*unitbytes,n,unit,leafranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&leafreqs[i]);CHKERRQ(ierr); 654 } 655 /* Pack and send root data */ 656 for (i=0; i<nrootranks; i++) { 657 PetscMPIInt n = rootoffset[i+1] - rootoffset[i]; 658 void *packstart = link->root+rootoffset[i]*unitbytes; 659 (*link->Pack)(n,rootloc+rootoffset[i],rootdata,packstart); 660 ierr = MPI_Isend(packstart,n,unit,rootranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&rootreqs[i]);CHKERRQ(ierr); 661 } 662 PetscFunctionReturn(0); 663 } 664 665 #undef __FUNCT__ 666 #define __FUNCT__ "PetscSFBcastEnd_Basic" 667 PetscErrorCode PetscSFBcastEnd_Basic(PetscSF sf,MPI_Datatype unit,const void *rootdata,void *leafdata) 668 { 669 PetscErrorCode ierr; 670 PetscSFBasicPack link; 671 PetscInt i,nleafranks; 672 const PetscInt *leafoffset,*leafloc; 673 674 PetscFunctionBegin; 675 ierr = PetscSFBasicGetPackInUse(sf,unit,rootdata,PETSC_OWN_POINTER,&link);CHKERRQ(ierr); 676 ierr = PetscSFBasicPackWaitall(sf,link);CHKERRQ(ierr); 677 ierr = PetscSFBasicGetLeafInfo(sf,&nleafranks,NULL,&leafoffset,&leafloc);CHKERRQ(ierr); 678 for (i=0; i<nleafranks; i++) { 679 PetscMPIInt n = leafoffset[i+1] - leafoffset[i]; 680 const void *packstart = link->leaf+leafoffset[i]*link->unitbytes; 681 (*link->UnpackInsert)(n,leafloc+leafoffset[i],leafdata,packstart); 682 } 683 ierr = PetscSFBasicReclaimPack(sf,&link);CHKERRQ(ierr); 684 PetscFunctionReturn(0); 685 } 686 687 #undef __FUNCT__ 688 #define __FUNCT__ "PetscSFReduceBegin_Basic" 689 /* leaf -> root with reduction */ 690 PetscErrorCode PetscSFReduceBegin_Basic(PetscSF sf,MPI_Datatype unit,const void *leafdata,void *rootdata,MPI_Op op) 691 { 692 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 693 PetscSFBasicPack link; 694 PetscErrorCode ierr; 695 PetscInt i,nrootranks,nleafranks; 696 const PetscInt *rootoffset,*leafoffset,*rootloc,*leafloc; 697 const PetscMPIInt *rootranks,*leafranks; 698 MPI_Request *rootreqs,*leafreqs; 699 size_t unitbytes; 700 701 PetscFunctionBegin; 702 ierr = PetscSFBasicGetRootInfo(sf,&nrootranks,&rootranks,&rootoffset,&rootloc);CHKERRQ(ierr); 703 ierr = PetscSFBasicGetLeafInfo(sf,&nleafranks,&leafranks,&leafoffset,&leafloc);CHKERRQ(ierr); 704 ierr = PetscSFBasicGetPack(sf,unit,rootdata,&link);CHKERRQ(ierr); 705 706 unitbytes = link->unitbytes; 707 708 ierr = PetscSFBasicPackGetReqs(sf,link,&rootreqs,&leafreqs);CHKERRQ(ierr); 709 /* Eagerly post root receives */ 710 for (i=0; i<nrootranks; i++) { 711 PetscMPIInt n = rootoffset[i+1] - rootoffset[i]; 712 ierr = MPI_Irecv(link->root+rootoffset[i]*unitbytes,n,unit,rootranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&rootreqs[i]);CHKERRQ(ierr); 713 } 714 /* Pack and send leaf data */ 715 for (i=0; i<nleafranks; i++) { 716 PetscMPIInt n = leafoffset[i+1] - leafoffset[i]; 717 void *packstart = link->leaf+leafoffset[i]*unitbytes; 718 (*link->Pack)(n,leafloc+leafoffset[i],leafdata,packstart); 719 ierr = MPI_Isend(packstart,n,unit,leafranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&leafreqs[i]);CHKERRQ(ierr); 720 } 721 PetscFunctionReturn(0); 722 } 723 724 #undef __FUNCT__ 725 #define __FUNCT__ "PetscSFReduceEnd_Basic" 726 static PetscErrorCode PetscSFReduceEnd_Basic(PetscSF sf,MPI_Datatype unit,const void *leafdata,void *rootdata,MPI_Op op) 727 { 728 void (*UnpackOp)(PetscInt,const PetscInt*,void*,const void*); 729 PetscErrorCode ierr; 730 PetscSFBasicPack link; 731 PetscInt i,nrootranks; 732 const PetscInt *rootoffset,*rootloc; 733 734 PetscFunctionBegin; 735 ierr = PetscSFBasicGetPackInUse(sf,unit,rootdata,PETSC_OWN_POINTER,&link);CHKERRQ(ierr); 736 /* This implementation could be changed to unpack as receives arrive, at the cost of non-determinism */ 737 ierr = PetscSFBasicPackWaitall(sf,link);CHKERRQ(ierr); 738 ierr = PetscSFBasicGetRootInfo(sf,&nrootranks,NULL,&rootoffset,&rootloc);CHKERRQ(ierr); 739 ierr = PetscSFBasicPackGetUnpackOp(sf,link,op,&UnpackOp);CHKERRQ(ierr); 740 for (i=0; i<nrootranks; i++) { 741 PetscMPIInt n = rootoffset[i+1] - rootoffset[i]; 742 const void *packstart = link->root+rootoffset[i]*link->unitbytes; 743 744 (*UnpackOp)(n,rootloc+rootoffset[i],rootdata,packstart); 745 } 746 ierr = PetscSFBasicReclaimPack(sf,&link);CHKERRQ(ierr); 747 PetscFunctionReturn(0); 748 } 749 750 #undef __FUNCT__ 751 #define __FUNCT__ "PetscSFFetchAndOpBegin_Basic" 752 static PetscErrorCode PetscSFFetchAndOpBegin_Basic(PetscSF sf,MPI_Datatype unit,void *rootdata,const void *leafdata,void *leafupdate,MPI_Op op) 753 { 754 PetscErrorCode ierr; 755 756 PetscFunctionBegin; 757 ierr = PetscSFReduceBegin_Basic(sf,unit,leafdata,rootdata,op);CHKERRQ(ierr); 758 PetscFunctionReturn(0); 759 } 760 761 #undef __FUNCT__ 762 #define __FUNCT__ "PetscSFFetchAndOpEnd_Basic" 763 static PetscErrorCode PetscSFFetchAndOpEnd_Basic(PetscSF sf,MPI_Datatype unit,void *rootdata,const void *leafdata,void *leafupdate,MPI_Op op) 764 { 765 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 766 void (*FetchAndOp)(PetscInt,const PetscInt*,void*,void*); 767 PetscErrorCode ierr; 768 PetscSFBasicPack link; 769 PetscInt i,nrootranks,nleafranks; 770 const PetscInt *rootoffset,*leafoffset,*rootloc,*leafloc; 771 const PetscMPIInt *rootranks,*leafranks; 772 MPI_Request *rootreqs,*leafreqs; 773 size_t unitbytes; 774 775 PetscFunctionBegin; 776 ierr = PetscSFBasicGetPackInUse(sf,unit,rootdata,PETSC_OWN_POINTER,&link);CHKERRQ(ierr); 777 /* This implementation could be changed to unpack as receives arrive, at the cost of non-determinism */ 778 ierr = PetscSFBasicPackWaitall(sf,link);CHKERRQ(ierr); 779 unitbytes = link->unitbytes; 780 ierr = PetscSFBasicGetRootInfo(sf,&nrootranks,&rootranks,&rootoffset,&rootloc);CHKERRQ(ierr); 781 ierr = PetscSFBasicGetLeafInfo(sf,&nleafranks,&leafranks,&leafoffset,&leafloc);CHKERRQ(ierr); 782 ierr = PetscSFBasicPackGetReqs(sf,link,&rootreqs,&leafreqs);CHKERRQ(ierr); 783 /* Post leaf receives */ 784 for (i=0; i<nleafranks; i++) { 785 PetscMPIInt n = leafoffset[i+1] - leafoffset[i]; 786 ierr = MPI_Irecv(link->leaf+leafoffset[i]*unitbytes,n,unit,leafranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&leafreqs[i]);CHKERRQ(ierr); 787 } 788 /* Process local fetch-and-op, post root sends */ 789 ierr = PetscSFBasicPackGetFetchAndOp(sf,link,op,&FetchAndOp);CHKERRQ(ierr); 790 for (i=0; i<nrootranks; i++) { 791 PetscMPIInt n = rootoffset[i+1] - rootoffset[i]; 792 void *packstart = link->root+rootoffset[i]*unitbytes; 793 794 (*FetchAndOp)(n,rootloc+rootoffset[i],rootdata,packstart); 795 ierr = MPI_Isend(packstart,n,unit,rootranks[i],bas->tag,PetscObjectComm((PetscObject)sf),&rootreqs[i]);CHKERRQ(ierr); 796 } 797 ierr = PetscSFBasicPackWaitall(sf,link);CHKERRQ(ierr); 798 for (i=0; i<nleafranks; i++) { 799 PetscMPIInt n = leafoffset[i+1] - leafoffset[i]; 800 const void *packstart = link->leaf+leafoffset[i]*unitbytes; 801 (*link->UnpackInsert)(n,leafloc+leafoffset[i],leafupdate,packstart); 802 } 803 ierr = PetscSFBasicReclaimPack(sf,&link);CHKERRQ(ierr); 804 PetscFunctionReturn(0); 805 } 806 807 #undef __FUNCT__ 808 #define __FUNCT__ "PetscSFCreate_Basic" 809 PETSC_EXTERN PetscErrorCode PetscSFCreate_Basic(PetscSF sf) 810 { 811 PetscSF_Basic *bas = (PetscSF_Basic*)sf->data; 812 PetscErrorCode ierr; 813 814 PetscFunctionBegin; 815 sf->ops->SetUp = PetscSFSetUp_Basic; 816 sf->ops->SetFromOptions = PetscSFSetFromOptions_Basic; 817 sf->ops->Reset = PetscSFReset_Basic; 818 sf->ops->Destroy = PetscSFDestroy_Basic; 819 sf->ops->View = PetscSFView_Basic; 820 sf->ops->BcastBegin = PetscSFBcastBegin_Basic; 821 sf->ops->BcastEnd = PetscSFBcastEnd_Basic; 822 sf->ops->ReduceBegin = PetscSFReduceBegin_Basic; 823 sf->ops->ReduceEnd = PetscSFReduceEnd_Basic; 824 sf->ops->FetchAndOpBegin = PetscSFFetchAndOpBegin_Basic; 825 sf->ops->FetchAndOpEnd = PetscSFFetchAndOpEnd_Basic; 826 827 ierr = PetscNewLog(sf,PetscSF_Basic,&bas);CHKERRQ(ierr); 828 sf->data = (void*)bas; 829 PetscFunctionReturn(0); 830 } 831