300{
301 dcomplex *ptrsendbuff, *ptrrecvbuff, *ptrNULL = 0;
304 Int *proc0, *proc1, *param;
305 Int mypnum, myprow0, mypcol0, myprow1, mypcol1,
nprocs;
307 Int nprow, npcol, gcontext;
308 Int recvsize, sendsize;
311 Int hinter_nb, vinter_nb;
315
316
317
318 if (m == 0 ||
n == 0)
319 return;
320 ia -= 1;
321 ja -= 1;
322 ib -= 1;
323 jb -= 1;
325 gcontext = globcontext;
327
328
329
330 if (nprow != 1) {
333 }
335
336 if (myprow0 >= p0 || mypcol0 >= q0)
337 myprow0 = mypcol0 = -1;
338 assert((myprow0 < p0 && mypcol0 < q0) || (myprow0 == -1 && mypcol0 == -1));
340 if (myprow1 >= p1 || mypcol1 >= q1)
341 myprow1 = mypcol1 = -1;
342 assert((myprow1 < p1 && mypcol1 < q1) || (myprow1 == -1 && mypcol1 == -1));
343
344
352
353
354 if (myprow0 >= 0) {
355 proc0[myprow0 * q0 + mypcol0] = mypnum;
356 param[0] = p0;
357 param[1] = q0;
360 param[6] = ma->
nbrow;
361 param[7] = ma->
nbcol;
362 param[8] = ma->
sprow;
363 param[9] = ma->
spcol;
364 param[10] = ia;
365 param[11] = ja;
366 }
367 if (myprow1 >= 0) {
368 proc1[myprow1 * q1 + mypcol1] = mypnum;
369 param[2] = p1;
370 param[3] = q1;
373 param[14] = mb->
nbrow;
374 param[15] = mb->
nbcol;
375 param[16] = mb->
sprow;
376 param[17] = mb->
spcol;
377 param[18] = ib;
378 param[19] = jb;
379 }
382 newa = *ma;
383 newb = *mb;
384 ma = &newa;
385 mb = &newb;
386 if (myprow0 == -1) {
387 p0 = param[0];
388 q0 = param[1];
391 ma->
nbrow = param[6];
392 ma->
nbcol = param[7];
393 ma->
sprow = param[8];
394 ma->
spcol = param[9];
395 ia = param[10];
396 ja = param[11];
397 }
398 if (myprow1 == -1) {
399 p1 = param[2];
400 q1 = param[3];
403 mb->
nbrow = param[14];
404 mb->
nbcol = param[15];
405 mb->
sprow = param[16];
406 mb->
spcol = param[17];
407 ib = param[18];
408 jb = param[19];
409 }
410 for (i = 0; i <
NBPARAM; i++) {
412 fprintf(stderr, "xxGEMR2D:something wrong in the parameters\n");
413 exit(1);
414 }
415 }
416#ifndef NDEBUG
417 for (i = 0; i < p0 * q0; i++)
418 assert(proc0[i] >= 0 && proc0[i] < nprocs);
419 for (i = 0; i < p1 * q1; i++)
420 assert(proc1[i] >= 0 && proc1[i] < nprocs);
421#endif
422
425
426 {
430 ptrmyblock += decal;
433 ptrmyblock += decal * ma->
lda;
438 ptrmynewblock += decal;
441 ptrmynewblock += decal * mb->
lda;
444 if (p0 == 1)
446 if (q0 == 1)
448 if (p1 == 1)
450 if (q1 == 1)
452#ifndef NDEBUG
455#endif
456 }
457
458
459 if (myprow0 >= 0 && mypcol0 >= 0) {
460
462 };
463 if (myprow1 >= 0 && mypcol1 >= 0) {
464
466 };
467
468
469
474
475
476
477
478
479 recvptr = ptrrecvbuff;
480 {
481 Int tot, myrang, step, sens;
482 Int *sender, *recver;
483 Int mesending, merecving;
484 tot =
max(p0 * q0, p1 * q1);
485 init_chenille(mypnum, nprocs, p0 * q0, proc0, p1 * q1, proc1,
486 &sender, &recver, &myrang);
487 if (myrang == -1)
488 goto after_comm;
489 mesending = myprow0 >= 0;
490 assert(sender[myrang] >= 0 || !mesending);
491 assert(!mesending || proc0[sender[myrang]] == mypnum);
492 merecving = myprow1 >= 0;
493 assert(recver[myrang] >= 0 || !merecving);
494 assert(!merecving || proc1[recver[myrang]] == mypnum);
495 step = tot - 1 - myrang;
496 do {
497 for (sens = 0; sens < 2; sens++) {
498
499
500 if (mesending && recver[step] >= 0 &&
501 (sens == 0)) {
502 i = recver[step] / q1;
503 j = recver[step] % q1;
504 vinter_nb =
scan_intervals(
'r', ia, ib, m, ma, mb, p0, p1, myprow0, i,
505 v_inter);
506 hinter_nb =
scan_intervals(
'c', ja, jb,
n, ma, mb, q0, q1, mypcol0, j,
507 h_inter);
508 sendsize =
block2buff(v_inter, vinter_nb, h_inter, hinter_nb,
509 ptrmyblock, ma, ptrsendbuff);
510 }
511 if (mesending && recver[step] >= 0 &&
512 (sens == myrang > step)) {
513 i = recver[step] / q1;
514 j = recver[step] % q1;
515 if (sendsize > 0
516 && (step != myrang || !merecving)
517 ) {
518 Czgesd2d(gcontext, sendsize, (
Int)1, ptrsendbuff, sendsize,
519 (
Int)0, proc1[i * q1 + j]);
520 }
521 }
522 if (merecving && sender[step] >= 0 &&
523 (sens == myrang <= step)) {
524 i = sender[step] / q0;
525 j = sender[step] % q0;
526 vinter_nb =
scan_intervals(
'r', ib, ia, m, mb, ma, p1, p0, myprow1, i,
527 v_inter);
528 hinter_nb =
scan_intervals(
'c', jb, ja,
n, mb, ma, q1, q0, mypcol1, j,
529 h_inter);
530 recvsize =
inter_len(hinter_nb, h_inter, vinter_nb, v_inter);
531 if (recvsize > 0) {
532 if (step == myrang && mesending) {
534 ptrsendbuff, recvsize,
535 ptrrecvbuff, recvsize);
536 } else {
537 Czgerv2d(gcontext, recvsize, (
Int)1, ptrrecvbuff, recvsize,
538 (
Int)0, proc0[i * q0 + j]);
539 }
540 }
541 }
542 if (merecving && sender[step] >= 0 && sens == 1) {
543 buff2block(v_inter, vinter_nb, h_inter, hinter_nb,
544 recvptr, ptrmynewblock, mb);
545 }
546 }
547 step -= 1;
548 if (step < 0)
549 step = tot - 1;
550 } while (step != tot - 1 - myrang);
551after_comm:
552 free(sender);
553 }
554
555 if (myprow1 >= 0 && mypcol1 >= 0) {
557 };
558 if (myprow0 >= 0 && mypcol0 >= 0) {
560 };
561 if (nprow != 1)
563 free(v_inter);
564 free(h_inter);
565 free(param);
integer, save, private nprocs
static2 void gridreshape()
static2 void buff2block()
static2 void init_chenille()
1.15.0