297{
298 Int *ptrsendbuff, *ptrrecvbuff, *ptrNULL = 0;
301 Int *proc0, *proc1, *param;
302 Int mypnum, myprow0, mypcol0, myprow1, mypcol1,
nprocs;
304 Int nprow, npcol, gcontext;
305 Int recvsize, sendsize;
308 Int hinter_nb, vinter_nb;
312
313
314
315 if (m == 0 ||
n == 0)
316 return;
317 ia -= 1;
318 ja -= 1;
319 ib -= 1;
320 jb -= 1;
322 gcontext = globcontext;
324
325
326
327 if (nprow != 1) {
330 }
332
333 if (myprow0 >= p0 || mypcol0 >= q0)
334 myprow0 = mypcol0 = -1;
335 assert((myprow0 < p0 && mypcol0 < q0) || (myprow0 == -1 && mypcol0 == -1));
337 if (myprow1 >= p1 || mypcol1 >= q1)
338 myprow1 = mypcol1 = -1;
339 assert((myprow1 < p1 && mypcol1 < q1) || (myprow1 == -1 && mypcol1 == -1));
340
341
349
350
351 if (myprow0 >= 0) {
352 proc0[myprow0 * q0 + mypcol0] = mypnum;
353 param[0] = p0;
354 param[1] = q0;
357 param[6] = ma->
nbrow;
358 param[7] = ma->
nbcol;
359 param[8] = ma->
sprow;
360 param[9] = ma->
spcol;
361 param[10] = ia;
362 param[11] = ja;
363 }
364 if (myprow1 >= 0) {
365 proc1[myprow1 * q1 + mypcol1] = mypnum;
366 param[2] = p1;
367 param[3] = q1;
370 param[14] = mb->
nbrow;
371 param[15] = mb->
nbcol;
372 param[16] = mb->
sprow;
373 param[17] = mb->
spcol;
374 param[18] = ib;
375 param[19] = jb;
376 }
379 newa = *ma;
380 newb = *mb;
381 ma = &newa;
382 mb = &newb;
383 if (myprow0 == -1) {
384 p0 = param[0];
385 q0 = param[1];
388 ma->
nbrow = param[6];
389 ma->
nbcol = param[7];
390 ma->
sprow = param[8];
391 ma->
spcol = param[9];
392 ia = param[10];
393 ja = param[11];
394 }
395 if (myprow1 == -1) {
396 p1 = param[2];
397 q1 = param[3];
400 mb->
nbrow = param[14];
401 mb->
nbcol = param[15];
402 mb->
sprow = param[16];
403 mb->
spcol = param[17];
404 ib = param[18];
405 jb = param[19];
406 }
407 for (i = 0; i <
NBPARAM; i++) {
409 fprintf(stderr, "xxGEMR2D:something wrong in the parameters\n");
410 exit(1);
411 }
412 }
413#ifndef NDEBUG
414 for (i = 0; i < p0 * q0; i++)
415 assert(proc0[i] >= 0 && proc0[i] < nprocs);
416 for (i = 0; i < p1 * q1; i++)
417 assert(proc1[i] >= 0 && proc1[i] < nprocs);
418#endif
419
422
423 {
427 ptrmyblock += decal;
430 ptrmyblock += decal * ma->
lda;
435 ptrmynewblock += decal;
438 ptrmynewblock += decal * mb->
lda;
441 if (p0 == 1)
443 if (q0 == 1)
445 if (p1 == 1)
447 if (q1 == 1)
449#ifndef NDEBUG
452#endif
453 }
454
455
456 if (myprow0 >= 0 && mypcol0 >= 0) {
457
459 };
460 if (myprow1 >= 0 && mypcol1 >= 0) {
461
463 };
464
465
466
471
472
473
474
475
476 recvptr = ptrrecvbuff;
477 {
478 Int tot, myrang, step, sens;
479 Int *sender, *recver;
480 Int mesending, merecving;
481 tot =
max(p0 * q0, p1 * q1);
482 init_chenille(mypnum, nprocs, p0 * q0, proc0, p1 * q1, proc1,
483 &sender, &recver, &myrang);
484 if (myrang == -1)
485 goto after_comm;
486 mesending = myprow0 >= 0;
487 assert(sender[myrang] >= 0 || !mesending);
488 assert(!mesending || proc0[sender[myrang]] == mypnum);
489 merecving = myprow1 >= 0;
490 assert(recver[myrang] >= 0 || !merecving);
491 assert(!merecving || proc1[recver[myrang]] == mypnum);
492 step = tot - 1 - myrang;
493 do {
494 for (sens = 0; sens < 2; sens++) {
495
496
497 if (mesending && recver[step] >= 0 &&
498 (sens == 0)) {
499 i = recver[step] / q1;
500 j = recver[step] % q1;
501 vinter_nb =
scan_intervals(
'r', ia, ib, m, ma, mb, p0, p1, myprow0, i,
502 v_inter);
503 hinter_nb =
scan_intervals(
'c', ja, jb,
n, ma, mb, q0, q1, mypcol0, j,
504 h_inter);
505 sendsize =
block2buff(v_inter, vinter_nb, h_inter, hinter_nb,
506 ptrmyblock, ma, ptrsendbuff);
507 }
508 if (mesending && recver[step] >= 0 &&
509 (sens == myrang > step)) {
510 i = recver[step] / q1;
511 j = recver[step] % q1;
512 if (sendsize > 0
513 && (step != myrang || !merecving)
514 ) {
515 Cigesd2d(gcontext, sendsize, (
Int)1, ptrsendbuff, sendsize,
516 (
Int)0, proc1[i * q1 + j]);
517 }
518 }
519 if (merecving && sender[step] >= 0 &&
520 (sens == myrang <= step)) {
521 i = sender[step] / q0;
522 j = sender[step] % q0;
523 vinter_nb =
scan_intervals(
'r', ib, ia, m, mb, ma, p1, p0, myprow1, i,
524 v_inter);
525 hinter_nb =
scan_intervals(
'c', jb, ja,
n, mb, ma, q1, q0, mypcol1, j,
526 h_inter);
527 recvsize =
inter_len(hinter_nb, h_inter, vinter_nb, v_inter);
528 if (recvsize > 0) {
529 if (step == myrang && mesending) {
531 ptrsendbuff, recvsize,
532 ptrrecvbuff, recvsize);
533 } else {
534 Cigerv2d(gcontext, recvsize, (
Int)1, ptrrecvbuff, recvsize,
535 (
Int)0, proc0[i * q0 + j]);
536 }
537 }
538 }
539 if (merecving && sender[step] >= 0 && sens == 1) {
540 buff2block(v_inter, vinter_nb, h_inter, hinter_nb,
541 recvptr, ptrmynewblock, mb);
542 }
543 }
544 step -= 1;
545 if (step < 0)
546 step = tot - 1;
547 } while (step != tot - 1 - myrang);
548after_comm:
549 free(sender);
550 }
551
552 if (myprow1 >= 0 && mypcol1 >= 0) {
554 };
555 if (myprow0 >= 0 && mypcol0 >= 0) {
557 };
558 if (nprow != 1)
560 free(v_inter);
561 free(h_inter);
562 free(param);
integer, save, private nprocs
static2 void gridreshape()
static2 void buff2block()
static2 void init_chenille()
1.15.0