27{
28
29
30
31
32
33
34
35
36
37
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 char * cbtop, * cctop, * rbtop, * rctop;
175 Int ictxt, iix, iiy, info, ixcol, ixrow, iycol, iyrow, jjx,
176 jjy, lcm, lcmp, mone=-1, mycol, myrow, nn, np, np0,
177 nprow, npcol, nq, nz, ione=1, tmp1, wksz;
179
180
181
183
184
185
193 void pberror_();
195 char * ptop();
199
200
201
202
203
204 ictxt = desc_X[
CTXT_];
206
207
208
209 info = 0;
210 if( nprow == -1 )
211 info = -(600+
CTXT_+1);
212 else
213 {
214 pbchkvect( *n, 1, *ix, *jx, desc_X, *incx, 6, &iix, &jjx,
215 &ixrow, &ixcol, nprow, npcol, myrow, mycol, &info );
216 pbchkvect( *n, 1, *iy, *jy, desc_Y, *incy, 11, &iiy, &jjy,
217 &iyrow, &iycol, nprow, npcol, myrow, mycol, &info );
218
219 if( info == 0 )
220 {
221 if( *n != 1 )
222 {
223 if( *incx == desc_X[
M_] )
224 {
225 if( *incy == desc_Y[
M_] )
226 {
227 if( ( ixcol != iycol ) ||
228 ( ( (*jx-1) % desc_X[
NB_] ) !=
229 ( (*jy-1) % desc_Y[
NB_] ) ) )
230 info = -10;
231 else if( desc_Y[
NB_] != desc_X[
NB_] )
232 info = -(1100+
NB_+1);
233 }
234 else if( ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
235 {
236 if( ( (*jx-1) % desc_X[
NB_] ) != ( (*iy-1) % desc_Y[
MB_] ) )
237 info = -9;
238 else if( desc_Y[
MB_] != desc_X[
NB_] )
239 info = -(1100+
MB_+1);
240 }
241 else
242 {
243 info = -12;
244 }
245 }
246 else if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) )
247 {
248 if( *incy == desc_Y[
M_] )
249 {
250 if( ( (*ix-1) % desc_X[
MB_] ) != ( (*jy-1) % desc_Y[
NB_] ) )
251 info = -10;
252 else if( desc_Y[
NB_] != desc_X[
MB_] )
253 info = -(1100+
NB_+1);
254 }
255 else if( ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
256 {
257 if( ( ixrow != iyrow ) ||
258 ( ( (*ix-1) % desc_X[
MB_] ) !=
259 ( (*iy-1) % desc_Y[
MB_] ) ) )
260 info = -9;
261 else if( desc_Y[
MB_] != desc_X[
MB_] )
262 info = -(1100+
MB_+1);
263 }
264 else
265 {
266 info = -12;
267 }
268 }
269 else
270 {
271 info = -7;
272 }
273 }
274 if( ictxt != desc_Y[
CTXT_] )
275 info = -(1100+
CTXT_+1);
276 }
277 }
278 if( info )
279 {
280 pberror_( &ictxt, "PZDOTU", &info );
281 return;
282 }
283
284
285
290 if( *n == 0 ) return;
291
292
293
294 if( *n == 1 )
295 {
296 if( ( myrow == ixrow ) && ( mycol == ixcol ) )
297 {
298 buff = &X[iix-1+(jjx-1)*desc_X[
LLD_]];
299 if( ( myrow != iyrow ) || ( mycol != iycol ) )
300 {
301 zgesd2d_( &ictxt, n, n, buff, n, &iyrow, &iycol );
302 zgerv2d_( &ictxt, n, n, ywork, n, &iyrow, &iycol );
303 }
304 else
305 *ywork = Y[iiy-1+(jjy-1)*desc_Y[
LLD_]];
306 zzdotu_( n, dotu, buff, n, ywork, n );
307 }
308 else if( ( myrow == iyrow ) && ( mycol == iycol ) )
309 {
310 zgesd2d_( &ictxt, n, n, &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], n,
311 &ixrow, &ixcol );
312 zgerv2d_( &ictxt, n, n, xwork, n, &ixrow, &ixcol );
313 zzdotu_( n, dotu, xwork, n,
314 &Y[iiy-1+(jjx-1)*desc_X[
LLD_]], n );
315 }
316
317 if( ( *incx == desc_X[
M_] ) && ( desc_X[
M_] != 1 ) )
318 {
319 if( myrow == ixrow )
320 {
322 if( mycol == ixcol )
323 {
325 &ione, &ione, dotu, &ione );
326 }
327 else
328 {
330 &ione, &ione, dotu, &ione, &myrow, &ixcol );
331 }
332 }
333 }
334 else if( ( *incx == 1 ) && ( desc_X[
M_] != 1 ) )
335 {
336 if( mycol == ixcol )
337 {
339 if( myrow == ixrow )
340 {
342 &ione, &ione, dotu, &ione );
343 }
344 else
345 {
347 &ione, &ione, dotu, &ione, &ixrow, &mycol );
348 }
349 }
350 }
351
352 if( ( *incy == desc_Y[
M_] ) && ( desc_Y[
M_] != 1 ) )
353 {
354 if( myrow == iyrow )
355 {
357 if( mycol == iycol )
358 {
360 &ione, &ione, dotu, &ione );
361 }
362 else
363 {
365 &ione, &ione, dotu, &ione, &myrow, &iycol );
366 }
367 }
368 }
369 else if( ( *incy == 1 ) && ( desc_Y[
M_] != 1 ) )
370 {
371 if( mycol == iycol )
372 {
374 if( myrow == iyrow )
375 {
377 &ione, &ione, dotu, &ione );
378 }
379 else
380 {
382 &ione, &ione, dotu, &ione, &iyrow, &mycol );
383 }
384 }
385 }
386 return;
387 }
388
389 if( ( *incx == desc_X[
M_] ) && ( *incy == desc_Y[
M_] ) )
390 {
391 nz = (*jx-1) % desc_Y[
NB_];
392 nn = *n + nz;
393 nq = numroc_( &nn, &desc_X[
NB_], &mycol, &ixcol, &npcol );
394 if( mycol == ixcol )
395 nq -= nz;
396 if( ixrow == iyrow )
397 {
398 if( myrow == ixrow )
399 {
401 zzdotu_( &nq, dotu,
402 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
403 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_] );
405 &ione, dotu, &ione, &mone, &mycol );
406 }
407 }
408 else
409 {
410 if( myrow == ixrow )
411 {
414 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
415 &iyrow, &mycol );
417 zgerv2d_( &ictxt, &nq, &ione, buff, &ione, &ixrow,
418 &mycol );
419 zzdotu_( &nq, dotu,
420 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
421 buff, &ione );
423 &ione, dotu, &ione, &mone, &mycol );
424 }
425 else if( myrow == iyrow )
426 {
429 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_],
430 &ixrow, &mycol );
432 zgerv2d_( &ictxt, &nq, &ione, buff, &ione, &ixrow,
433 &mycol );
434 zzdotu_( &nq, dotu,
435 buff, &ione,
436 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_] );
438 &ione, dotu, &ione, &mone, &mycol );
439 }
440 }
441 }
442 else if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) &&
443 ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
444 {
445 nz = (*ix-1) % desc_X[
MB_];
446 nn = *n + nz;
447 np = numroc_( &nn, &desc_X[
MB_], &myrow, &ixrow, &nprow );
448 if( myrow == ixrow )
449 np -= nz;
450 if( ixcol == iycol )
451 {
452 if( mycol == ixcol )
453 {
455 zzdotu_( &np, dotu,
456 &X[iix-1+(jjx-1)*desc_X[
LLD_]], incx,
457 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
459 &ione, &ione, dotu, &ione, &mone, &mycol );
460 }
461 }
462 else
463 {
464 if( mycol == ixcol )
465 {
468 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
469 &myrow, &iycol );
471 zgerv2d_( &ictxt, &np, &ione, buff, &ione,
472 &myrow, &iycol );
473 zzdotu_( &np, dotu,
474 &X[iix-1+(jjx-1)*desc_X[
LLD_]], incx,
475 buff, &ione );
477 &ione, &ione, dotu, &ione, &mone, &mycol );
478 }
479 else if( mycol == iycol )
480 {
483 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_],
484 &myrow, &ixcol );
486 zgerv2d_( &ictxt, &np, &ione, buff, &ione,
487 &myrow, &ixcol );
488 zzdotu_( &np, dotu,
489 buff, &ione,
490 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
492 &ione, &ione, dotu, &ione, &mone, &mycol );
493 }
494 }
495 }
496 else
497 {
498 lcm = ilcm_( &nprow, &npcol );
499 if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) )
500 {
501 lcmp = lcm / nprow;
502 nz = (*jy-1) % desc_Y[
NB_];
503 nn = *n + nz;
504 tmp1 = nn / desc_Y[
MB_];
505 np = numroc_( &nn, &desc_X[
MB_], &myrow, &ixrow, &nprow );
506 np0 =
MYROC0( tmp1, nn, desc_X[
MB_], nprow );
507 tmp1 = np0 / desc_X[
MB_];
508 wksz =
MYROC0( tmp1, np0, desc_X[
MB_], lcmp );
509 wksz = np + wksz;
510
512
513 if( mycol == iycol )
514 jjy -= nz;
515 if( myrow == ixrow )
516 np -= nz;
518 &desc_Y[
NB_], &nz, &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]],
519 &desc_Y[
LLD_], &zero, buff, &ione, &iyrow, &iycol,
520 &ixrow, &ixcol, buff+np );
521 if( mycol == ixcol )
522 {
524 zzdotu_( &np, dotu, &X[iix-1+(jjx-1)*desc_X[
LLD_]],
525 incx, buff, &ione );
527 &ione, &ione, dotu, &ione, &mone, &mycol );
528 }
529 if( myrow == iyrow )
530 {
532 if( mycol == ixcol )
534 &ione, &ione, dotu, &ione );
535 else
537 &ione, &ione, dotu, &ione, &myrow, &ixcol );
538 }
539 }
540 else
541 {
542 lcmp = lcm / nprow;
543 nz = (*jx-1) % desc_X[
NB_];
544 nn = *n + nz;
545 tmp1 = nn / desc_X[
MB_];
546 np = numroc_( &nn, desc_Y+
MB_, &myrow, &iyrow, &nprow );
547 np0 =
MYROC0( tmp1, nn, desc_Y[
MB_], nprow );
548 tmp1 = np0 / desc_Y[
MB_];
549 wksz =
MYROC0( tmp1, np0, desc_Y[
MB_], lcmp );
550 wksz = np + wksz;
551
553
554 if( myrow == iyrow )
555 np -= nz;
557 &desc_X[
NB_], &nz, &X[iix-1+(jjx-1)*desc_X[
LLD_]],
558 &desc_X[
LLD_], &zero, buff, &ione, &ixrow, &ixcol,
559 &iyrow, &iycol, buff+np );
560 if( mycol == iycol )
561 {
563 zzdotu_( &np, dotu, buff, &ione,
564 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
566 &ione, &ione, dotu, &ione, &mone, &mycol );
567 }
568 if( myrow == ixrow )
569 {
571 if( mycol == iycol )
573 &ione, &ione, dotu, &ione );
574 else
576 &ione, &ione, dotu, &ione, &myrow, &iycol );
577 }
578 }
579 }
580}
#define MYROC0(nblocks, n, nb, nprocs)
F_VOID_FUNC blacs_gridinfo_(Int *ConTxt, Int *nprow, Int *npcol, Int *myrow, Int *mycol)
char * getpbbuf(char *mess, Int length)
void pbchkvect(Int n, Int npos0, Int ix, Int jx, Int desc_X[], Int incx, Int dpos0, Int *iix, Int *jjx, Int *ixrow, Int *ixcol, Int nprow, Int npcol, Int myrow, Int mycol, Int *info)
F_VOID_FUNC zgebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, double *A, Int *lda, Int *rsrc, Int *csrc)
F_VOID_FUNC zgebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, double *A, Int *lda)
F_VOID_FUNC zgerv2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, Int *rsrc, Int *csrc)
F_VOID_FUNC zgesd2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, Int *rdest, Int *cdest)
F_VOID_FUNC zgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, double *A, Int *lda, Int *rdest, Int *cdest)