1 #define PETSCKSP_DLL 2 3 /***********************************comm.c************************************* 4 5 Author: Henry M. Tufo III 6 7 e-mail: hmt@cs.brown.edu 8 9 snail-mail: 10 Division of Applied Mathematics 11 Brown University 12 Providence, RI 02912 13 14 Last Modification: 15 11.21.97 16 ***********************************comm.c*************************************/ 17 #include "src/ksp/pc/impls/tfs/tfs.h" 18 19 20 /* global program control variables - explicitly exported */ 21 PetscMPIInt my_id = 0; 22 PetscMPIInt num_nodes = 1; 23 PetscMPIInt floor_num_nodes = 0; 24 PetscMPIInt i_log2_num_nodes = 0; 25 26 /* global program control variables */ 27 static PetscInt p_init = 0; 28 static PetscInt modfl_num_nodes; 29 static PetscInt edge_not_pow_2; 30 31 static PetscInt edge_node[sizeof(PetscInt)*32]; 32 33 /***********************************comm.c*************************************/ 34 PetscErrorCode comm_init (void) 35 { 36 37 if (p_init++) PetscFunctionReturn(0); 38 39 MPI_Comm_size(MPI_COMM_WORLD,&num_nodes); 40 MPI_Comm_rank(MPI_COMM_WORLD,&my_id); 41 42 if (num_nodes> (INT_MAX >> 1)) 43 {SETERRQ(PETSC_ERR_PLIB,"Can't have more then MAX_INT/2 nodes!!!");} 44 45 ivec_zero((PetscInt*)edge_node,sizeof(PetscInt)*32); 46 47 floor_num_nodes = 1; 48 i_log2_num_nodes = modfl_num_nodes = 0; 49 while (floor_num_nodes <= num_nodes) 50 { 51 edge_node[i_log2_num_nodes] = my_id ^ floor_num_nodes; 52 floor_num_nodes <<= 1; 53 i_log2_num_nodes++; 54 } 55 56 i_log2_num_nodes--; 57 floor_num_nodes >>= 1; 58 modfl_num_nodes = (num_nodes - floor_num_nodes); 59 60 if ((my_id > 0) && (my_id <= modfl_num_nodes)) 61 {edge_not_pow_2=((my_id|floor_num_nodes)-1);} 62 else if (my_id >= floor_num_nodes) 63 {edge_not_pow_2=((my_id^floor_num_nodes)+1); 64 } 65 else 66 {edge_not_pow_2 = 0;} 67 PetscFunctionReturn(0); 68 } 69 70 /***********************************comm.c*************************************/ 71 PetscErrorCode giop(PetscInt *vals, PetscInt *work, PetscInt n, PetscInt *oprs) 72 { 73 PetscInt mask, edge; 74 PetscInt type, dest; 75 vfp fp; 76 MPI_Status status; 77 PetscInt ierr; 78 79 PetscFunctionBegin; 80 /* ok ... should have some data, work, and operator(s) */ 81 if (!vals||!work||!oprs) 82 {SETERRQ3(PETSC_ERR_PLIB,"giop() :: vals=%D, work=%D, oprs=%D",vals,work,oprs);} 83 84 /* non-uniform should have at least two entries */ 85 if ((oprs[0] == NON_UNIFORM)&&(n<2)) 86 {SETERRQ(PETSC_ERR_PLIB,"giop() :: non_uniform and n=0,1?");} 87 88 /* check to make sure comm package has been initialized */ 89 if (!p_init) 90 {comm_init();} 91 92 /* if there's nothing to do return */ 93 if ((num_nodes<2)||(!n)) 94 { 95 PetscFunctionReturn(0); 96 } 97 98 /* a negative number if items to send ==> fatal */ 99 if (n<0) 100 {SETERRQ1(PETSC_ERR_PLIB,"giop() :: n=%D<0?",n);} 101 102 /* advance to list of n operations for custom */ 103 if ((type=oprs[0])==NON_UNIFORM) 104 {oprs++;} 105 106 /* major league hack */ 107 if (!(fp = (vfp) ivec_fct_addr(type))) { 108 ierr = PetscInfo(0,"giop() :: hope you passed in a rbfp!\n");CHKERRQ(ierr); 109 fp = (vfp) oprs; 110 } 111 112 /* all msgs will be of the same length */ 113 /* if not a hypercube must colapse partial dim */ 114 if (edge_not_pow_2) 115 { 116 if (my_id >= floor_num_nodes) 117 {ierr = MPI_Send(vals,n,MPIU_INT,edge_not_pow_2,MSGTAG0+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 118 else 119 { 120 ierr = MPI_Recv(work,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG0+edge_not_pow_2, MPI_COMM_WORLD,&status);CHKERRQ(ierr); 121 (*fp)(vals,work,n,oprs); 122 } 123 } 124 125 /* implement the mesh fan in/out exchange algorithm */ 126 if (my_id<floor_num_nodes) 127 { 128 for (mask=1,edge=0; edge<i_log2_num_nodes; edge++,mask<<=1) 129 { 130 dest = my_id^mask; 131 if (my_id > dest) 132 {ierr = MPI_Send(vals,n,MPIU_INT,dest,MSGTAG2+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 133 else 134 { 135 ierr = MPI_Recv(work,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG2+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 136 (*fp)(vals, work, n, oprs); 137 } 138 } 139 140 mask=floor_num_nodes>>1; 141 for (edge=0; edge<i_log2_num_nodes; edge++,mask>>=1) 142 { 143 if (my_id%mask) 144 {continue;} 145 146 dest = my_id^mask; 147 if (my_id < dest) 148 {ierr = MPI_Send(vals,n,MPIU_INT,dest,MSGTAG4+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 149 else 150 { 151 ierr = MPI_Recv(vals,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG4+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 152 } 153 } 154 } 155 156 /* if not a hypercube must expand to partial dim */ 157 if (edge_not_pow_2) 158 { 159 if (my_id >= floor_num_nodes) 160 { 161 ierr = MPI_Recv(vals,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG5+edge_not_pow_2,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 162 } 163 else 164 {ierr = MPI_Send(vals,n,MPIU_INT,edge_not_pow_2,MSGTAG5+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 165 } 166 PetscFunctionReturn(0); 167 } 168 169 /***********************************comm.c*************************************/ 170 PetscErrorCode grop(PetscScalar *vals, PetscScalar *work, PetscInt n, PetscInt *oprs) 171 { 172 PetscInt mask, edge; 173 PetscInt type, dest; 174 vfp fp; 175 MPI_Status status; 176 PetscErrorCode ierr; 177 178 PetscFunctionBegin; 179 /* ok ... should have some data, work, and operator(s) */ 180 if (!vals||!work||!oprs) 181 {SETERRQ3(PETSC_ERR_PLIB,"grop() :: vals=%D, work=%D, oprs=%D",vals,work,oprs);} 182 183 /* non-uniform should have at least two entries */ 184 if ((oprs[0] == NON_UNIFORM)&&(n<2)) 185 {SETERRQ(PETSC_ERR_PLIB,"grop() :: non_uniform and n=0,1?");} 186 187 /* check to make sure comm package has been initialized */ 188 if (!p_init) 189 {comm_init();} 190 191 /* if there's nothing to do return */ 192 if ((num_nodes<2)||(!n)) 193 { PetscFunctionReturn(0);} 194 195 /* a negative number of items to send ==> fatal */ 196 if (n<0) 197 {SETERRQ1(PETSC_ERR_PLIB,"gdop() :: n=%D<0?",n);} 198 199 /* advance to list of n operations for custom */ 200 if ((type=oprs[0])==NON_UNIFORM) 201 {oprs++;} 202 203 if (!(fp = (vfp) rvec_fct_addr(type))) { 204 ierr = PetscInfo(0,"grop() :: hope you passed in a rbfp!\n");CHKERRQ(ierr); 205 fp = (vfp) oprs; 206 } 207 208 /* all msgs will be of the same length */ 209 /* if not a hypercube must colapse partial dim */ 210 if (edge_not_pow_2) 211 { 212 if (my_id >= floor_num_nodes) 213 {ierr = MPI_Send(vals,n,MPIU_SCALAR,edge_not_pow_2,MSGTAG0+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 214 else 215 { 216 ierr = MPI_Recv(work,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG0+edge_not_pow_2,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 217 (*fp)(vals,work,n,oprs); 218 } 219 } 220 221 /* implement the mesh fan in/out exchange algorithm */ 222 if (my_id<floor_num_nodes) 223 { 224 for (mask=1,edge=0; edge<i_log2_num_nodes; edge++,mask<<=1) 225 { 226 dest = my_id^mask; 227 if (my_id > dest) 228 {ierr = MPI_Send(vals,n,MPIU_SCALAR,dest,MSGTAG2+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 229 else 230 { 231 ierr = MPI_Recv(work,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG2+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 232 (*fp)(vals, work, n, oprs); 233 } 234 } 235 236 mask=floor_num_nodes>>1; 237 for (edge=0; edge<i_log2_num_nodes; edge++,mask>>=1) 238 { 239 if (my_id%mask) 240 {continue;} 241 242 dest = my_id^mask; 243 if (my_id < dest) 244 {ierr = MPI_Send(vals,n,MPIU_SCALAR,dest,MSGTAG4+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 245 else 246 { 247 ierr = MPI_Recv(vals,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG4+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 248 } 249 } 250 } 251 252 /* if not a hypercube must expand to partial dim */ 253 if (edge_not_pow_2) 254 { 255 if (my_id >= floor_num_nodes) 256 { 257 ierr = MPI_Recv(vals,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG5+edge_not_pow_2, MPI_COMM_WORLD,&status);CHKERRQ(ierr); 258 } 259 else 260 {ierr = MPI_Send(vals,n,MPIU_SCALAR,edge_not_pow_2,MSGTAG5+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 261 } 262 PetscFunctionReturn(0); 263 } 264 265 /***********************************comm.c*************************************/ 266 PetscErrorCode grop_hc(PetscScalar *vals, PetscScalar *work, PetscInt n, PetscInt *oprs, PetscInt dim) 267 { 268 PetscInt mask, edge; 269 PetscInt type, dest; 270 vfp fp; 271 MPI_Status status; 272 PetscErrorCode ierr; 273 274 PetscFunctionBegin; 275 /* ok ... should have some data, work, and operator(s) */ 276 if (!vals||!work||!oprs) 277 {SETERRQ3(PETSC_ERR_PLIB,"grop_hc() :: vals=%D, work=%D, oprs=%D",vals,work,oprs);} 278 279 /* non-uniform should have at least two entries */ 280 if ((oprs[0] == NON_UNIFORM)&&(n<2)) 281 {SETERRQ(PETSC_ERR_PLIB,"grop_hc() :: non_uniform and n=0,1?");} 282 283 /* check to make sure comm package has been initialized */ 284 if (!p_init) 285 {comm_init();} 286 287 /* if there's nothing to do return */ 288 if ((num_nodes<2)||(!n)||(dim<=0)) 289 {PetscFunctionReturn(0);} 290 291 /* the error msg says it all!!! */ 292 if (modfl_num_nodes) 293 {SETERRQ(PETSC_ERR_PLIB,"grop_hc() :: num_nodes not a power of 2!?!");} 294 295 /* a negative number of items to send ==> fatal */ 296 if (n<0) 297 {SETERRQ1(PETSC_ERR_PLIB,"grop_hc() :: n=%D<0?",n);} 298 299 /* can't do more dimensions then exist */ 300 dim = PetscMin(dim,i_log2_num_nodes); 301 302 /* advance to list of n operations for custom */ 303 if ((type=oprs[0])==NON_UNIFORM) 304 {oprs++;} 305 306 if (!(fp = (vfp) rvec_fct_addr(type))) { 307 ierr = PetscInfo(0,"grop_hc() :: hope you passed in a rbfp!\n");CHKERRQ(ierr); 308 fp = (vfp) oprs; 309 } 310 311 for (mask=1,edge=0; edge<dim; edge++,mask<<=1) 312 { 313 dest = my_id^mask; 314 if (my_id > dest) 315 {ierr = MPI_Send(vals,n,MPIU_SCALAR,dest,MSGTAG2+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 316 else 317 { 318 ierr = MPI_Recv(work,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG2+dest,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 319 (*fp)(vals, work, n, oprs); 320 } 321 } 322 323 if (edge==dim) 324 {mask>>=1;} 325 else 326 {while (++edge<dim) {mask<<=1;}} 327 328 for (edge=0; edge<dim; edge++,mask>>=1) 329 { 330 if (my_id%mask) 331 {continue;} 332 333 dest = my_id^mask; 334 if (my_id < dest) 335 {ierr = MPI_Send(vals,n,MPIU_SCALAR,dest,MSGTAG4+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 336 else 337 { 338 ierr = MPI_Recv(vals,n,MPIU_SCALAR,MPI_ANY_SOURCE,MSGTAG4+dest,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 339 } 340 } 341 PetscFunctionReturn(0); 342 } 343 344 /***********************************comm.c*************************************/ 345 PetscErrorCode gfop(void *vals, void *work, PetscInt n, vbfp fp, MPI_Datatype dt) 346 { 347 PetscInt mask, edge; 348 PetscInt dest; 349 MPI_Status status; 350 MPI_Op op; 351 PetscErrorCode ierr; 352 353 PetscFunctionBegin; 354 /* check to make sure comm package has been initialized */ 355 if (!p_init) 356 {comm_init();} 357 358 /* ok ... should have some data, work, and operator(s) */ 359 if (!vals||!work||!fp) 360 {SETERRQ3(PETSC_ERR_PLIB,"gop() :: v=%D, w=%D, f=%D",vals,work,fp);} 361 362 /* if there's nothing to do return */ 363 if ((num_nodes<2)||(!n)) 364 {PetscFunctionReturn(0);} 365 366 /* a negative number of items to send ==> fatal */ 367 if (n<0) 368 {SETERRQ1(PETSC_ERR_PLIB,"gop() :: n=%D<0?",n);} 369 370 ierr = MPI_Op_create(fp,TRUE,&op);CHKERRQ(ierr); 371 ierr = MPI_Allreduce (vals, work, n, dt, op, MPI_COMM_WORLD);CHKERRQ(ierr); 372 ierr = MPI_Op_free(&op);CHKERRQ(ierr); 373 374 375 /* if not a hypercube must colapse partial dim */ 376 if (edge_not_pow_2) 377 { 378 if (my_id >= floor_num_nodes) 379 {ierr = MPI_Send(vals,n,dt,edge_not_pow_2,MSGTAG0+my_id, MPI_COMM_WORLD);CHKERRQ(ierr);} 380 else 381 { 382 ierr = MPI_Recv(work,n,dt,MPI_ANY_SOURCE,MSGTAG0+edge_not_pow_2,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 383 (*fp)(vals,work,&n,&dt); 384 } 385 } 386 387 /* implement the mesh fan in/out exchange algorithm */ 388 if (my_id<floor_num_nodes) 389 { 390 for (mask=1,edge=0; edge<i_log2_num_nodes; edge++,mask<<=1) 391 { 392 dest = my_id^mask; 393 if (my_id > dest) 394 {ierr = MPI_Send(vals,n,dt,dest,MSGTAG2+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 395 else 396 { 397 ierr = MPI_Recv(work,n,dt,MPI_ANY_SOURCE,MSGTAG2+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 398 (*fp)(vals, work, &n, &dt); 399 } 400 } 401 402 mask=floor_num_nodes>>1; 403 for (edge=0; edge<i_log2_num_nodes; edge++,mask>>=1) 404 { 405 if (my_id%mask) 406 {continue;} 407 408 dest = my_id^mask; 409 if (my_id < dest) 410 {ierr = MPI_Send(vals,n,dt,dest,MSGTAG4+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 411 else 412 { 413 ierr = MPI_Recv(vals,n,dt,MPI_ANY_SOURCE,MSGTAG4+dest, MPI_COMM_WORLD, &status);CHKERRQ(ierr); 414 } 415 } 416 } 417 /* if not a hypercube must expand to partial dim */ 418 if (edge_not_pow_2) 419 { 420 if (my_id >= floor_num_nodes) 421 { 422 ierr = MPI_Recv(vals,n,dt,MPI_ANY_SOURCE,MSGTAG5+edge_not_pow_2, MPI_COMM_WORLD,&status);CHKERRQ(ierr); 423 } 424 else 425 {ierr = MPI_Send(vals,n,dt,edge_not_pow_2,MSGTAG5+my_id, MPI_COMM_WORLD);CHKERRQ(ierr);} 426 } 427 PetscFunctionReturn(0); 428 } 429 430 /******************************************************************************/ 431 PetscErrorCode ssgl_radd( PetscScalar *vals, PetscScalar *work, PetscInt level, PetscInt *segs) 432 { 433 PetscInt edge, type, dest, mask; 434 PetscInt stage_n; 435 MPI_Status status; 436 PetscErrorCode ierr; 437 438 PetscFunctionBegin; 439 /* check to make sure comm package has been initialized */ 440 if (!p_init) 441 {comm_init();} 442 443 444 /* all msgs are *NOT* the same length */ 445 /* implement the mesh fan in/out exchange algorithm */ 446 for (mask=0, edge=0; edge<level; edge++, mask++) 447 { 448 stage_n = (segs[level] - segs[edge]); 449 if (stage_n && !(my_id & mask)) 450 { 451 dest = edge_node[edge]; 452 type = MSGTAG3 + my_id + (num_nodes*edge); 453 if (my_id>dest) 454 {ierr = MPI_Send(vals+segs[edge],stage_n,MPIU_SCALAR,dest,type, MPI_COMM_WORLD);CHKERRQ(ierr);} 455 else 456 { 457 type = type - my_id + dest; 458 ierr = MPI_Recv(work,stage_n,MPIU_SCALAR,MPI_ANY_SOURCE,type,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 459 rvec_add(vals+segs[edge], work, stage_n); 460 } 461 } 462 mask <<= 1; 463 } 464 mask>>=1; 465 for (edge=0; edge<level; edge++) 466 { 467 stage_n = (segs[level] - segs[level-1-edge]); 468 if (stage_n && !(my_id & mask)) 469 { 470 dest = edge_node[level-edge-1]; 471 type = MSGTAG6 + my_id + (num_nodes*edge); 472 if (my_id<dest) 473 {ierr = MPI_Send(vals+segs[level-1-edge],stage_n,MPIU_SCALAR,dest,type,MPI_COMM_WORLD);CHKERRQ(ierr);} 474 else 475 { 476 type = type - my_id + dest; 477 ierr = MPI_Recv(vals+segs[level-1-edge],stage_n,MPIU_SCALAR, MPI_ANY_SOURCE,type,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 478 } 479 } 480 mask >>= 1; 481 } 482 PetscFunctionReturn(0); 483 } 484 485 /******************************************************************************/ 486 PetscErrorCode new_ssgl_radd( PetscScalar *vals, PetscScalar *work, PetscInt level, PetscInt *segs) 487 { 488 PetscInt edge, type, dest, mask; 489 PetscInt stage_n; 490 MPI_Status status; 491 PetscErrorCode ierr; 492 493 PetscFunctionBegin; 494 /* check to make sure comm package has been initialized */ 495 if (!p_init) 496 {comm_init();} 497 498 /* all msgs are *NOT* the same length */ 499 /* implement the mesh fan in/out exchange algorithm */ 500 for (mask=0, edge=0; edge<level; edge++, mask++) 501 { 502 stage_n = (segs[level] - segs[edge]); 503 if (stage_n && !(my_id & mask)) 504 { 505 dest = edge_node[edge]; 506 type = MSGTAG3 + my_id + (num_nodes*edge); 507 if (my_id>dest) 508 {ierr = MPI_Send(vals+segs[edge],stage_n,MPIU_SCALAR,dest,type, MPI_COMM_WORLD);CHKERRQ(ierr);} 509 else 510 { 511 type = type - my_id + dest; 512 ierr = MPI_Recv(work,stage_n,MPIU_SCALAR,MPI_ANY_SOURCE,type, MPI_COMM_WORLD,&status);CHKERRQ(ierr); 513 rvec_add(vals+segs[edge], work, stage_n); 514 } 515 } 516 mask <<= 1; 517 } 518 mask>>=1; 519 for (edge=0; edge<level; edge++) 520 { 521 stage_n = (segs[level] - segs[level-1-edge]); 522 if (stage_n && !(my_id & mask)) 523 { 524 dest = edge_node[level-edge-1]; 525 type = MSGTAG6 + my_id + (num_nodes*edge); 526 if (my_id<dest) 527 {ierr = MPI_Send(vals+segs[level-1-edge],stage_n,MPIU_SCALAR,dest,type,MPI_COMM_WORLD);CHKERRQ(ierr);} 528 else 529 { 530 type = type - my_id + dest; 531 ierr = MPI_Recv(vals+segs[level-1-edge],stage_n,MPIU_SCALAR, MPI_ANY_SOURCE,type,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 532 } 533 } 534 mask >>= 1; 535 } 536 PetscFunctionReturn(0); 537 } 538 539 /***********************************comm.c*************************************/ 540 PetscErrorCode giop_hc(PetscInt *vals, PetscInt *work, PetscInt n, PetscInt *oprs, PetscInt dim) 541 { 542 PetscInt mask, edge; 543 PetscInt type, dest; 544 vfp fp; 545 MPI_Status status; 546 PetscErrorCode ierr; 547 548 PetscFunctionBegin; 549 /* ok ... should have some data, work, and operator(s) */ 550 if (!vals||!work||!oprs) 551 {SETERRQ3(PETSC_ERR_PLIB,"giop_hc() :: vals=%D, work=%D, oprs=%D",vals,work,oprs);} 552 553 /* non-uniform should have at least two entries */ 554 if ((oprs[0] == NON_UNIFORM)&&(n<2)) 555 {SETERRQ(PETSC_ERR_PLIB,"giop_hc() :: non_uniform and n=0,1?");} 556 557 /* check to make sure comm package has been initialized */ 558 if (!p_init) 559 {comm_init();} 560 561 /* if there's nothing to do return */ 562 if ((num_nodes<2)||(!n)||(dim<=0)) 563 { PetscFunctionReturn(0);} 564 565 /* the error msg says it all!!! */ 566 if (modfl_num_nodes) 567 {SETERRQ(PETSC_ERR_PLIB,"giop_hc() :: num_nodes not a power of 2!?!");} 568 569 /* a negative number of items to send ==> fatal */ 570 if (n<0) 571 {SETERRQ1(PETSC_ERR_PLIB,"giop_hc() :: n=%D<0?",n);} 572 573 /* can't do more dimensions then exist */ 574 dim = PetscMin(dim,i_log2_num_nodes); 575 576 /* advance to list of n operations for custom */ 577 if ((type=oprs[0])==NON_UNIFORM) 578 {oprs++;} 579 580 if (!(fp = (vfp) ivec_fct_addr(type))){ 581 ierr = PetscInfo(0,"giop_hc() :: hope you passed in a rbfp!\n");CHKERRQ(ierr); 582 fp = (vfp) oprs; 583 } 584 585 for (mask=1,edge=0; edge<dim; edge++,mask<<=1) 586 { 587 dest = my_id^mask; 588 if (my_id > dest) 589 {ierr = MPI_Send(vals,n,MPIU_INT,dest,MSGTAG2+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 590 else 591 { 592 ierr = MPI_Recv(work,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG2+dest,MPI_COMM_WORLD, &status);CHKERRQ(ierr); 593 (*fp)(vals, work, n, oprs); 594 } 595 } 596 597 if (edge==dim) 598 {mask>>=1;} 599 else 600 {while (++edge<dim) {mask<<=1;}} 601 602 for (edge=0; edge<dim; edge++,mask>>=1) 603 { 604 if (my_id%mask) 605 {continue;} 606 607 dest = my_id^mask; 608 if (my_id < dest) 609 {ierr = MPI_Send(vals,n,MPIU_INT,dest,MSGTAG4+my_id,MPI_COMM_WORLD);CHKERRQ(ierr);} 610 else 611 { 612 ierr = MPI_Recv(vals,n,MPIU_INT,MPI_ANY_SOURCE,MSGTAG4+dest,MPI_COMM_WORLD,&status);CHKERRQ(ierr); 613 } 614 } 615 PetscFunctionReturn(0); 616 } 617