SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
All Classes Files Functions Variables Typedefs Macros
pdsymv_.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__
20void pdsymv_( F_CHAR_T UPLO, Int * N, double * ALPHA,
21 double * A, Int * IA, Int * JA, Int * DESCA,
22 double * X, Int * IX, Int * JX, Int * DESCX, Int * INCX,
23 double * BETA,
24 double * Y, Int * IY, Int * JY, Int * DESCY, Int * INCY )
25#else
26void pdsymv_( 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 double * ALPHA, * BETA;
35/*
36* .. Array Arguments ..
37*/
38 Int * DESCA, * DESCX, * DESCY;
39 double * A, * X, * Y;
40#endif
41{
42/*
43* Purpose
44* =======
45*
46* PDSYMV 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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 double * 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, "PDSYMV", "A", *N, 2, *N, 2, Ai, Aj, Ad, 7, &info );
282 PB_Cchkvec( ctxt, "PDSYMV", "X", *N, 2, Xi, Xj, Xd, *INCX, 11, &info );
283 PB_Cchkvec( ctxt, "PDSYMV", "Y", *N, 2, Yi, Yj, Yd, *INCY, 17, &info );
284 }
285 if( info ) { PB_Cabort( ctxt, "PDSYMV", 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_Cdtypeset();
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 dset_( &Ynq, ((char *) BETA), Mptr( ((char *) Y), Yii,
332 Yjj, Yld, type->size ), &Yld );
333 }
334 else
335 {
336 dscal_( &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 dset_( &Ynp, ((char *) BETA), Mptr( ((char *) Y), Yii,
359 Yjj, Yd[LLD_], type->size ), INCY );
360 }
361 else
362 {
363 dscal_( &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 dset_( &Anq, ((char *) tbeta), YR, &YRld );
448 }
449 else
450 {
451 dscal_( &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 dset_( &Amp, ((char *) tbeta), YC, &ione );
474 }
475 else
476 {
477 dscal_( &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 dgemv_( 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 dgemv_( 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 dgemv_( 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 dgemv_( 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 Cdgsum2d( 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 Cdgsum2d( 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 Cdgsum2d( 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 Cdgsum2d( 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 PDSYMV
627*/
628}
#define Int
Definition Bconfig.h:22
#define REAL_PART
Definition pblas.h:139
#define F2C_CHAR(a)
Definition pblas.h:124
#define C2F_CHAR(a)
Definition pblas.h:125
char * F_CHAR_T
Definition pblas.h:122
#define TOP_GET
Definition PBblacs.h:50
#define COLUMN
Definition PBblacs.h:45
#define COMBINE
Definition PBblacs.h:49
#define ROW
Definition PBblacs.h:46
void Cblacs_gridinfo()
void Cdgsum2d()
#define NOTRAN
Definition PBblas.h:44
#define TRAN
Definition PBblas.h:46
#define LEFT
Definition PBblas.h:55
#define NOCONJG
Definition PBblas.h:45
#define CUPPER
Definition PBblas.h:26
#define dscal_
Definition PBblas.h:111
#define LOWER
Definition PBblas.h:51
#define dgemv_
Definition PBblas.h:140
#define INIT
Definition PBblas.h:61
#define UPPER
Definition PBblas.h:52
#define CLOWER
Definition PBblas.h:25
#define pdsymv_
Definition PBpblas.h:105
#define pilaenv_
Definition PBpblas.h:44
#define CTXT_
Definition PBtools.h:38
#define MB_
Definition PBtools.h:43
void PB_Cpsym()
void PB_Cabort()
#define ONE
Definition PBtools.h:64
void PB_Cchkvec()
void PB_Cinfog2l()
void PB_Cchkmat()
#define MIN(a_, b_)
Definition PBtools.h:76
#define Mptr(a_, i_, j_, lda_, siz_)
Definition PBtools.h:132
void PB_Cwarn()
#define LLD_
Definition PBtools.h:47
Int PB_Cnumroc()
char * PB_Ctop()
void PB_CInV()
void PB_Ctzsymv()
void PB_CInOutV()
#define RSRC_
Definition PBtools.h:45
void PB_COutV()
#define M_
Definition PBtools.h:39
#define INB_
Definition PBtools.h:42
void PB_CargFtoC()
#define CSRC_
Definition PBtools.h:46
Int PB_Clcm()
#define IMB_
Definition PBtools.h:41
#define ZERO
Definition PBtools.h:66
PBTYP_T * PB_Cdtypeset()
#define Mupcase(C)
Definition PBtools.h:83
#define DLEN_
Definition PBtools.h:48
#define NB_
Definition PBtools.h:44
#define dset_
Definition PBtools.h:664
void PB_Cpaxpby()
void PB_Cdescribe()
char type
Definition pblas.h:331
Int size
Definition pblas.h:333
char * one
Definition pblas.h:336