38{
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188 char * one, * zero;
189 Int Afwd, AggRow, AiiD, AiiR, Ainb1D, Ainb1R, Ald, AmyprocD,
190 AmyprocR, AnR, AnbD, AnbR, AnnxtL, AnnxtR, AnpD, AnpR, AnpreR,
191 AnprocsR, ArocR, AsrcD, AsrcR, Bld, Bsrc_, ctxt, k, kb, kblks,
192 kn, ktmp, mycol, mydist, mydistnb, myrow, nlen, npcol, nprow,
193 offset, size, srcdist;
196
197
198
199 char * Aptr = NULL, * Bptr = NULL;
200
201
202
203
204
205
206
207 *BFREE = 0;
208 *B = NULL;
209
210
211
212 if( ( M <= 0 ) || ( N <= 0 ) )
213 {
216 return;
217 }
218
219
220
222
223 if( ( AggRow = (
Mupcase( AROC[0] ) ==
CROW ) ) != 0 )
224 {
225
226
227
228 AnbR = DESCA[
MB_]; AnbD = DESCA[
NB_]; Ald = DESCA[
LLD_];
229 PB_Cinfog2l( IA, JA, DESCA, nprow, npcol, myrow, mycol, &AiiR, &AiiD,
230 &AsrcR, &AsrcD );
232 AnpD =
PB_Cnumroc( N, 0, Ainb1D, AnbD, mycol, AsrcD, npcol );
233
234
235
236
237 if( !(
PB_Cspan( M, IA, DESCA[
IMB_], AnbR, AsrcR, nprow ) ) )
238 {
240 {
241
242
243
244 if( ( ( myrow == AsrcR ) || ( AsrcR < 0 ) ) && ( AnpD > 0 ) )
245 {
246
247
248
249 Bld = Ald;
250 *B =
Mptr( A, AiiR, AiiD, Ald,
TYPE->size );
251 }
252 else { Bld = 1; }
253 }
254 else
255 {
256
257
258
259 if( ( ( myrow == AsrcR ) || ( AsrcR < 0 ) ) && ( AnpD > 0 ) )
260 {
261
262
263
264
265 Bld = M;
266 if( AnpD > 0 )
267 {
270 *BFREE = 1;
271 TYPE->Fmmadd( &M, &AnpD,
TYPE->one,
Mptr( A, AiiR, AiiD, Ald,
272 size ), &Ald,
TYPE->zero, *B, &Bld );
273 }
274 }
275 else { Bld = 1; }
276 }
277
278
279
280 PB_Cdescset( DESCB, M, N, M, Ainb1D, AnbR, AnbD, AsrcR, AsrcD, ctxt,
281 Bld );
282 return;
283 }
284
285 AnR = M; Bsrc_ =
RSRC_;
286 AmyprocR = myrow; AmyprocD = mycol; AnprocsR = nprow;
288 AnpR =
PB_Cnumroc( M, 0, Ainb1R, AnbR, myrow, AsrcR, nprow );
289 }
290 else
291 {
292
293
294
295 AnbD = DESCA[
MB_ ]; AnbR = DESCA[
NB_ ]; Ald = DESCA[
LLD_];
296 PB_Cinfog2l( IA, JA, DESCA, nprow, npcol, myrow, mycol, &AiiD, &AiiR,
297 &AsrcD, &AsrcR );
299 AnpD =
PB_Cnumroc( M, 0, Ainb1D, AnbD, myrow, AsrcD, nprow );
300
301
302
303
304 if( !(
PB_Cspan( N, JA, DESCA[
INB_], AnbR, AsrcR, npcol ) ) )
305 {
307 {
308
309
310
311 Bld = Ald;
312 if( ( ( mycol == AsrcR ) || ( AsrcR < 0 ) ) && ( AnpD > 0 ) )
313
314
315
316 *B =
Mptr( A, AiiD, AiiR, Ald,
TYPE->size );
317 }
318 else
319 {
320
321
322
323 Bld =
MAX( 1, AnpD );
324 if( ( ( mycol == AsrcR ) || ( AsrcR < 0 ) ) && ( AnpD > 0 ) )
325 {
326
327
328
329
330 if( AnpD > 0 )
331 {
334 *BFREE = 1;
335 TYPE->Fmmadd( &AnpD, &N,
TYPE->one,
Mptr( A, AiiD, AiiR, Ald,
336 size ), &Ald,
TYPE->zero, *B, &Bld );
337 }
338 }
339 }
340
341
342
343 PB_Cdescset( DESCB, M, N, Ainb1D, N, AnbD, AnbR, AsrcD, AsrcR, ctxt,
344 Bld );
345 return;
346 }
347
348 AnR = N; Bsrc_ =
CSRC_;
349 AmyprocR = mycol; AmyprocD = myrow; AnprocsR = npcol;
351 AnpR =
PB_Cnumroc( N, 0, Ainb1R, AnbR, mycol, AsrcR, npcol );
352 }
353
354
355
356
357
358
360 {
361 if( ( AnpD > 0 ) && ( AnpR > 0 ) )
362 {
363
364
365
366 AnpreR =
PB_Cnpreroc( AnR, 0, Ainb1R, AnbR, AmyprocR, AsrcR,
367 AnprocsR );
368
369 if( AnpreR == 0 )
370 {
371
372
373
374
375 if( AggRow )
376 {
377 TYPE->Cgesd2d( ctxt, AnpR, AnpD,
Mptr( A, AiiR, AiiD, Ald,
379 AmyprocD );
380 }
381 else
382 {
383 TYPE->Cgesd2d( ctxt, AnpD, AnpR,
Mptr( A, AiiD, AiiR,
384 Ald,
TYPE->size ), Ald, AmyprocD,
386 }
387 }
388 else if( AnpreR > 0 )
389 {
390
391
392
393
396 *B = Bptr =
PB_Cmalloc( ( AnpreR + AnpR ) * AnpD * size );
397 nlen = AnpreR;
398 mydistnb =
MModSub( AmyprocR, AsrcR, AnprocsR ) * AnbR;
399 kblks = ( ( ( ktmp = AnR - Ainb1R - 1 ) >= 0 ) ?
400 ( ( ktmp / AnbR ) + 1 ) / AnprocsR : 0 );
401 offset = kblks * AnbR;
402 kn = Ainb1R + mydistnb - AnbR;
403 kn =
MIN( kn, AnpreR ) +
404 (
MAX( 1, kblks ) - 1 ) * mydistnb;
405 if( AggRow )
406 {
408 Aptr =
Mptr( A, AiiR, AiiD, Ald, size );
409 Bld = AnpreR + AnpR;
410
411
412
413 TYPE->Cgerv2d( ctxt, AnpreR, AnpD, *B, Bld,
MModSub1( AmyprocR,
414 AnprocsR ), AmyprocD );
415
416
417
418
419 if( ( ( AnpR - 1 ) / AnbR ) == kblks )
420 {
421 kb = AnpR - offset;
422 add( &kb, &AnpD, one,
Mptr( Aptr, offset, 0, Ald, size ),
423 &Ald, zero,
Mptr( Bptr, nlen+offset, 0, Bld, size ),
424 &Bld );
425 }
426
427 for( k = kblks; k >= 1; k-- )
428 {
429 kb = nlen - kn;
430 shft( &kb, &AnpD, &offset,
Mptr( Bptr, kn, 0, Bld, size ),
431 &Bld );
432 offset -= AnbR;
433 add( &AnbR, &AnpD, one,
Mptr( Aptr, offset, 0, Ald, size ),
434 &Ald, zero,
Mptr( Bptr, kn+offset, 0, Bld, size ),
435 &Bld );
436 kn -= mydistnb;
437 nlen -= kb;
438 }
439
440 if( AnpreR + AnpR != AnR )
441 {
442
443
444
445
446
447 TYPE->Cgesd2d( ctxt, AnpreR+AnpR, AnpD, *B, Bld,
448 MModAdd1( AmyprocR, AnprocsR ), AmyprocD );
449 if( *B ) free( *B );
450 }
451 }
452 else
453 {
455 Aptr =
Mptr( A, AiiD, AiiR, Ald, size );
456 Bld =
MAX( 1, AnpD );
457
458
459
460 TYPE->Cgerv2d( ctxt, AnpD, AnpreR, *B, Bld, AmyprocD,
462
463
464
465
466 if( ( ( AnpR - 1 ) / AnbR ) == kblks )
467 {
468 kb = AnpR - offset;
469 add( &AnpD, &kb, one,
Mptr( Aptr, 0, offset, Ald, size ),
470 &Ald, zero,
Mptr( Bptr, 0, nlen+offset, Bld, size ),
471 &Bld );
472 }
473
474 for( k = kblks; k >= 1; k-- )
475 {
476 kb = nlen - kn;
477 shft( &AnpD, &kb, &offset,
Mptr( Bptr, 0, kn, Bld, size ),
478 &Bld );
479 offset -= AnbR;
480 add( &AnpD, &AnbR, one,
Mptr( Aptr, 0, offset, Ald, size ),
481 &Ald, zero,
Mptr( Bptr, 0, kn + offset, Bld, size ),
482 &Bld );
483 kn -= mydistnb;
484 nlen -= kb;
485 }
486
487 if( AnpreR + AnpR != AnR )
488 {
489
490
491
492
493
494 TYPE->Cgesd2d( ctxt, AnpD, AnpreR+AnpR, *B, Bld, AmyprocD,
496 if( *B ) free( *B );
497 }
498 }
499 }
500 }
501 }
502 else
503 {
504
505
506
507
508 ArocR =
PB_Cindxg2p( AnR-1, Ainb1R, AnbR, AsrcR, AsrcR, AnprocsR );
509
510 if( ( AnpD > 0 ) && ( AnpR > 0 ) )
511 {
512
513
514
515 AnnxtR =
PB_Cnnxtroc( AnR, 0, Ainb1R, AnbR, AmyprocR, AsrcR,
516 AnprocsR );
517 AnnxtL =
PB_Cnnxtroc( AnR, 0, Ainb1R, AnbR, ArocR, AsrcR,
518 AnprocsR );
519
520 if( ( AnnxtR =
MModSub( AnnxtR, AnnxtL, AnR ) ) == 0 )
521 {
522
523
524
525
526 if( AggRow )
527 {
528 TYPE->Cgesd2d( ctxt, AnpR, AnpD,
Mptr( A, AiiR, AiiD, Ald,
530 AmyprocD );
531 }
532 else
533 {
534 TYPE->Cgesd2d( ctxt, AnpD, AnpR,
Mptr( A, AiiD, AiiR, Ald,
536 AnprocsR ) );
537 }
538 }
539 else if( AnnxtR > 0 )
540 {
541
542
543
544
547 *B = Bptr =
PB_Cmalloc( ( AnnxtR + AnpR ) * AnpD * size );
548 kblks = ( ( ( ktmp = AnR - Ainb1R - 1 ) >= 0 ) ?
549 ( ( ktmp / AnbR ) + 1 ) / AnprocsR : 0 );
550 mydist =
MModSub( ArocR, AmyprocR, AnprocsR );
551 mydistnb = mydist * AnbR;
552 srcdist =
MModSub( ArocR, AsrcR, AnprocsR );
553
554 if( AggRow )
555 {
557 Aptr =
Mptr( A, AiiR, AiiD, Ald, size );
558 Bld = AnnxtR + AnpR;
559
560
561
562 TYPE->Cgerv2d( ctxt, AnnxtR, AnpD,
Mptr( *B, AnpR, 0, Bld,
563 size ), Bld,
MModAdd1( AmyprocR, AnprocsR ),
564 AmyprocD );
565
566
567
568
569 if( mydist > srcdist )
570 {
571 offset = -AnpR;
572 kb = Ainb1R + srcdist*AnbR;
573 }
574 else if( mydist == srcdist )
575 {
576 add( &Ainb1R, &AnpD, one, Aptr, &Ald, zero, Bptr, &Bld );
577 Aptr =
Mptr( Aptr, Ainb1R, 0, Ald, size );
578 Bptr =
Mptr( Bptr, Ainb1R, 0, Ald, size );
579 offset = Ainb1R - AnpR;
580 kb = mydistnb;
581 }
582 else
583 {
584 add( &AnbR, &AnpD, one, Aptr, &Ald, zero, Bptr, &Bld );
585 Aptr =
Mptr( Aptr, AnbR, 0, Ald, size );
586 Bptr =
Mptr( Bptr, AnbR, 0, Ald, size );
587 offset = AnbR - AnpR;
588 kb = mydistnb;
589 }
590
591 for( k = kblks; k >= 1; k-- )
592 {
593 shft( &kb, &AnpD, &offset, Bptr, &Bld );
594 Bptr =
Mptr( Bptr, kb, 0, Bld, size );
595 add( &AnbR, &AnpD, one, Aptr, &Ald, zero, Bptr, &Bld );
596 Aptr =
Mptr( Aptr, AnbR, 0, Ald, size );
597 Bptr =
Mptr( Bptr, AnbR, 0, Ald, size );
598 offset += AnbR;
599 kb = mydistnb;
600 }
601
602 if( AnnxtR + AnpR != AnR )
603 {
604
605
606
607
608
609 TYPE->Cgesd2d( ctxt, AnnxtR+AnpR, AnpD, *B, Bld,
610 MModSub1( AmyprocR, AnprocsR ), AmyprocD );
611 if( *B ) free( *B );
612 }
613 }
614 else
615 {
617 Aptr =
Mptr( A, AiiD, AiiR, Ald, size );
618 Bld =
MAX( 1, AnpD );
619
620
621
622 TYPE->Cgerv2d( ctxt, AnpD, AnnxtR,
Mptr( *B, 0, AnpR, Bld,
623 size ), Bld, AmyprocD,
MModAdd1( AmyprocR,
624 AnprocsR ) );
625
626
627
628
629 if( mydist > srcdist )
630 {
631 offset = -AnpR;
632 kb = Ainb1R + srcdist*AnbR;
633 }
634 else if( mydist == srcdist )
635 {
636 add( &AnpD, &Ainb1R, one, Aptr, &Ald, zero, Bptr, &Bld );
637 Aptr =
Mptr( Aptr, 0, Ainb1R, Ald, size );
638 Bptr =
Mptr( Bptr, 0, Ainb1R, Bld, size );
639 offset = Ainb1R - AnpR;
640 kb = mydistnb;
641 }
642 else
643 {
644 add( &AnpD, &AnbR, one, Aptr, &Ald, zero, Bptr, &Bld );
645 Aptr =
Mptr( Aptr, 0, AnbR, Ald, size );
646 Bptr =
Mptr( Bptr, 0, AnbR, Bld, size );
647 offset = AnbR - AnpR;
648 kb = mydistnb;
649 }
650
651 for( k = kblks; k >= 1; k-- )
652 {
653 shft( &AnpD, &kb, &offset, Bptr, &Bld );
654 Bptr =
Mptr( Bptr, 0, kb, Bld, size );
655 add( &AnpD, &AnbR, one, Aptr, &Ald, zero, Bptr, &Bld );
656 Aptr =
Mptr( Aptr, 0, AnbR, Ald, size );
657 Bptr =
Mptr( Bptr, 0, AnbR, Bld, size );
658 offset += AnbR;
659 kb = mydistnb;
660 }
661
662 if( AnnxtR + AnpR != AnR )
663 {
664
665
666
667
668
669 TYPE->Cgesd2d( ctxt, AnpD, AnnxtR+AnpR, *B, Bld, AmyprocD,
671 if( *B ) free( *B );
672 }
673 }
674 }
675 }
676 }
677
678
679
680 if( AggRow )
681 {
682 PB_Cdescset( DESCB, M, N, M, Ainb1D, AnbR, AnbD, AsrcR, AsrcD, ctxt, M );
683 }
684 else
685 {
686 PB_Cdescset( DESCB, M, N, Ainb1D, N, AnbD, AnbR, AsrcD, AsrcR, ctxt,
688 }
689
690
691
692
693 if( Afwd )
694 {
695 if( AnR + AnbR > Ainb1R + ( AnprocsR - 1 ) * AnbR )
696 {
697
698
699
700
701
702 DESCB[Bsrc_] =
MModSub1( AsrcR, AnprocsR );
703 }
704 else
705 {
706
707
708
709
710 DESCB[Bsrc_] =
PB_Cindxg2p( AnR-1, Ainb1R, AnbR, AsrcR, AsrcR,
711 AnprocsR );
712 }
713 if( ( AnpD > 0 ) && ( AnpR > 0 ) && ( AmyprocR == DESCB[Bsrc_] ) )
714 *BFREE = 1;
715 }
716 else
717 {
718 if( AnR + AnbR > Ainb1R + ( AnprocsR - 1 ) * AnbR )
719 {
720
721
722
723
724
725 DESCB[Bsrc_] =
MModAdd1( ArocR, AnprocsR );
726 }
727 else
728 {
729
730
731
732
733 DESCB[Bsrc_] = AsrcR;
734 }
735 if( ( AnpD > 0 ) && ( AnpR > 0 ) && ( AmyprocR == DESCB[Bsrc_] ) )
736 *BFREE = 1;
737 }
738
739
740
741}