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