ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzdotc.c
Go to the documentation of this file.
1 /* ---------------------------------------------------------------------
2 *
3 * Mark R. Fahey
4 * August 2000
5 * This is a slightly modified version of pzaxpy_ from ScaLAPACK 1.0
6 * which fixes a bug in the incx=1 and incy=1 case.
7 *
8 * ---------------------------------------------------------------------
9 */
10 /*
11 * Include files
12 */
13 #include "pblas.h"
14 
15 void pzdotc_( n, dotc, X, ix, jx, desc_X, incx, Y, iy, jy, desc_Y,
16  incy )
17 /*
18 * .. Scalar Arguments ..
19 */
20  int * incx, * incy, * ix, * iy, * jx, * jy, * n;
21  complex16 * dotc;
22 /* ..
23 * .. Array Arguments ..
24 */
25  int desc_X[], desc_Y[];
26  complex16 X[], Y[];
27 {
28 /*
29 * Purpose
30 * =======
31 *
32 * PZDOTC forms the dot product of two distributed vectors,
33 *
34 * dotc := sub( X )**H * sub( Y )
35 *
36 * where sub( X ) denotes X(IX,JX:JX+N-1) if INCX = M_X,
37 * X(IX:IX+N-1,JX) if INCX = 1 and INCX <> M_X,
38 *
39 * sub( Y ) denotes Y(IY,JY:JY+N-1) if INCY = M_Y,
40 * Y(IY:IY+N-1,JY) if INCY = 1 and INCY <> M_Y.
41 *
42 * Notes
43 * =====
44 *
45 * Each global data object is described by an associated description
46 * vector. This vector stores the information required to establish
47 * the mapping between an object element and its corresponding process
48 * and memory location.
49 *
50 * Let A be a generic term for any 2D block cyclicly distributed array.
51 * Such a global array has an associated description vector descA.
52 * In the following comments, the character _ should be read as
53 * "of the global array".
54 *
55 * NOTATION STORED IN EXPLANATION
56 * --------------- -------------- --------------------------------------
57 * DT_A (global) descA[ DT_ ] The descriptor type. In this case,
58 * DT_A = 1.
59 * CTXT_A (global) descA[ CTXT_ ] The BLACS context handle, indicating
60 * the BLACS process grid A is distribu-
61 * ted over. The context itself is glo-
62 * bal, but the handle (the integer
63 * value) may vary.
64 * M_A (global) descA[ M_ ] The number of rows in the global
65 * array A.
66 * N_A (global) descA[ N_ ] The number of columns in the global
67 * array A.
68 * MB_A (global) descA[ MB_ ] The blocking factor used to distribu-
69 * te the rows of the array.
70 * NB_A (global) descA[ NB_ ] The blocking factor used to distribu-
71 * te the columns of the array.
72 * RSRC_A (global) descA[ RSRC_ ] The process row over which the first
73 * row of the array A is distributed.
74 * CSRC_A (global) descA[ CSRC_ ] The process column over which the
75 * first column of the array A is
76 * distributed.
77 * LLD_A (local) descA[ LLD_ ] The leading dimension of the local
78 * array. LLD_A >= MAX(1,LOCr(M_A)).
79 *
80 * Let K be the number of rows or columns of a distributed matrix,
81 * and assume that its process grid has dimension p x q.
82 * LOCr( K ) denotes the number of elements of K that a process
83 * would receive if K were distributed over the p processes of its
84 * process column.
85 * Similarly, LOCc( K ) denotes the number of elements of K that a
86 * process would receive if K were distributed over the q processes of
87 * its process row.
88 * The values of LOCr() and LOCc() may be determined via a call to the
89 * ScaLAPACK tool function, NUMROC:
90 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
91 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
92 * An upper bound for these quantities may be computed by:
93 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
94 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
95 *
96 * Because vectors may be seen as particular matrices, a distributed
97 * vector is considered to be a distributed matrix.
98 *
99 * If INCX = M_X and INCY = M_Y, NB_X must be equal to NB_Y, and the
100 * process column having the first entries of sub( Y ) must also contain
101 * the first entries of sub( X ). Moreover, the quantity
102 * MOD( JX-1, NB_X ) must be equal to MOD( JY-1, NB_Y ).
103 *
104 * If INCX = M_X, INCY = 1 and INCY <> M_Y, NB_X must be equal to MB_Y.
105 * Moreover, the quantity MOD( JX-1, NB_X ) must be equal to
106 * MOD( IY-1, MB_Y ).
107 *
108 * If INCX = 1, INCX <> M_X and INCY = M_Y, MB_X must be equal to NB_Y.
109 * Moreover, the quantity MOD( IX-1, MB_X ) must be equal to
110 * MOD( JY-1, NB_Y ).
111 *
112 * If INCX = 1, INCX <> M_X, INCY = 1 and INCY <> M_Y, MB_X must be
113 * equal to MB_Y, and the process row having the first entries of
114 * sub( Y ) must also contain the first entries of sub( X ). Moreover,
115 * the quantity MOD( IX-1, MB_X ) must be equal to MOD( IY-1, MB_Y ).
116 *
117 *
118 * Parameters
119 * ==========
120 *
121 * N (global input) pointer to INTEGER
122 * The length of the distributed vectors to be multiplied.
123 * N >= 0.
124 *
125 * DOTC (local output) pointer to COMPLEX*16
126 * The dot product of sub( X ) and sub( Y ) only in their scope.
127 *
128 * X (local input) COMPLEX*16 array containing the local
129 * pieces of a distributed matrix of dimension of at least
130 * ( (JX-1)*M_X + IX + ( N - 1 )*abs( INCX ) )
131 * This array contains the entries of the distributed vector
132 * sub( X ).
133 *
134 * IX (global input) pointer to INTEGER
135 * The global row index of the submatrix of the distributed
136 * matrix X to operate on.
137 *
138 * JX (global input) pointer to INTEGER
139 * The global column index of the submatrix of the distributed
140 * matrix X to operate on.
141 *
142 * DESCX (global and local input) INTEGER array of dimension 8.
143 * The array descriptor of the distributed matrix X.
144 *
145 * INCX (global input) pointer to INTEGER
146 * The global increment for the elements of X. Only two values
147 * of INCX are supported in this version, namely 1 and M_X.
148 *
149 * Y (local input) COMPLEX*16 array containing the local
150 * pieces of a distributed matrix of dimension of at least
151 * ( (JY-1)*M_Y + IY + ( N - 1 )*abs( INCY ) )
152 * This array contains the entries of the distributed vector
153 * sub( Y ).
154 *
155 * IY (global input) pointer to INTEGER
156 * The global row index of the submatrix of the distributed
157 * matrix Y to operate on.
158 *
159 * JY (global input) pointer to INTEGER
160 * The global column index of the submatrix of the distributed
161 * matrix Y to operate on.
162 *
163 * DESCY (global and local input) INTEGER array of dimension 8.
164 * The array descriptor of the distributed matrix Y.
165 *
166 * INCY (global input) pointer to INTEGER
167 * The global increment for the elements of Y. Only two values
168 * of INCY are supported in this version, namely 1 and M_Y.
169 *
170 * =====================================================================
171 *
172 * .. Local Scalars ..
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;
178  complex16 xwork[1], ywork[1], zero;
179 /* ..
180 * .. PBLAS Buffer ..
181 */
182  complex16 * buff;
183 /* ..
184 * .. External Functions ..
185 */
186  void blacs_gridinfo_();
187  void zgebr2d_();
188  void zgebs2d_();
189  void zgerv2d_();
190  void zgesd2d_();
191  void zgsum2d_();
192  void pbchkvect();
193  void pberror_();
194  char * getpbbuf();
195  char * ptop();
196  F_VOID_FCT pbztrnv_();
197  F_VOID_FCT zzdotc_();
198  F_INTG_FCT ilcm_();
199 /* ..
200 * .. Executable Statements ..
201 *
202 * Get grid parameters
203 */
204  ictxt = desc_X[CTXT_];
205  blacs_gridinfo_( &ictxt, &nprow, &npcol, &myrow, &mycol );
206 /*
207 * Test the input parameters
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  { /* X is distributed along a process row */
225  if( *incy == desc_Y[M_] )
226  { /* Y is distributed over a process row */
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  { /* Y is distributed over a process column */
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  { /* X is distributed along a process column */
248  if( *incy == desc_Y[M_] )
249  { /* Y is distributed over a process row */
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  { /* Y is distributed over a process column */
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, "PZDOTC", &info );
281  return;
282  }
283 /*
284 * Quick return if possible.
285 */
286  dotc->re = ZERO;
287  dotc->im = ZERO;
288  zero.re = ZERO;
289  zero.im = ZERO;
290  if( *n == 0 ) return;
291 /*
292 * dot <- x^{h} * y
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  zzdotc_( n, dotc, 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  zzdotc_( n, dotc, xwork, n,
314  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], n );
315  }
316 
317  if( ( *incx == desc_X[M_] ) && ( desc_X[M_] != 1 ) )
318  {
319  if( myrow == ixrow )
320  {
321  rbtop = ptop( BROADCAST, ROW, TOPGET );
322  if( mycol == ixcol )
323  {
324  zgebs2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
325  &ione, &ione, dotc, &ione );
326  }
327  else
328  {
329  zgebr2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
330  &ione, &ione, dotc, &ione, &myrow, &ixcol );
331  }
332  }
333  }
334  else if( ( *incx == 1 ) && ( desc_X[M_] != 1 ) )
335  {
336  if( mycol == ixcol )
337  {
338  cbtop = ptop( BROADCAST, COLUMN, TOPGET );
339  if( myrow == ixrow )
340  {
341  zgebs2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cbtop ),
342  &ione, &ione, dotc, &ione );
343  }
344  else
345  {
346  zgebr2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cbtop ),
347  &ione, &ione, dotc, &ione, &ixrow, &mycol );
348  }
349  }
350  }
351 
352  if( ( *incy == desc_Y[M_] ) && ( desc_Y[M_] != 1 ) )
353  {
354  if( myrow == iyrow )
355  {
356  rbtop = ptop( BROADCAST, ROW, TOPGET );
357  if( mycol == iycol )
358  {
359  zgebs2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
360  &ione, &ione, dotc, &ione );
361  }
362  else
363  {
364  zgebr2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
365  &ione, &ione, dotc, &ione, &myrow, &iycol );
366  }
367  }
368  }
369  else if( ( *incy == 1 ) && ( desc_Y[M_] != 1 ) )
370  {
371  if( mycol == iycol )
372  {
373  cbtop = ptop( BROADCAST, COLUMN, TOPGET );
374  if( myrow == iyrow )
375  {
376  zgebs2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cbtop ),
377  &ione, &ione, dotc, &ione );
378  }
379  else
380  {
381  zgebr2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cbtop ),
382  &ione, &ione, dotc, &ione, &iyrow, &mycol );
383  }
384  }
385  }
386  return;
387  }
388 
389  if( ( *incx == desc_X[M_] ) && ( *incy == desc_Y[M_] ) )
390  { /* X and Y are both distributed over a process row */
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  {
400  rctop = ptop( COMBINE, ROW, TOPGET );
401  zzdotc_( &nq, dotc,
402  &X[iix-1+(jjx-1)*desc_X[LLD_]], &desc_X[LLD_],
403  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], &desc_Y[LLD_] );
404  zgsum2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rctop ), &ione,
405  &ione, dotc, &ione, &mone, &mycol );
406  }
407  }
408  else
409  {
410  if( myrow == ixrow )
411  {
412  rctop = ptop( COMBINE, ROW, TOPGET );
413  zgesd2d_( &ictxt, &ione, &nq,
414  &X[iix-1+(jjx-1)*desc_X[LLD_]], &desc_X[LLD_],
415  &iyrow, &mycol );
416  buff = (complex16 *)getpbbuf( "PZDOTC", nq*sizeof(complex16) );
417  zgerv2d_( &ictxt, &nq, &ione, buff, &ione,
418  &ixrow, &mycol );
419  zzdotc_( &nq, dotc, &X[iix-1+(jjx-1)*desc_X[LLD_]],
420  &desc_X[LLD_], buff, &ione );
421  zgsum2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rctop ), &ione,
422  &ione, dotc, &ione, &mone, &mycol );
423  }
424  else if( myrow == iyrow )
425  {
426  rctop = ptop( COMBINE, ROW, TOPGET );
427  zgesd2d_( &ictxt, &ione, &nq,
428  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], &desc_Y[LLD_],
429  &ixrow, &mycol );
430  buff = (complex16 *)getpbbuf( "PZDOTC", nq*sizeof(complex16) );
431  zgerv2d_( &ictxt, &nq, &ione, buff, &ione, &ixrow,
432  &mycol );
433  zzdotc_( &nq, dotc,
434  buff, &ione,
435  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], &desc_Y[LLD_] );
436  zgsum2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rctop ), &ione,
437  &ione, dotc, &ione, &mone, &mycol );
438  }
439  }
440  }
441  else if( ( *incx == 1 ) && ( *incx != desc_X[M_] ) &&
442  ( *incy == 1 ) && ( *incy != desc_Y[M_] ) )
443  { /* X and Y are both distributed over a process column */
444  nz = (*ix-1) % desc_X[MB_];
445  nn = *n + nz;
446  np = numroc_( &nn, &desc_X[MB_], &myrow, &ixrow, &nprow );
447  if( myrow == ixrow )
448  np -= nz;
449  if( ixcol == iycol )
450  {
451  if( mycol == ixcol )
452  {
453  cctop = ptop( COMBINE, COLUMN, TOPGET );
454  zzdotc_( &np, dotc,
455  &X[iix-1+(jjx-1)*desc_X[LLD_]], incx,
456  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], incy );
457  zgsum2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cctop ),
458  &ione, &ione, dotc, &ione, &mone, &mycol );
459  }
460  }
461  else
462  {
463  if( mycol == ixcol )
464  {
465  cctop = ptop( COMBINE, COLUMN, TOPGET );
466  zgesd2d_( &ictxt, &np, &ione,
467  &X[iix-1+(jjx-1)*desc_X[LLD_]], &desc_X[LLD_],
468  &myrow, &iycol );
469  buff = (complex16 *)getpbbuf( "PZDOTC", np*sizeof(complex16) );
470  zgerv2d_( &ictxt, &np, &ione, buff, &ione,
471  &myrow, &iycol );
472  zzdotc_( &np, dotc,
473  &X[iix-1+(jjx-1)*desc_X[LLD_]], incx,
474  buff, &ione );
475  zgsum2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cctop ),
476  &ione, &ione, dotc, &ione, &mone, &mycol );
477  }
478  else if( mycol == iycol )
479  {
480  cctop = ptop( COMBINE, COLUMN, TOPGET );
481  buff = (complex16 *)getpbbuf( "PZDOTC", np*sizeof(complex16) );
482  zgerv2d_( &ictxt, &np, &ione, buff, &ione,
483  &myrow, &ixcol );
484  zgesd2d_( &ictxt, &np, &ione,
485  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], &desc_Y[LLD_],
486  &myrow, &ixcol );
487  zzdotc_( &np, dotc,
488  buff, &ione,
489  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], incy );
490  zgsum2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cctop ),
491  &ione, &ione, dotc, &ione, &mone, &mycol );
492  }
493  }
494  }
495  else /* X and Y are not distributed along the same direction */
496  {
497  lcm = ilcm_( &nprow, &npcol );
498  if( ( *incx == 1 ) && ( *incx != desc_X[M_] ) )
499  { /* X is distributed over a process column */
500  lcmp = lcm / nprow;
501  nz = (*jy-1) % desc_Y[NB_];
502  nn = *n + nz;
503  tmp1 = nn / desc_Y[MB_];
504  np = numroc_( &nn, &desc_X[MB_], &myrow, &ixrow, &nprow );
505  np0 = MYROC0( tmp1, nn, desc_X[MB_], nprow );
506  tmp1 = np0 / desc_X[MB_];
507  wksz = MYROC0( tmp1, np0, desc_X[MB_], lcmp );
508  wksz = np + wksz;
509 
510  buff = (complex16 *)getpbbuf( "PZDOTC", wksz*sizeof(complex16) );
511 
512  if( mycol == iycol )
513  jjy -= nz;
514  if( myrow == ixrow )
515  np -= nz;
516  pbztrnv_( &ictxt, C2F_CHAR( "R" ), C2F_CHAR( "T" ), n,
517  &desc_Y[NB_], &nz, &Y[iiy-1+(jjy-1)*desc_Y[LLD_]],
518  &desc_Y[LLD_], &zero, buff, &ione, &iyrow, &iycol,
519  &ixrow, &ixcol, buff+np );
520  if( mycol == ixcol )
521  {
522  cctop = ptop( COMBINE, COLUMN, TOPGET );
523  zzdotc_( &np, dotc, &X[iix-1+(jjx-1)*desc_X[LLD_]],
524  incx, buff, &ione );
525  zgsum2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cctop ),
526  &ione, &ione, dotc, &ione, &mone, &mycol );
527  }
528  if( myrow == iyrow )
529  {
530  rbtop = ptop( BROADCAST, ROW, TOPGET );
531  if( mycol == ixcol )
532  zgebs2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
533  &ione, &ione, dotc, &ione );
534  else
535  zgebr2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
536  &ione, &ione, dotc, &ione, &myrow, &ixcol );
537  }
538  }
539  else /* Y is distributed over a process column */
540  {
541  lcmp = lcm / nprow;
542  nz = (*jx-1) % desc_X[NB_];
543  nn = *n + nz;
544  tmp1 = nn / desc_X[MB_];
545  np = numroc_( &nn, desc_Y+MB_, &myrow, &iyrow, &nprow );
546  np0 = MYROC0( tmp1, nn, desc_Y[MB_], nprow );
547  tmp1 = np0 / desc_Y[MB_];
548  wksz = MYROC0( tmp1, np0, desc_Y[MB_], lcmp );
549  wksz = np + wksz;
550 
551  buff = (complex16 *)getpbbuf( "PZDOTC", wksz*sizeof(complex16) );
552 
553  if( myrow == iyrow )
554  np -= nz;
555  pbztrnv_( &ictxt, C2F_CHAR( "R" ), C2F_CHAR( "T" ), n,
556  &desc_X[NB_], &nz, &X[iix-1+(jjx-1)*desc_X[LLD_]],
557  &desc_X[LLD_], &zero, buff, &ione, &ixrow, &ixcol,
558  &iyrow, &iycol, buff+np );
559  if( mycol == iycol )
560  {
561  cctop = ptop( COMBINE, COLUMN, TOPGET );
562  zzdotc_( &np, dotc, buff, &ione,
563  &Y[iiy-1+(jjy-1)*desc_Y[LLD_]], incy );
564  zgsum2d_( &ictxt, C2F_CHAR( COLUMN ), C2F_CHAR( cctop ),
565  &ione, &ione, dotc, &ione, &mone, &mycol );
566  }
567  if( myrow == ixrow )
568  {
569  rbtop = ptop( BROADCAST, ROW, TOPGET );
570  if( mycol == iycol )
571  zgebs2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
572  &ione, &ione, dotc, &ione );
573  else
574  zgebr2d_( &ictxt, C2F_CHAR( ROW ), C2F_CHAR( rbtop ),
575  &ione, &ione, dotc, &ione, &myrow, &iycol );
576  }
577  }
578  }
579 }
M_
#define M_
Definition: PBtools.h:39
ROW
#define ROW
Definition: PBblacs.h:46
getpbbuf
char * getpbbuf(char *mess, int length)
Definition: getpbbuf.c:3
MB_
#define MB_
Definition: PBtools.h:43
zgerv2d_
F_VOID_FUNC zgerv2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc)
Definition: zgerv2d_.c:6
TOPGET
#define TOPGET
Definition: pblas.h:151
complex16
Definition: pblas.h:93
NB_
#define NB_
Definition: PBtools.h:44
COLUMN
#define COLUMN
Definition: PBblacs.h:45
BROADCAST
#define BROADCAST
Definition: pblas.h:142
zgesd2d_
F_VOID_FUNC zgesd2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rdest, int *cdest)
Definition: zgesd2d_.c:7
zgebr2d_
F_VOID_FUNC zgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc)
Definition: zgebr2d_.c:7
complex16::re
double re
Definition: pblas.h:93
F_VOID_FCT
#define F_VOID_FCT
Definition: pblas.h:123
zgebs2d_
F_VOID_FUNC zgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda)
Definition: zgebs2d_.c:6
LLD_
#define LLD_
Definition: PBtools.h:47
ZERO
#define ZERO
Definition: PBtools.h:66
pzdotc_
void pzdotc_(int *n, complex16 *dotc, X, int *ix, int *jx, desc_X, int *incx, Y, int *iy, int *jy, desc_Y, int *incy)
Definition: pzdotc.c:15
blacs_gridinfo_
F_VOID_FUNC blacs_gridinfo_(int *ConTxt, int *nprow, int *npcol, int *myrow, int *mycol)
Definition: blacs_info_.c:6
complex16::im
double im
Definition: pblas.h:93
pbchkvect
void pbchkvect(int n, int npos0, int ix, int jx, desc_X, int incx, int dpos0, int *iix, int *jjx, int *ixrow, int *ixcol, int nprow, int npcol, int myrow, int mycol, int *info)
Definition: pbchkvect.c:15
pblas.h
COMBINE
#define COMBINE
Definition: PBblacs.h:49
F_INTG_FCT
#define F_INTG_FCT
Definition: pblas.h:124
C2F_CHAR
#define C2F_CHAR(a)
Definition: pblas.h:121
MYROC0
#define MYROC0(nblocks, n, nb, nprocs)
Definition: pblas.h:191
CTXT_
#define CTXT_
Definition: PBtools.h:38
zgsum2d_
F_VOID_FUNC zgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rdest, int *cdest)
Definition: zgsum2d_.c:8