314{
315 Int *ptrsendbuff, *ptrrecvbuff, *ptrNULL = 0;
318 Int *proc0, *proc1, *param;
319 Int mypnum, myprow0, mypcol0, myprow1, mypcol1,
nprocs;
321 Int nprow, npcol, gcontext;
322 Int recvsize, sendsize;
325 Int hinter_nb, vinter_nb;
329
330
331
332 if (m == 0 ||
n == 0)
333 return;
334 ia -= 1;
335 ja -= 1;
336 ib -= 1;
337 jb -= 1;
339 gcontext = globcontext;
341
342
343
344 if (nprow != 1) {
347 }
349
350 if (myprow0 >= p0 || mypcol0 >= q0)
351 myprow0 = mypcol0 = -1;
352 assert((myprow0 < p0 && mypcol0 < q0) || (myprow0 == -1 && mypcol0 == -1));
354 if (myprow1 >= p1 || mypcol1 >= q1)
355 myprow1 = mypcol1 = -1;
356 assert((myprow1 < p1 && mypcol1 < q1) || (myprow1 == -1 && mypcol1 == -1));
357
358
366
367
368 if (myprow0 >= 0) {
369 proc0[myprow0 * q0 + mypcol0] = mypnum;
370 param[0] = p0;
371 param[1] = q0;
374 param[6] = ma->
nbrow;
375 param[7] = ma->
nbcol;
376 param[8] = ma->
sprow;
377 param[9] = ma->
spcol;
378 param[10] = ia;
379 param[11] = ja;
380 }
381 if (myprow1 >= 0) {
382 proc1[myprow1 * q1 + mypcol1] = mypnum;
383 param[2] = p1;
384 param[3] = q1;
387 param[14] = mb->
nbrow;
388 param[15] = mb->
nbcol;
389 param[16] = mb->
sprow;
390 param[17] = mb->
spcol;
391 param[18] = ib;
392 param[19] = jb;
393 }
396 newa = *ma;
397 newb = *mb;
398 ma = &newa;
399 mb = &newb;
400 if (myprow0 == -1) {
401 p0 = param[0];
402 q0 = param[1];
405 ma->
nbrow = param[6];
406 ma->
nbcol = param[7];
407 ma->
sprow = param[8];
408 ma->
spcol = param[9];
409 ia = param[10];
410 ja = param[11];
411 }
412 if (myprow1 == -1) {
413 p1 = param[2];
414 q1 = param[3];
417 mb->
nbrow = param[14];
418 mb->
nbcol = param[15];
419 mb->
sprow = param[16];
420 mb->
spcol = param[17];
421 ib = param[18];
422 jb = param[19];
423 }
424 for (i = 0; i <
NBPARAM; i++) {
426 fprintf(stderr, "xxGEMR2D:something wrong in the parameters\n");
427 exit(1);
428 }
429 }
430#ifndef NDEBUG
431 for (i = 0; i < p0 * q0; i++)
432 assert(proc0[i] >= 0 && proc0[i] < nprocs);
433 for (i = 0; i < p1 * q1; i++)
434 assert(proc1[i] >= 0 && proc1[i] < nprocs);
435#endif
436
439
440 {
444 ptrmyblock += decal;
447 ptrmyblock += decal * ma->
lda;
452 ptrmynewblock += decal;
455 ptrmynewblock += decal * mb->
lda;
458 if (p0 == 1)
460 if (q0 == 1)
462 if (p1 == 1)
464 if (q1 == 1)
466#ifndef NDEBUG
469#endif
470 }
471
472
473 if (myprow0 >= 0 && mypcol0 >= 0) {
474
476 };
477 if (myprow1 >= 0 && mypcol1 >= 0) {
478
480 };
481
482
483
488
489
490
491
492
493 recvptr = ptrrecvbuff;
494 {
495 Int tot, myrang, step, sens;
496 Int *sender, *recver;
497 Int mesending, merecving;
498 tot =
max(p0 * q0, p1 * q1);
499 init_chenille(mypnum, nprocs, p0 * q0, proc0, p1 * q1, proc1,
500 &sender, &recver, &myrang);
501 if (myrang == -1)
502 goto after_comm;
503 mesending = myprow0 >= 0;
504 assert(sender[myrang] >= 0 || !mesending);
505 assert(!mesending || proc0[sender[myrang]] == mypnum);
506 merecving = myprow1 >= 0;
507 assert(recver[myrang] >= 0 || !merecving);
508 assert(!merecving || proc1[recver[myrang]] == mypnum);
509 step = tot - 1 - myrang;
510 do {
511 for (sens = 0; sens < 2; sens++) {
512
513
514 if (mesending && recver[step] >= 0 &&
515 (sens == 0)) {
516 i = recver[step] / q1;
517 j = recver[step] % q1;
518 vinter_nb =
scan_intervals(
'r', ia, ib, m, ma, mb, p0, p1, myprow0, i,
519 v_inter);
520 hinter_nb =
scan_intervals(
'c', ja, jb,
n, ma, mb, q0, q1, mypcol0, j,
521 h_inter);
523 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
524 v_inter, vinter_nb, h_inter, hinter_nb,
525 ptrmyblock);
526 }
527 if (mesending && recver[step] >= 0 &&
528 (sens == myrang > step)) {
529 i = recver[step] / q1;
530 j = recver[step] % q1;
531 if (sendsize > 0
532 && (step != myrang || !merecving)
533 ) {
534 Cigesd2d(gcontext, sendsize, (
Int)1, ptrsendbuff, sendsize,
535 (
Int)0, proc1[i * q1 + j]);
536 }
537 }
538 if (merecving && sender[step] >= 0 &&
539 (sens == myrang <= step)) {
540 i = sender[step] / q0;
541 j = sender[step] % q0;
542 vinter_nb =
scan_intervals(
'r', ib, ia, m, mb, ma, p1, p0, myprow1, i,
543 v_inter);
544 hinter_nb =
scan_intervals(
'c', jb, ja,
n, mb, ma, q1, q0, mypcol1, j,
545 h_inter);
547 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
548 v_inter, vinter_nb, h_inter, hinter_nb, ptrNULL);
549 if (recvsize > 0) {
550 if (step == myrang && mesending) {
552 ptrsendbuff, recvsize,
553 ptrrecvbuff, recvsize);
554 } else {
555 Cigerv2d(gcontext, recvsize, (
Int)1, ptrrecvbuff, recvsize,
556 (
Int)0, proc0[i * q0 + j]);
557 }
558 }
559 }
560 if (merecving && sender[step] >= 0 && sens == 1) {
562 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
563 v_inter, vinter_nb, h_inter, hinter_nb, ptrmynewblock);
564 }
565 }
566 step -= 1;
567 if (step < 0)
568 step = tot - 1;
569 } while (step != tot - 1 - myrang);
570after_comm:
571 free(sender);
572 }
573
574 if (myprow1 >= 0 && mypcol1 >= 0) {
576 };
577 if (myprow0 >= 0 && mypcol0 >= 0) {
579 };
580 if (nprow != 1)
582 free(v_inter);
583 free(h_inter);
584 free(param);
integer, save, private nprocs
static2 void gridreshape()
static2 void init_chenille()
1.15.0