317{
318 dcomplex *ptrsendbuff, *ptrrecvbuff, *ptrNULL = 0;
321 Int *proc0, *proc1, *param;
322 Int mypnum, myprow0, mypcol0, myprow1, mypcol1,
nprocs;
324 Int nprow, npcol, gcontext;
325 Int recvsize, sendsize;
328 Int hinter_nb, vinter_nb;
332
333
334
335 if (m == 0 ||
n == 0)
336 return;
337 ia -= 1;
338 ja -= 1;
339 ib -= 1;
340 jb -= 1;
342 gcontext = globcontext;
344
345
346
347 if (nprow != 1) {
350 }
352
353 if (myprow0 >= p0 || mypcol0 >= q0)
354 myprow0 = mypcol0 = -1;
355 assert((myprow0 < p0 && mypcol0 < q0) || (myprow0 == -1 && mypcol0 == -1));
357 if (myprow1 >= p1 || mypcol1 >= q1)
358 myprow1 = mypcol1 = -1;
359 assert((myprow1 < p1 && mypcol1 < q1) || (myprow1 == -1 && mypcol1 == -1));
360
361
369
370
371 if (myprow0 >= 0) {
372 proc0[myprow0 * q0 + mypcol0] = mypnum;
373 param[0] = p0;
374 param[1] = q0;
377 param[6] = ma->
nbrow;
378 param[7] = ma->
nbcol;
379 param[8] = ma->
sprow;
380 param[9] = ma->
spcol;
381 param[10] = ia;
382 param[11] = ja;
383 }
384 if (myprow1 >= 0) {
385 proc1[myprow1 * q1 + mypcol1] = mypnum;
386 param[2] = p1;
387 param[3] = q1;
390 param[14] = mb->
nbrow;
391 param[15] = mb->
nbcol;
392 param[16] = mb->
sprow;
393 param[17] = mb->
spcol;
394 param[18] = ib;
395 param[19] = jb;
396 }
399 newa = *ma;
400 newb = *mb;
401 ma = &newa;
402 mb = &newb;
403 if (myprow0 == -1) {
404 p0 = param[0];
405 q0 = param[1];
408 ma->
nbrow = param[6];
409 ma->
nbcol = param[7];
410 ma->
sprow = param[8];
411 ma->
spcol = param[9];
412 ia = param[10];
413 ja = param[11];
414 }
415 if (myprow1 == -1) {
416 p1 = param[2];
417 q1 = param[3];
420 mb->
nbrow = param[14];
421 mb->
nbcol = param[15];
422 mb->
sprow = param[16];
423 mb->
spcol = param[17];
424 ib = param[18];
425 jb = param[19];
426 }
427 for (i = 0; i <
NBPARAM; i++) {
429 fprintf(stderr, "xxGEMR2D:something wrong in the parameters\n");
430 exit(1);
431 }
432 }
433#ifndef NDEBUG
434 for (i = 0; i < p0 * q0; i++)
435 assert(proc0[i] >= 0 && proc0[i] < nprocs);
436 for (i = 0; i < p1 * q1; i++)
437 assert(proc1[i] >= 0 && proc1[i] < nprocs);
438#endif
439
442
443 {
447 ptrmyblock += decal;
450 ptrmyblock += decal * ma->
lda;
455 ptrmynewblock += decal;
458 ptrmynewblock += decal * mb->
lda;
461 if (p0 == 1)
463 if (q0 == 1)
465 if (p1 == 1)
467 if (q1 == 1)
469#ifndef NDEBUG
472#endif
473 }
474
475
476 if (myprow0 >= 0 && mypcol0 >= 0) {
477
479 };
480 if (myprow1 >= 0 && mypcol1 >= 0) {
481
483 };
484
485
486
491
492
493
494
495
496 recvptr = ptrrecvbuff;
497 {
498 Int tot, myrang, step, sens;
499 Int *sender, *recver;
500 Int mesending, merecving;
501 tot =
max(p0 * q0, p1 * q1);
502 init_chenille(mypnum, nprocs, p0 * q0, proc0, p1 * q1, proc1,
503 &sender, &recver, &myrang);
504 if (myrang == -1)
505 goto after_comm;
506 mesending = myprow0 >= 0;
507 assert(sender[myrang] >= 0 || !mesending);
508 assert(!mesending || proc0[sender[myrang]] == mypnum);
509 merecving = myprow1 >= 0;
510 assert(recver[myrang] >= 0 || !merecving);
511 assert(!merecving || proc1[recver[myrang]] == mypnum);
512 step = tot - 1 - myrang;
513 do {
514 for (sens = 0; sens < 2; sens++) {
515
516
517 if (mesending && recver[step] >= 0 &&
518 (sens == 0)) {
519 i = recver[step] / q1;
520 j = recver[step] % q1;
521 vinter_nb =
scan_intervals(
'r', ia, ib, m, ma, mb, p0, p1, myprow0, i,
522 v_inter);
523 hinter_nb =
scan_intervals(
'c', ja, jb,
n, ma, mb, q0, q1, mypcol0, j,
524 h_inter);
526 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
527 v_inter, vinter_nb, h_inter, hinter_nb,
528 ptrmyblock);
529 }
530 if (mesending && recver[step] >= 0 &&
531 (sens == myrang > step)) {
532 i = recver[step] / q1;
533 j = recver[step] % q1;
534 if (sendsize > 0
535 && (step != myrang || !merecving)
536 ) {
537 Czgesd2d(gcontext, sendsize, (
Int)1, ptrsendbuff, sendsize,
538 (
Int)0, proc1[i * q1 + j]);
539 }
540 }
541 if (merecving && sender[step] >= 0 &&
542 (sens == myrang <= step)) {
543 i = sender[step] / q0;
544 j = sender[step] % q0;
545 vinter_nb =
scan_intervals(
'r', ib, ia, m, mb, ma, p1, p0, myprow1, i,
546 v_inter);
547 hinter_nb =
scan_intervals(
'c', jb, ja,
n, mb, ma, q1, q0, mypcol1, j,
548 h_inter);
550 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
551 v_inter, vinter_nb, h_inter, hinter_nb, ptrNULL);
552 if (recvsize > 0) {
553 if (step == myrang && mesending) {
555 ptrsendbuff, recvsize,
556 ptrrecvbuff, recvsize);
557 } else {
558 Czgerv2d(gcontext, recvsize, (
Int)1, ptrrecvbuff, recvsize,
559 (
Int)0, proc0[i * q0 + j]);
560 }
561 }
562 }
563 if (merecving && sender[step] >= 0 && sens == 1) {
565 m,
n, ma, ia, ja, p0, q0, mb, ib, jb, p1, q1,
566 v_inter, vinter_nb, h_inter, hinter_nb, ptrmynewblock);
567 }
568 }
569 step -= 1;
570 if (step < 0)
571 step = tot - 1;
572 } while (step != tot - 1 - myrang);
573after_comm:
574 free(sender);
575 }
576
577 if (myprow1 >= 0 && mypcol1 >= 0) {
579 };
580 if (myprow0 >= 0 && mypcol0 >= 0) {
582 };
583 if (nprow != 1)
585 free(v_inter);
586 free(h_inter);
587 free(param);
integer, save, private nprocs
static2 void gridreshape()
static2 void init_chenille()
1.15.0