SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
All Classes Files Functions Variables Typedefs Macros
pdasymv_.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 pdasymv_( 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 pdasymv_( 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* PDASYMV 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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 double * 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, "PDASYMV", "A", *N, 2, *N, 2, Ai, Aj, Ad, 7, &info );
284 PB_Cchkvec( ctxt, "PDASYMV", "X", *N, 2, Xi, Xj, Xd, *INCX, 11, &info );
285 PB_Cchkvec( ctxt, "PDASYMV", "Y", *N, 2, Yi, Yj, Yd, *INCY, 17, &info );
286 }
287 if( info ) { PB_Cabort( ctxt, "PDASYMV", 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_Cdtypeset();
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 dascal_( &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 dascal_( &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 dascal_( &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 dascal_( &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 dagemv_( 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 dagemv_( 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 dagemv_( 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 dagemv_( 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 Cdgsum2d( 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 Cdgsum2d( 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 dascal_( &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 Cdgsum2d( 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 Cdgsum2d( 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 dascal_( &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 PDASYMV
633*/
634}
#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 LOWER
Definition PBblas.h:51
#define INIT
Definition PBblas.h:61
#define UPPER
Definition PBblas.h:52
#define CLOWER
Definition PBblas.h:25
#define pdasymv_
Definition PBpblas.h:110
#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_Ctzasymv()
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_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
#define dascal_
Definition PBtools.h:674
PBTYP_T * PB_Cdtypeset()
#define Mupcase(C)
Definition PBtools.h:83
#define DLEN_
Definition PBtools.h:48
#define NB_
Definition PBtools.h:44
#define dagemv_
Definition PBtools.h:715
void PB_Cpaxpby()
void PB_Cdescribe()
char type
Definition pblas.h:331
Int size
Definition pblas.h:333
char * one
Definition pblas.h:336