ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
psasymv_.c
Go to the documentation of this file.
1 /* ---------------------------------------------------------------------
2 *
3 * -- PBLAS routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * ---------------------------------------------------------------------
9 */
10 /*
11 * Include files
12 */
13 #include "pblas.h"
14 #include "PBpblas.h"
15 #include "PBtools.h"
16 #include "PBblacs.h"
17 #include "PBblas.h"
18 
19 #ifdef __STDC__
20 void psasymv_( F_CHAR_T UPLO, int * N, float * ALPHA,
21  float * A, int * IA, int * JA, int * DESCA,
22  float * X, int * IX, int * JX, int * DESCX, int * INCX,
23  float * BETA,
24  float * Y, int * IY, int * JY, int * DESCY, int * INCY )
25 #else
26 void psasymv_( UPLO, N, ALPHA, A, IA, JA, DESCA, X, IX, JX, DESCX,
27  INCX, BETA, Y, IY, JY, DESCY, INCY )
28 /*
29 * .. Scalar Arguments ..
30 */
31  F_CHAR_T UPLO;
32  int * IA, * INCX, * INCY, * IX, * IY, * JA, * JX, * JY,
33  * N;
34  float * ALPHA, * BETA;
35 /*
36 * .. Array Arguments ..
37 */
38  int * DESCA, * DESCX, * DESCY;
39  float * A, * X, * Y;
40 #endif
41 {
42 /*
43 * Purpose
44 * =======
45 *
46 * PSASYMV performs the matrix-vector operation
47 *
48 * sub( Y ) := abs( alpha )*abs( sub( A ) )*abs( sub( X ) ) +
49 * abs( beta*sub( Y ) ),
50 *
51 * where
52 *
53 * sub( A ) denotes A(IA:IA+M-1,JA:JA+N-1),
54 *
55 * sub( X ) denotes X(IX,JX:JX+N-1) if INCX = M_X,
56 * X(IX:IX+N-1,JX) if INCX = 1 and INCX <> M_X, and,
57 *
58 * sub( Y ) denotes Y(IY,JY:JY+N-1) if INCY = M_Y,
59 * Y(IY:IY+N-1,JY) if INCY = 1 and INCY <> M_Y.
60 *
61 * Alpha and beta are real scalars, sub( Y ) is a n element real subvec-
62 * tor, sub( X ) is an n element subvector and sub( A ) is an n by n
63 * symmetric submatrix.
64 *
65 * Notes
66 * =====
67 *
68 * A description vector is associated with each 2D block-cyclicly dis-
69 * tributed matrix. This vector stores the information required to
70 * establish the mapping between a matrix entry and its corresponding
71 * process and memory location.
72 *
73 * In the following comments, the character _ should be read as
74 * "of the distributed matrix". Let A be a generic term for any 2D
75 * block cyclicly distributed matrix. Its description vector is DESC_A:
76 *
77 * NOTATION STORED IN EXPLANATION
78 * ---------------- --------------- ------------------------------------
79 * DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
80 * CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
81 * the NPROW x NPCOL BLACS process grid
82 * A is distributed over. The context
83 * itself is global, but the handle
84 * (the integer value) may vary.
85 * M_A (global) DESCA[ M_ ] The number of rows in the distribu-
86 * ted matrix A, M_A >= 0.
87 * N_A (global) DESCA[ N_ ] The number of columns in the distri-
88 * buted matrix A, N_A >= 0.
89 * IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
90 * block of the matrix A, IMB_A > 0.
91 * INB_A (global) DESCA[ INB_ ] The number of columns of the upper
92 * left block of the matrix A,
93 * INB_A > 0.
94 * MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
95 * bute the last M_A-IMB_A rows of A,
96 * MB_A > 0.
97 * NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
98 * bute the last N_A-INB_A columns of
99 * A, NB_A > 0.
100 * RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
101 * row of the matrix A is distributed,
102 * NPROW > RSRC_A >= 0.
103 * CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
104 * first column of A is distributed.
105 * NPCOL > CSRC_A >= 0.
106 * LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
107 * array storing the local blocks of
108 * the distributed matrix A,
109 * IF( Lc( 1, N_A ) > 0 )
110 * LLD_A >= MAX( 1, Lr( 1, M_A ) )
111 * ELSE
112 * LLD_A >= 1.
113 *
114 * Let K be the number of rows of a matrix A starting at the global in-
115 * dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
116 * that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
117 * receive if these K rows were distributed over NPROW processes. If K
118 * is the number of columns of a matrix A starting at the global index
119 * JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
120 * lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
121 * these K columns were distributed over NPCOL processes.
122 *
123 * The values of Lr() and Lc() may be determined via a call to the func-
124 * tion PB_Cnumroc:
125 * Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
126 * Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
127 *
128 * Arguments
129 * =========
130 *
131 * UPLO (global input) CHARACTER*1
132 * On entry, UPLO specifies whether the local pieces of
133 * the array A containing the upper or lower triangular part
134 * of the symmetric submatrix sub( A ) are to be referenced as
135 * follows:
136 *
137 * UPLO = 'U' or 'u' Only the local pieces corresponding to
138 * the upper triangular part of the
139 * symmetric submatrix sub( A ) are to be
140 * referenced,
141 *
142 * UPLO = 'L' or 'l' Only the local pieces corresponding to
143 * the lower triangular part of the
144 * symmetric submatrix sub( A ) are to be
145 * referenced.
146 *
147 * N (global input) INTEGER
148 * On entry, N specifies the order of the submatrix sub( A ).
149 * N must be at least zero.
150 *
151 * ALPHA (global input) REAL
152 * On entry, ALPHA specifies the scalar alpha. When ALPHA is
153 * supplied as zero then the local entries of the arrays A
154 * and X corresponding to the entries of the submatrix sub( A )
155 * and the subvector sub( X ) need not be set on input.
156 *
157 * A (local input) REAL array
158 * On entry, A is an array of dimension (LLD_A, Ka), where Ka is
159 * at least Lc( 1, JA+N-1 ). Before entry, this array contains
160 * the local entries of the matrix A.
161 * Before entry with UPLO = 'U' or 'u', this array contains
162 * the local entries of the upper triangular part of the
163 * symmetric submatrix sub( A ), and the local entries of the
164 * strictly lower triangular of sub( A ) are not referenced.
165 * Before entry with UPLO = 'L' or 'l', this array contains
166 * the local entries of the lower triangular part of the
167 * symmetric submatrix sub( A ), and the local entries of the
168 * strictly upper triangular of sub( A ) are not referenced.
169 *
170 * IA (global input) INTEGER
171 * On entry, IA specifies A's global row index, which points to
172 * the beginning of the submatrix sub( A ).
173 *
174 * JA (global input) INTEGER
175 * On entry, JA specifies A's global column index, which points
176 * to the beginning of the submatrix sub( A ).
177 *
178 * DESCA (global and local input) INTEGER array
179 * On entry, DESCA is an integer array of dimension DLEN_. This
180 * is the array descriptor for the matrix A.
181 *
182 * X (local input) REAL array
183 * On entry, X is an array of dimension (LLD_X, Kx), where LLD_X
184 * is at least MAX( 1, Lr( 1, IX ) ) when INCX = M_X and
185 * MAX( 1, Lr( 1, IX+N-1 ) ) otherwise, and, Kx is at least
186 * Lc( 1, JX+N-1 ) when INCX = M_X and Lc( 1, JX ) otherwise.
187 * Before entry, this array contains the local entries of the
188 * matrix X.
189 *
190 * IX (global input) INTEGER
191 * On entry, IX specifies X's global row index, which points to
192 * the beginning of the submatrix sub( X ).
193 *
194 * JX (global input) INTEGER
195 * On entry, JX specifies X's global column index, which points
196 * to the beginning of the submatrix sub( X ).
197 *
198 * DESCX (global and local input) INTEGER array
199 * On entry, DESCX is an integer array of dimension DLEN_. This
200 * is the array descriptor for the matrix X.
201 *
202 * INCX (global input) INTEGER
203 * On entry, INCX specifies the global increment for the
204 * elements of X. Only two values of INCX are supported in
205 * this version, namely 1 and M_X. INCX must not be zero.
206 *
207 * BETA (global input) REAL
208 * On entry, BETA specifies the scalar beta. When BETA is
209 * supplied as zero then the local entries of the array Y
210 * corresponding to the entries of the subvector sub( Y ) need
211 * not be set on input.
212 *
213 * Y (local input/local output) REAL array
214 * On entry, Y is an array of dimension (LLD_Y, Ky), where LLD_Y
215 * is at least MAX( 1, Lr( 1, IY ) ) when INCY = M_Y and
216 * MAX( 1, Lr( 1, IY+N-1 ) ) otherwise, and, Ky is at least
217 * Lc( 1, JY+N-1 ) when INCY = M_Y and Lc( 1, JY ) otherwise.
218 * Before entry, this array contains the local entries of the
219 * matrix Y. On exit, sub( Y ) is overwritten by the updated
220 * subvector.
221 *
222 * IY (global input) INTEGER
223 * On entry, IY specifies Y's global row index, which points to
224 * the beginning of the submatrix sub( Y ).
225 *
226 * JY (global input) INTEGER
227 * On entry, JY specifies Y's global column index, which points
228 * to the beginning of the submatrix sub( Y ).
229 *
230 * DESCY (global and local input) INTEGER array
231 * On entry, DESCY is an integer array of dimension DLEN_. This
232 * is the array descriptor for the matrix Y.
233 *
234 * INCY (global input) INTEGER
235 * On entry, INCY specifies the global increment for the
236 * elements of Y. Only two values of INCY are supported in
237 * this version, namely 1 and M_Y. INCY must not be zero.
238 *
239 * -- Written on April 1, 1998 by
240 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
241 *
242 * ---------------------------------------------------------------------
243 */
244 /*
245 * .. Local Scalars ..
246 */
247  char UploA, * one, top;
248  int Acol, Ai, Aii, Aimb1, Ainb1, Aj, Ajj, Akp, Akq, Ald, Amb, Amp,
249  Amp0, Anb, Anq, Anq0, Arow, XCfr, XCld, XRfr, XRld, Xi, Xj,
250  YCfr, YCpbY, YCsum, YCld, YRfr, YRpbY, YRsum, YRld, Ycol, Yi,
251  Yii, YisRow, Yj, Yjj, Yld, Ynp, Ynq, Yrow, ctxt, info, ione=1,
252  k, kb, ktmp, mycol, myrow, nb, npcol, nprow, size, upper,
253  usiz;
254  float * tbeta;
255  PBTYP_T * type, * utyp;
256 /*
257 * .. Local Arrays ..
258 */
259  int Ad [DLEN_], Ad0[DLEN_], XCd[DLEN_], XRd[DLEN_], Xd[DLEN_],
260  YCd[DLEN_], YRd[DLEN_], Yd [DLEN_];
261  char * Aptr = NULL, * XC = NULL, * XR = NULL, * YC = NULL,
262  * YR = NULL;
263 /* ..
264 * .. Executable Statements ..
265 *
266 */
267  upper = ( ( UploA = Mupcase( F2C_CHAR( UPLO )[0] ) ) == CUPPER );
268  PB_CargFtoC( *IA, *JA, DESCA, &Ai, &Aj, Ad );
269  PB_CargFtoC( *IX, *JX, DESCX, &Xi, &Xj, Xd );
270  PB_CargFtoC( *IY, *JY, DESCY, &Yi, &Yj, Yd );
271 #ifndef NO_ARGCHK
272 /*
273 * Test the input parameters
274 */
275  Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
276  if( !( info = ( ( nprow == -1 ) ? -( 701 + CTXT_ ) : 0 ) ) )
277  {
278  if( ( !upper ) && ( UploA != CLOWER ) )
279  {
280  PB_Cwarn( ctxt, __LINE__, __FILE__, "Illegal UPLO = %c\n", UploA );
281  info = -1;
282  }
283  PB_Cchkmat( ctxt, "PSASYMV", "A", *N, 2, *N, 2, Ai, Aj, Ad, 7, &info );
284  PB_Cchkvec( ctxt, "PSASYMV", "X", *N, 2, Xi, Xj, Xd, *INCX, 11, &info );
285  PB_Cchkvec( ctxt, "PSASYMV", "Y", *N, 2, Yi, Yj, Yd, *INCY, 17, &info );
286  }
287  if( info ) { PB_Cabort( ctxt, "PSASYMV", info ); return; }
288 #endif
289 /*
290 * Quick return if possible
291 */
292  if( ( *N == 0 ) ||
293  ( ( ALPHA[REAL_PART] == ZERO ) && ( BETA[REAL_PART] == ONE ) ) )
294  return;
295 /*
296 * Retrieve process grid information
297 */
298 #ifdef NO_ARGCHK
299  Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
300 #endif
301 /*
302 * Get type structure
303 */
304  type = utyp = PB_Cstypeset();
305  size = usiz = type->size;
306 /*
307 * and when alpha is zero
308 */
309  if( ALPHA[REAL_PART] == ZERO )
310  {
311 /*
312 * Retrieve sub( Y )'s local information: Yii, Yjj, Yrow, Ycol
313 */
314  PB_Cinfog2l( Yi, Yj, Yd, nprow, npcol, myrow, mycol, &Yii, &Yjj,
315  &Yrow, &Ycol );
316 
317  if( *INCY == Yd[M_] )
318  {
319 /*
320 * sub( Y ) resides in (a) process row(s)
321 */
322  if( ( myrow == Yrow ) || ( Yrow < 0 ) )
323  {
324 /*
325 * Make sure I own some data and scale sub( Y )
326 */
327  Ynq = PB_Cnumroc( *N, Yj, Yd[INB_], Yd[NB_], mycol, Yd[CSRC_],
328  npcol );
329  if( Ynq > 0 )
330  {
331  Yld = Yd[LLD_];
332  sascal_( &Ynq, ((char *) BETA), Mptr( ((char *) Y), Yii,
333  Yjj, Yld, usiz ), &Yld );
334  }
335  }
336  }
337  else
338  {
339 /*
340 * sub( Y ) resides in (a) process column(s)
341 */
342  if( ( mycol == Ycol ) || ( Ycol < 0 ) )
343  {
344 /*
345 * Make sure I own some data and scale sub( Y )
346 */
347  Ynp = PB_Cnumroc( *N, Yi, Yd[IMB_], Yd[MB_], myrow, Yd[RSRC_],
348  nprow );
349  if( Ynp > 0 )
350  {
351  sascal_( &Ynp, ((char *) BETA), Mptr( ((char *) Y), Yii,
352  Yjj, Yd[LLD_], usiz ), INCY );
353  }
354  }
355  }
356  return;
357  }
358 /*
359 * Compute descriptor Ad0 for sub( A )
360 */
361  PB_Cdescribe( *N, *N, Ai, Aj, Ad, nprow, npcol, myrow, mycol, &Aii, &Ajj,
362  &Ald, &Aimb1, &Ainb1, &Amb, &Anb, &Arow, &Acol, Ad0 );
363 /*
364 * Reuse sub( Y ) and/or create vectors YR in process rows and YC in process
365 * columns spanned by sub( A )
366 */
367  if( ( YisRow = ( *INCY == Yd[M_] ) ) != 0 )
368  {
369  PB_CInOutV( utyp, ROW, *N, *N, Ad0, 1, ((char *)BETA), ((char *) Y),
370  Yi, Yj, Yd, ROW, ((char**)(&tbeta)), &YR, YRd, &YRfr,
371  &YRsum, &YRpbY );
372  PB_COutV( utyp, COLUMN, INIT, *N, *N, Ad0, 1, &YC, YCd, &YCfr, &YCsum );
373  }
374  else
375  {
376  PB_CInOutV( utyp, COLUMN, *N, *N, Ad0, 1, ((char *)BETA), ((char *) Y),
377  Yi, Yj, Yd, COLUMN, ((char**)(&tbeta)), &YC, YCd, &YCfr,
378  &YCsum, &YCpbY );
379  PB_COutV( utyp, ROW, INIT, *N, *N, Ad0, 1, &YR, YRd, &YRfr, &YRsum );
380  }
381 /*
382 * Replicate sub( X ) in process rows (XR) and process columns (XC) spanned by
383 * sub( A )
384 */
385  if( *INCX == Xd[M_] )
386  {
387  PB_CInV( type, NOCONJG, ROW, *N, *N, Ad0, 1, ((char *) X), Xi, Xj, Xd,
388  ROW, &XR, XRd, &XRfr );
389  PB_CInV( type, NOCONJG, COLUMN, *N, *N, Ad0, 1, XR, 0, 0, XRd,
390  ROW, &XC, XCd, &XCfr );
391  }
392  else
393  {
394  PB_CInV( type, NOCONJG, COLUMN, *N, *N, Ad0, 1, ((char *) X), Xi, Xj, Xd,
395  COLUMN, &XC, XCd, &XCfr );
396  PB_CInV( type, NOCONJG, ROW, *N, *N, Ad0, 1, XC, 0, 0, XCd,
397  COLUMN, &XR, XRd, &XRfr );
398  }
399  one = type->one;
400 /*
401 * Local matrix-vector multiply iff I own some data
402 */
403  Aimb1 = Ad0[IMB_ ]; Ainb1 = Ad0[INB_ ]; Amb = Ad0[MB_]; Anb = Ad0[NB_];
404  Acol = Ad0[CSRC_]; Arow = Ad0[RSRC_];
405  Amp = PB_Cnumroc( *N, 0, Aimb1, Amb, myrow, Arow, nprow );
406  Anq = PB_Cnumroc( *N, 0, Ainb1, Anb, mycol, Acol, npcol );
407 
408  if( ( Amp > 0 ) && ( Anq > 0 ) )
409  {
410  Aptr = Mptr( ((char *) A), Aii, Ajj, Ald, size );
411 
412  XCld = XCd[LLD_]; XRld = XRd[LLD_]; YCld = YCd[LLD_]; YRld = YRd[LLD_];
413 /*
414 * Scale YR or YC in the case sub( Y ) has been reused
415 */
416  if( YisRow )
417  {
418 /*
419 * YR resides in (a) process row(s)
420 */
421  if( !YRpbY )
422  {
423  if( ( myrow == YRd[RSRC_] ) || ( YRd[RSRC_] < 0 ) )
424  {
425 /*
426 * Make sure I own some data and scale YR
427 */
428  if( Anq > 0 )
429  sascal_( &Anq, ((char *) tbeta), YR, &YRld );
430  }
431  }
432  }
433  else
434  {
435 /*
436 * YC resides in (a) process column(s)
437 */
438  if( !YCpbY )
439  {
440  if( ( mycol == YCd[CSRC_] ) || ( YCd[CSRC_] < 0 ) )
441  {
442 /*
443 * Make sure I own some data and scale YC
444 */
445  if( Amp > 0 )
446  sascal_( &Amp, ((char *) tbeta), YC, &ione );
447  }
448  }
449  }
450 /*
451 * Computational partitioning size is computed as the product of the logical
452 * value returned by pilaenv_ and 2 * lcm( nprow, npcol )
453 */
454  nb = 2 * pilaenv_( &ctxt, C2F_CHAR( &utyp->type ) ) *
455  PB_Clcm( ( Arow >= 0 ? nprow : 1 ), ( Acol >= 0 ? npcol : 1 ) );
456 
457  if( upper )
458  {
459  for( k = 0; k < *N; k += nb )
460  {
461  kb = *N - k; kb = MIN( kb, nb );
462  Akp = PB_Cnumroc( k, 0, Aimb1, Amb, myrow, Arow, nprow );
463  Akq = PB_Cnumroc( k, 0, Ainb1, Anb, mycol, Acol, npcol );
464  Anq0 = PB_Cnumroc( kb, k, Ainb1, Anb, mycol, Acol, npcol );
465  if( Akp > 0 && Anq0 > 0 )
466  {
467  sagemv_( C2F_CHAR( NOTRAN ), &Akp, &Anq0, ((char *)ALPHA),
468  Mptr( Aptr, 0, Akq, Ald, size ), &Ald, Mptr( XR, 0, Akq,
469  XRld, size ), &XRld, one, YC, &ione );
470  sagemv_( C2F_CHAR( TRAN ), &Akp, &Anq0, ((char *)ALPHA),
471  Mptr( Aptr, 0, Akq, Ald, size ), &Ald, XC, &ione, one,
472  Mptr( YR, 0, Akq, YRld, usiz ), &YRld );
473  }
474  PB_Cpsym( type, utyp, LEFT, UPPER, kb, 1, ((char *) ALPHA), Aptr, k,
475  k, Ad0, Mptr( XC, Akp, 0, XCld, size ), XCld, Mptr( XR, 0,
476  Akq, XRld, size ), XRld, Mptr( YC, Akp, 0, YCld, usiz ),
477  YCld, Mptr( YR, 0, Akq, YRld, usiz ), YRld, PB_Ctzasymv );
478  }
479  }
480  else
481  {
482  for( k = 0; k < *N; k += nb )
483  {
484  kb = *N - k; ktmp = k + ( kb = MIN( kb, nb ) );
485  Akp = PB_Cnumroc( k, 0, Aimb1, Amb, myrow, Arow, nprow );
486  Akq = PB_Cnumroc( k, 0, Ainb1, Anb, mycol, Acol, npcol );
487  PB_Cpsym( type, utyp, LEFT, LOWER, kb, 1, ((char *) ALPHA), Aptr, k,
488  k, Ad0, Mptr( XC, Akp, 0, XCld, size ), XCld, Mptr( XR, 0,
489  Akq, XRld, size ), XRld, Mptr( YC, Akp, 0, YCld, usiz ),
490  YCld, Mptr( YR, 0, Akq, YRld, usiz ), YRld, PB_Ctzasymv );
491  Akp = PB_Cnumroc( ktmp, 0, Aimb1, Amb, myrow, Arow, nprow );
492  Amp0 = Amp - Akp;
493  Anq0 = PB_Cnumroc( kb, k, Ainb1, Anb, mycol, Acol, npcol );
494  if( Amp0 > 0 && Anq0 > 0 )
495  {
496  sagemv_( C2F_CHAR( NOTRAN ), &Amp0, &Anq0, ((char *) ALPHA),
497  Mptr( Aptr, Akp, Akq, Ald, size ), &Ald, Mptr( XR, 0,
498  Akq, XRld, size ), &XRld, one, Mptr( YC, Akp, 0, YCld,
499  usiz ), &ione );
500  sagemv_( C2F_CHAR( TRAN ), &Amp0, &Anq0, ((char *) ALPHA),
501  Mptr( Aptr, Akp, Akq, Ald, size ), &Ald, Mptr( XC, Akp,
502  0, XCld, size ), &ione, one, Mptr( YR, 0, Akq, YRld,
503  usiz ), &YRld );
504  }
505  }
506  }
507  }
508  if( XCfr ) free( XC );
509  if( XRfr ) free( XR );
510 
511  if( YisRow )
512  {
513 /*
514 * Combine the partial column results into YC
515 */
516  if( YCsum )
517  {
518  YCd[CSRC_] = 0;
519  if( Amp > 0 )
520  {
521  top = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_GET );
522  Csgsum2d( ctxt, ROW, &top, Amp, 1, YC, YCd[LLD_], myrow, 0 );
523  }
524  }
525 /*
526 * Combine the partial row results into YR
527 */
528  if( YRsum && ( Anq > 0 ) )
529  {
530  top = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_GET );
531  Csgsum2d( ctxt, COLUMN, &top, 1, Anq, YR, YRd[LLD_], YRd[RSRC_],
532  mycol );
533  }
534 /*
535 * YR := YR + YC
536 */
537  PB_Cpaxpby( utyp, NOCONJG, *N, 1, one, YC, 0, 0, YCd, COLUMN, one,
538  YR, 0, 0, YRd, ROW );
539 /*
540 * sub( Y ) := beta * sub( Y ) + YR (if necessary)
541 */
542  if( YRpbY )
543  {
544 /*
545 * Retrieve sub( Y )'s local information: Yii, Yjj, Yrow, Ycol
546 */
547  PB_Cinfog2l( Yi, Yj, Yd, nprow, npcol, myrow, mycol, &Yii, &Yjj, &Yrow,
548  &Ycol );
549 /*
550 * sub( Y ) resides in (a) process row(s)
551 */
552  if( ( myrow == Yrow ) || Yrow < 0 )
553  {
554 /*
555 * Make sure I own some data and scale sub( Y )
556 */
557  Ynq = PB_Cnumroc( *N, Yj, Yd[INB_], Yd[NB_], mycol, Yd[CSRC_],
558  npcol );
559  if( Ynq > 0 )
560  {
561  Yld = Yd[LLD_];
562  sascal_( &Ynq, ((char *) BETA), Mptr( ((char *) Y), Yii,
563  Yjj, Yld, usiz ), &Yld );
564  }
565  }
566  PB_Cpaxpby( utyp, NOCONJG, 1, *N, one, YR, 0, 0, YRd, ROW, one,
567  ((char *) Y), Yi, Yj, Yd, ROW );
568  }
569  }
570  else
571  {
572 /*
573 * Combine the partial row results into YR
574 */
575  if( YRsum )
576  {
577  YRd[RSRC_] = 0;
578  if( Anq > 0 )
579  {
580  top = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_GET );
581  Csgsum2d( ctxt, COLUMN, &top, 1, Anq, YR, YRd[LLD_], 0,
582  mycol );
583  }
584  }
585 /*
586 * Combine the partial column results into YC
587 */
588  if( YCsum && ( Amp > 0 ) )
589  {
590  top = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_GET );
591  Csgsum2d( ctxt, ROW, &top, Amp, 1, YC, YCd[LLD_], myrow,
592  YCd[CSRC_] );
593  }
594 /*
595 * YC := YR + YC
596 */
597  PB_Cpaxpby( utyp, NOCONJG, 1, *N, one, YR, 0, 0, YRd, ROW, one,
598  YC, 0, 0, YCd, COLUMN );
599 /*
600 * sub( Y ) := beta * sub( Y ) + YC (if necessary)
601 */
602  if( YCpbY )
603  {
604 /*
605 * Retrieve sub( Y )'s local information: Yii, Yjj, Yrow, Ycol
606 */
607  PB_Cinfog2l( Yi, Yj, Yd, nprow, npcol, myrow, mycol, &Yii, &Yjj, &Yrow,
608  &Ycol );
609 /*
610 * sub( Y ) resides in (a) process column(s)
611 */
612  if( ( mycol == Ycol ) || Ycol < 0 )
613  {
614 /*
615 * Make sure I own some data and scale sub( Y )
616 */
617  Ynp = PB_Cnumroc( *N, Yi, Yd[IMB_], Yd[MB_], myrow, Yd[RSRC_],
618  nprow );
619  if( Ynp > 0 )
620  {
621  sascal_( &Ynp, ((char *) BETA), Mptr( ((char *) Y), Yii,
622  Yjj, Yd[LLD_], usiz ), INCY );
623  }
624  }
625  PB_Cpaxpby( utyp, NOCONJG, *N, 1, one, YC, 0, 0, YCd, COLUMN, one,
626  ((char *) Y), Yi, Yj, Yd, COLUMN );
627  }
628  }
629  if( YCfr ) free( YC );
630  if( YRfr ) free( YR );
631 /*
632 * End of PSASYMV
633 */
634 }
M_
#define M_
Definition: PBtools.h:39
ROW
#define ROW
Definition: PBblacs.h:46
MB_
#define MB_
Definition: PBtools.h:43
PB_Cpaxpby
void PB_Cpaxpby()
PB_Cwarn
void PB_Cwarn()
NB_
#define NB_
Definition: PBtools.h:44
COLUMN
#define COLUMN
Definition: PBblacs.h:45
CSRC_
#define CSRC_
Definition: PBtools.h:46
PB_Cpsym
void PB_Cpsym()
PBblacs.h
PBtools.h
PBblas.h
NOCONJG
#define NOCONJG
Definition: PBblas.h:45
REAL_PART
#define REAL_PART
Definition: pblas.h:135
PB_Ctzasymv
void PB_Ctzasymv()
PBTYP_T::type
char type
Definition: pblas.h:327
PBpblas.h
DLEN_
#define DLEN_
Definition: PBtools.h:48
TRAN
#define TRAN
Definition: PBblas.h:46
NOTRAN
#define NOTRAN
Definition: PBblas.h:44
LLD_
#define LLD_
Definition: PBtools.h:47
PB_Cdescribe
void PB_Cdescribe()
F_CHAR_T
char * F_CHAR_T
Definition: pblas.h:118
ZERO
#define ZERO
Definition: PBtools.h:66
PB_Cchkvec
void PB_Cchkvec()
UPPER
#define UPPER
Definition: PBblas.h:52
IMB_
#define IMB_
Definition: PBtools.h:41
pilaenv_
int pilaenv_()
INIT
#define INIT
Definition: PBblas.h:61
PB_Cabort
void PB_Cabort()
CLOWER
#define CLOWER
Definition: PBblas.h:25
LEFT
#define LEFT
Definition: PBblas.h:55
F2C_CHAR
#define F2C_CHAR(a)
Definition: pblas.h:120
TOP_GET
#define TOP_GET
Definition: PBblacs.h:50
PB_Ctop
char * PB_Ctop()
ONE
#define ONE
Definition: PBtools.h:64
RSRC_
#define RSRC_
Definition: PBtools.h:45
PBTYP_T::one
char * one
Definition: pblas.h:331
PB_CargFtoC
void PB_CargFtoC()
COMBINE
#define COMBINE
Definition: PBblacs.h:49
PBTYP_T::size
int size
Definition: pblas.h:329
PB_Cinfog2l
void PB_Cinfog2l()
PB_Cchkmat
void PB_Cchkmat()
sagemv_
F_VOID_FCT sagemv_()
PB_Cnumroc
int PB_Cnumroc()
PB_Cstypeset
PBTYP_T * PB_Cstypeset()
Definition: PB_Cstypeset.c:19
PB_CInV
void PB_CInV()
sascal_
F_VOID_FCT sascal_()
PB_CInOutV
void PB_CInOutV()
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
INB_
#define INB_
Definition: PBtools.h:42
LOWER
#define LOWER
Definition: PBblas.h:51
PB_COutV
void PB_COutV()
C2F_CHAR
#define C2F_CHAR(a)
Definition: pblas.h:121
Cblacs_gridinfo
void Cblacs_gridinfo()
PBTYP_T
Definition: pblas.h:325
Mupcase
#define Mupcase(C)
Definition: PBtools.h:83
pblas.h
CUPPER
#define CUPPER
Definition: PBblas.h:26
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CTXT_
#define CTXT_
Definition: PBtools.h:38
Csgsum2d
void Csgsum2d()
psasymv_
void psasymv_(F_CHAR_T UPLO, int *N, float *ALPHA, float *A, int *IA, int *JA, int *DESCA, float *X, int *IX, int *JX, int *DESCX, int *INCX, float *BETA, float *Y, int *IY, int *JY, int *DESCY, int *INCY)
Definition: psasymv_.c:26
PB_Clcm
int PB_Clcm()