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 Int ictxt, info, iix, iiy, ixcol, ixrow, iycol, iyrow, jjx,
175 jjy, lcm, lcmp, lcmq, mycol, myrow, nn, np, np0, nprow,
176 npcol, nq, nq0, nz, ione=1, tmp1, wksz;
178
179
180
182
183
184
189 void pberror_();
196
197
198
199
200
201 ictxt = desc_X[
CTXT_];
203
204
205
206 info = 0;
207 if( nprow == -1 )
208 info = -(600+
CTXT_+1);
209 else
210 {
211 pbchkvect( *n, 1, *ix, *jx, desc_X, *incx, 6, &iix, &jjx,
212 &ixrow, &ixcol, nprow, npcol, myrow, mycol, &info );
213 pbchkvect( *n, 1, *iy, *jy, desc_Y, *incy, 11, &iiy, &jjy,
214 &iyrow, &iycol, nprow, npcol, myrow, mycol, &info );
215
216 if( info == 0 )
217 {
218 if( *n != 1 )
219 {
220 if( *incx == desc_X[
M_] )
221 {
222 if( *incy == desc_Y[
M_] )
223 {
224 if( ( ixcol != iycol ) ||
225 ( ( (*jx-1) % desc_X[
NB_] ) !=
226 ( (*jy-1) % desc_Y[
NB_] ) ) )
227 info = -10;
228 else if( desc_Y[
NB_] != desc_X[
NB_] )
229 info = -(1100+
NB_+1);
230 }
231 else if( ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
232 {
233 if( ( (*jx-1) % desc_X[
NB_] ) != ( (*iy-1) % desc_Y[
MB_] ) )
234 info = -9;
235 else if( desc_Y[
MB_] != desc_X[
NB_] )
236 info = -(1100+
MB_+1);
237 }
238 else
239 {
240 info = -12;
241 }
242 }
243 else if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) )
244 {
245 if( *incy == desc_Y[
M_] )
246 {
247 if( ( (*ix-1) % desc_X[
MB_] ) != ( (*jy-1) % desc_Y[
NB_] ) )
248 info = -10;
249 else if( desc_Y[
NB_] != desc_X[
MB_] )
250 info = -(1100+
NB_+1);
251 }
252 else if( ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
253 {
254 if( ( ixrow != iyrow ) ||
255 ( ( (*ix-1) % desc_X[
MB_] ) !=
256 ( (*iy-1) % desc_Y[
MB_] ) ) )
257 info = -9;
258 else if( desc_Y[
MB_] != desc_X[
MB_] )
259 info = -(1100+
MB_+1);
260 }
261 else
262 {
263 info = -12;
264 }
265 }
266 else
267 {
268 info = -7;
269 }
270 }
271 if( ictxt != desc_Y[
CTXT_] )
272 info = -(1100+
CTXT_+1);
273 }
274 }
275 if( info )
276 {
277 pberror_( &ictxt, "PZAXPY", &info );
278 return;
279 }
280
281
282
283 if( *n == 0 )
284 return;
285
286
287
288 if( *n == 1 )
289 {
290 if( ( myrow == iyrow ) && ( mycol == iycol ) )
291 {
292 if( ( myrow != ixrow ) || ( mycol != ixcol ) )
293 zgerv2d_( &ictxt, n, n, &tmp, n, &ixrow, &ixcol );
294 else
295 tmp = X[iix-1+(jjx-1)*desc_X[
LLD_]];
296 zaxpy_( n, alpha, &tmp, n, &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], n );
297 }
298 else if( ( myrow == ixrow ) && ( mycol == ixcol ) )
299 zgesd2d_( &ictxt, n, n, &X[iix-1+(jjx-1)*desc_X[
LLD_]], n,
300 &iyrow, &iycol );
301 return;
302 }
303
306 if( ( *incx == desc_X[
M_] ) && ( *incy == desc_Y[
M_] ) )
307 {
308 nz = (*jx-1) % desc_Y[
NB_];
309 nn = *n + nz;
310 nq = numroc_( &nn, &desc_X[
NB_], &mycol, &ixcol, &npcol );
311 if( mycol == ixcol )
312 nq -= nz;
313 if( ixrow == iyrow )
314 {
315 if( myrow == ixrow )
317 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
318 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_] );
319 }
320 else
321 {
322 if( myrow == ixrow )
324 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
325 &iyrow, &mycol );
326 else if( myrow == iyrow )
327 {
329 zgerv2d_( &ictxt, &nq, &ione, buff, &ione, &ixrow,
330 &mycol );
331 zaxpy_( &nq, alpha, buff, &ione,
332 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_] );
333 }
334 }
335 }
336 else if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) &&
337 ( *incy == 1 ) && ( *incy != desc_Y[
M_] ) )
338 {
339 nz = (*ix-1) % desc_X[
MB_];
340 nn = *n + nz;
341 np = numroc_( &nn, &desc_X[
MB_], &myrow, &ixrow, &nprow );
342 if( myrow == ixrow )
343 np -= nz;
344 if( ixcol == iycol )
345 {
346 if( mycol == ixcol )
348 &X[iix-1+(jjx-1)*desc_X[
LLD_]], incx,
349 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
350 }
351 else
352 {
353 if( mycol == ixcol )
355 &X[iix-1+(jjx-1)*desc_X[
LLD_]], &desc_X[
LLD_],
356 &myrow, &iycol );
357 else if( mycol == iycol )
358 {
360 zgerv2d_( &ictxt, &np, &ione, buff, &ione, &myrow,
361 &ixcol );
362 zaxpy_( &np, alpha, buff, &ione,
363 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
364 }
365 }
366 }
367 else
368 {
369 lcm = ilcm_( &nprow, &npcol );
370 if( ( *incx == 1 ) && ( *incx != desc_X[
M_] ) )
371 {
372 lcmq = lcm / npcol;
373 nz = (*ix-1) % desc_X[
MB_];
374 nn = *n + nz;
375 np = numroc_( &nn, &desc_X[
MB_], &myrow, &ixrow, &nprow );
376 nz = (*jy-1) % desc_Y[
NB_];
377 nn = *n + nz;
378 tmp1 = nn / desc_Y[
NB_];
379 nq0 =
MYROC0( tmp1, nn, desc_Y[
NB_], npcol );
380 tmp1 = nq0 / desc_Y[
NB_];
381 wksz = np +
MYROC0( tmp1, nq0, desc_Y[
NB_], lcmq );
382
384
385 if( myrow == ixrow )
386 np -= nz;
387
388 if( mycol == ixcol )
389 {
390 zcopy_( &np, &X[iix-1+(jjx-1)*desc_X[
LLD_]], incx,
391 buff, incx );
392 zscal_( &np, alpha, buff, incx );
393 }
395 &desc_X[
MB_], &nz, buff, incx, &one,
396 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], &desc_Y[
LLD_],
397 &ixrow, &ixcol, &iyrow, &iycol, buff+np );
398 }
399 else
400 {
401 lcmp = lcm / nprow;
402 nz = (*iy-1) % desc_Y[
MB_];
403 nn = *n + nz;
404 tmp1 = nn / desc_Y[
MB_];
405 np = numroc_( &nn, &desc_Y[
MB_], &myrow, &iyrow, &nprow );
406 np0 =
MYROC0( tmp1, nn, desc_Y[
MB_], nprow );
407 tmp1 = np0 / desc_Y[
MB_];
408 wksz =
MYROC0( tmp1, np0, desc_Y[
MB_], lcmp );
409 wksz = np + wksz;
410
412
414 &desc_X[
NB_], &nz, &X[iix-1+(jjx-1)*desc_X[
LLD_]],
415 &desc_X[
LLD_], &zero, buff, &ione, &ixrow, &ixcol,
416 &iyrow, &iycol, buff+np );
417 if( mycol == iycol )
418 {
419 if( myrow == iyrow )
420 np -= nz;
421 zaxpy_( &np, alpha, buff, &ione,
422 &Y[iiy-1+(jjy-1)*desc_Y[
LLD_]], incy );
423 }
424 }
425 }
426}
#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 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)