SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pdsymm_.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 pdsymm_( F_CHAR_T SIDE, F_CHAR_T UPLO, Int * M, Int * N,
21 double * ALPHA,
22 double * A, Int * IA, Int * JA, Int * DESCA,
23 double * B, Int * IB, Int * JB, Int * DESCB,
24 double * BETA,
25 double * C, Int * IC, Int * JC, Int * DESCC )
26#else
27void pdsymm_( SIDE, UPLO, M, N, ALPHA, A, IA, JA, DESCA,
28 B, IB, JB, DESCB, BETA, C, IC, JC, DESCC )
29/*
30* .. Scalar Arguments ..
31*/
32 F_CHAR_T SIDE, UPLO;
33 Int * IA, * IB, * IC, * JA, * JB, * JC, * M, * N;
34 double * ALPHA, * BETA;
35/*
36* .. Array Arguments ..
37*/
38 Int * DESCA, * DESCB, * DESCC;
39 double * A, * B, * C;
40#endif
41{
42/*
43* Purpose
44* =======
45*
46* PDSYMM performs one of the matrix-matrix operations
47*
48* sub( C ) := alpha*sub( A )*sub( B ) + beta*sub( C ),
49*
50* or
51*
52* sub( C ) := alpha*sub( B )*sub( A ) + beta*sub( C ),
53*
54* where
55*
56* sub( C ) denotes C(IC:IC+M-1,JC:JC+N-1),
57*
58* sub( A ) denotes A(IA:IA+M-1,JA:JA+M-1) if SIDE = 'L',
59* A(IA:IA+N-1,JA:JA+N-1) if SIDE = 'R', and,
60*
61* sub( B ) denotes B(IB:IB+M-1,JB:JB+N-1).
62*
63* Alpha and beta are scalars, sub( A ) is a symmetric submatrix and
64* sub( B ) and sub( C ) are m by n submatrices.
65*
66* Notes
67* =====
68*
69* A description vector is associated with each 2D block-cyclicly dis-
70* tributed matrix. This vector stores the information required to
71* establish the mapping between a matrix entry and its corresponding
72* process and memory location.
73*
74* In the following comments, the character _ should be read as
75* "of the distributed matrix". Let A be a generic term for any 2D
76* block cyclicly distributed matrix. Its description vector is DESC_A:
77*
78* NOTATION STORED IN EXPLANATION
79* ---------------- --------------- ------------------------------------
80* DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
81* CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
82* the NPROW x NPCOL BLACS process grid
83* A is distributed over. The context
84* itself is global, but the handle
85* (the integer value) may vary.
86* M_A (global) DESCA[ M_ ] The number of rows in the distribu-
87* ted matrix A, M_A >= 0.
88* N_A (global) DESCA[ N_ ] The number of columns in the distri-
89* buted matrix A, N_A >= 0.
90* IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
91* block of the matrix A, IMB_A > 0.
92* INB_A (global) DESCA[ INB_ ] The number of columns of the upper
93* left block of the matrix A,
94* INB_A > 0.
95* MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
96* bute the last M_A-IMB_A rows of A,
97* MB_A > 0.
98* NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
99* bute the last N_A-INB_A columns of
100* A, NB_A > 0.
101* RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
102* row of the matrix A is distributed,
103* NPROW > RSRC_A >= 0.
104* CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
105* first column of A is distributed.
106* NPCOL > CSRC_A >= 0.
107* LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
108* array storing the local blocks of
109* the distributed matrix A,
110* IF( Lc( 1, N_A ) > 0 )
111* LLD_A >= MAX( 1, Lr( 1, M_A ) )
112* ELSE
113* LLD_A >= 1.
114*
115* Let K be the number of rows of a matrix A starting at the global in-
116* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
117* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
118* receive if these K rows were distributed over NPROW processes. If K
119* is the number of columns of a matrix A starting at the global index
120* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
121* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
122* these K columns were distributed over NPCOL processes.
123*
124* The values of Lr() and Lc() may be determined via a call to the func-
125* tion PB_Cnumroc:
126* Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
127* Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
128*
129* Arguments
130* =========
131*
132* SIDE (global input) CHARACTER*1
133* On entry, SIDE specifies whether the symmetric submatrix
134* sub( A ) appears on the left or right in the operation as
135* follows:
136*
137* SIDE = 'L' or 'l'
138* sub( C ) := alpha*sub( A )*sub( B ) + beta*sub( C ),
139*
140* SIDE = 'R' or 'r'
141* sub( C ) := alpha*sub( B )*sub( A ) + beta*sub( C ).
142*
143* UPLO (global input) CHARACTER*1
144* On entry, UPLO specifies whether the local pieces of
145* the array A containing the upper or lower triangular part
146* of the symmetric submatrix sub( A ) are to be referenced as
147* follows:
148*
149* UPLO = 'U' or 'u' Only the local pieces corresponding to
150* the upper triangular part of the
151* symmetric submatrix sub( A ) are to be
152* referenced,
153*
154* UPLO = 'L' or 'l' Only the local pieces corresponding to
155* the lower triangular part of the
156* symmetric submatrix sub( A ) are to be
157* referenced.
158*
159* M (global input) INTEGER
160* On entry, M specifies the number of rows of the submatrix
161* sub( C ). M must be at least zero.
162*
163* N (global input) INTEGER
164* On entry, N specifies the number of columns of the submatrix
165* sub( C ). N must be at least zero.
166*
167* ALPHA (global input) DOUBLE PRECISION
168* On entry, ALPHA specifies the scalar alpha. When ALPHA is
169* supplied as zero then the local entries of the arrays A and
170* B corresponding to the entries of the submatrices sub( A )
171* and sub( B ) respectively need not be set on input.
172*
173* A (local input) DOUBLE PRECISION array
174* On entry, A is an array of dimension (LLD_A, Ka), where Ka is
175* at least Lc( 1, JA+M-1 ) when SIDE = 'L' or 'l' and is at
176* at least Lc( 1, JA+N-1 ) otherwise. Before entry, this array
177* contains the local entries of the matrix A.
178* Before entry with SIDE = 'L' or 'l', this array contains
179* the local entries corresponding to the entries of the m by m
180* symmetric submatrix sub( A ), such that when UPLO = 'U' or
181* 'u', this array contains the local entries of the upper tri-
182* angular part of the symmetric submatrix sub( A ), and the
183* local entries of the strictly lower triangular of sub( A )
184* are not referenced, and when UPLO = 'L' or 'l', this array
185* contains the local entries of the lower triangular part of
186* the symmetric submatrix sub( A ), and the local entries of
187* the strictly upper triangular of sub( A ) are not referenced.
188* Before entry with SIDE = 'R' or 'r', this array contains
189* the local entries corresponding to the entries of the n by n
190* symmetric submatrix sub( A ), such that when UPLO = 'U' or
191* 'u', this array contains the local entries of the upper tri-
192* angular part of the symmetric submatrix sub( A ), and the
193* local entries of the strictly lower triangular of sub( A )
194* are not referenced, and when UPLO = 'L' or 'l', this array
195* contains the local entries of the lower triangular part of
196* the symmetric submatrix sub( A ), and the local entries of
197* the strictly upper triangular of sub( A ) are not referenced.
198*
199* IA (global input) INTEGER
200* On entry, IA specifies A's global row index, which points to
201* the beginning of the submatrix sub( A ).
202*
203* JA (global input) INTEGER
204* On entry, JA specifies A's global column index, which points
205* to the beginning of the submatrix sub( A ).
206*
207* DESCA (global and local input) INTEGER array
208* On entry, DESCA is an integer array of dimension DLEN_. This
209* is the array descriptor for the matrix A.
210*
211* B (local input) DOUBLE PRECISION array
212* On entry, B is an array of dimension (LLD_B, Kb), where Kb is
213* at least Lc( 1, JB+N-1 ). Before entry, this array contains
214* the local entries of the matrix B.
215*
216* IB (global input) INTEGER
217* On entry, IB specifies B's global row index, which points to
218* the beginning of the submatrix sub( B ).
219*
220* JB (global input) INTEGER
221* On entry, JB specifies B's global column index, which points
222* to the beginning of the submatrix sub( B ).
223*
224* DESCB (global and local input) INTEGER array
225* On entry, DESCB is an integer array of dimension DLEN_. This
226* is the array descriptor for the matrix B.
227*
228* BETA (global input) DOUBLE PRECISION
229* On entry, BETA specifies the scalar beta. When BETA is
230* supplied as zero then the local entries of the array C
231* corresponding to the entries of the submatrix sub( C ) need
232* not be set on input.
233*
234* C (local input/local output) DOUBLE PRECISION array
235* On entry, C is an array of dimension (LLD_C, Kc), where Kc is
236* at least Lc( 1, JC+N-1 ). Before entry, this array contains
237* the local entries of the matrix C.
238* On exit, the entries of this array corresponding to the local
239* entries of the submatrix sub( C ) are overwritten by the
240* local entries of the m by n updated submatrix.
241*
242* IC (global input) INTEGER
243* On entry, IC specifies C's global row index, which points to
244* the beginning of the submatrix sub( C ).
245*
246* JC (global input) INTEGER
247* On entry, JC specifies C's global column index, which points
248* to the beginning of the submatrix sub( C ).
249*
250* DESCC (global and local input) INTEGER array
251* On entry, DESCC is an integer array of dimension DLEN_. This
252* is the array descriptor for the matrix C.
253*
254* -- Written on April 1, 1998 by
255* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
256*
257* ---------------------------------------------------------------------
258*/
259/*
260* .. Local Scalars ..
261*/
262 char DirAB, SideOp, UploA, cbtop, cbtopsave, cctop, cctopsave,
263 rbtop, rbtopsave, rctop, rctopsave;
264 Int Ai, Aj, Bi, Bj, ChooseABC, Ci, Cj, ForceTop, ctxt, info,
265 lside, mycol, myrow, nb, npcol, nprow, upper;
266 double ABCest, BCest, tmp1, tmp2, tmp3, tmp4;
267 PBTYP_T * type;
268/*
269* .. Local Arrays ..
270*/
271 Int Ad[DLEN_], Bd[DLEN_], Cd[DLEN_];
272/* ..
273* .. Executable Statements ..
274*
275*/
276 lside = ( ( SideOp = Mupcase( F2C_CHAR( SIDE )[0] ) ) == CLEFT );
277 upper = ( ( UploA = Mupcase( F2C_CHAR( UPLO )[0] ) ) == CUPPER );
278 PB_CargFtoC( *IA, *JA, DESCA, &Ai, &Aj, Ad );
279 PB_CargFtoC( *IB, *JB, DESCB, &Bi, &Bj, Bd );
280 PB_CargFtoC( *IC, *JC, DESCC, &Ci, &Cj, Cd );
281#ifndef NO_ARGCHK
282/*
283* Test the input parameters
284*/
285 Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
286 if( !( info = ( ( nprow == -1 ) ? -( 901 + CTXT_ ) : 0 ) ) )
287 {
288 if( ( !lside ) && ( SideOp != CRIGHT ) )
289 {
290 PB_Cwarn( ctxt, __LINE__, "PDSYMM", "Illegal SIDE = %c\n", SideOp );
291 info = -1;
292 }
293 else if( ( !upper ) && ( UploA != CLOWER ) )
294 {
295 PB_Cwarn( ctxt, __LINE__, "PDSYMM", "Illegal UPLO = %c\n", UploA );
296 info = -2;
297 }
298 if( lside )
299 {
300 PB_Cchkmat( ctxt, "PDSYMM", "A", *M, 3, *M, 3, Ai, Aj, Ad, 9,
301 &info );
302 PB_Cchkmat( ctxt, "PDSYMM", "B", *M, 3, *N, 4, Bi, Bj, Bd, 13,
303 &info );
304 }
305 else
306 {
307 PB_Cchkmat( ctxt, "PDSYMM", "A", *N, 4, *N, 4, Ai, Aj, Ad, 9,
308 &info );
309 PB_Cchkmat( ctxt, "PDSYMM", "B", *M, 3, *N, 4, Bi, Bj, Bd, 13,
310 &info );
311 }
312 PB_Cchkmat( ctxt, "PDSYMM", "C", *M, 3, *N, 4, Ci, Cj, Cd, 18,
313 &info );
314 }
315 if( info ) { PB_Cabort( ctxt, "PDSYMM", info ); return; }
316#endif
317/*
318* Quick return if possible
319*/
320 if( ( *M == 0 ) || ( *N == 0 ) ||
321 ( ( ALPHA[REAL_PART] == ZERO ) && ( BETA[REAL_PART] == ONE ) ) )
322 return;
323/*
324* Get type structure
325*/
326 type = PB_Cdtypeset();
327/*
328* If alpha is zero, sub( C ) := beta * sub( C ).
329*/
330 if( ALPHA[REAL_PART] == ZERO )
331 {
332 if( BETA[REAL_PART] == ZERO )
333 {
334 PB_Cplapad( type, ALL, NOCONJG, *M, *N, type->zero, type->zero,
335 ((char * ) C), Ci, Cj, Cd );
336 }
337 else if( !( BETA[REAL_PART] == ONE ) )
338 {
339 PB_Cplascal( type, ALL, NOCONJG, *M, *N, ((char *) BETA), ((char *) C),
340 Ci, Cj, Cd );
341 }
342 return;
343 }
344/*
345* Start the operations
346*/
347#ifdef NO_ARGCHK
348 Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
349#endif
350/*
351* Algorithm selection is based on approximation of the communication volume
352* for distributed and aligned operands.
353*
354* ABCest: operands sub( A ), sub( B ) and sub( C ) are communicated (N >> M)
355* BCest : Both operands sub( B ) and sub( C ) are communicated (M >> N)
356*/
357 if( lside )
358 {
359 tmp1 = DNROC( *M, Ad[MB_], nprow ); tmp2 = DNROC( *N, Bd[NB_], npcol );
360 ABCest = (double)(*M) *
361 ( ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp1 / TWO ) +
362 ( ( ( Bd[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO :
363 tmp2 + tmp2 * CBRATIO ) );
364 tmp1 = DNROC( *M, Ad[MB_], nprow ); tmp2 = DNROC( *M, Ad[NB_], npcol );
365 tmp3 = DNROC( *M, Bd[MB_], nprow ); tmp4 = DNROC( *M, Cd[MB_], nprow );
366 BCest = (double)(*N) *
367 ( CBRATIO * ( npcol == 1 ? ZERO : tmp1 ) +
368 ( nprow == 1 ? ZERO : tmp2 ) + MAX( tmp2, tmp3 ) +
369 ( ( ( Bd[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp1 ) +
370 CBRATIO * ( nprow == 1 ? ZERO : tmp2 ) + MAX( tmp2, tmp4 ) );
371 }
372 else
373 {
374 tmp1 = DNROC( *N, Ad[NB_], npcol ); tmp2 = DNROC( *M, Bd[MB_], nprow );
375 ABCest = (double)(*N) *
376 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp1 / TWO ) +
377 ( ( ( Bd[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO :
378 tmp2 + tmp2 * CBRATIO ) );
379 tmp1 = DNROC( *N, Ad[MB_], nprow ); tmp2 = DNROC( *N, Ad[NB_], npcol );
380 tmp3 = DNROC( *N, Bd[NB_], npcol ); tmp4 = DNROC( *N, Cd[NB_], npcol );
381 BCest = (double)(*M) *
382 ( ( npcol == 1 ? ZERO : tmp1 ) + MAX( tmp1, tmp3 ) +
383 CBRATIO * ( nprow == 1 ? ZERO : tmp2 ) +
384 ( ( ( Bd[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp2 ) +
385 CBRATIO * ( npcol == 1 ? ZERO : tmp1 ) + MAX( tmp1, tmp4 ) );
386 }
387/*
388* Shift a little the cross-over point between both algorithms.
389*/
390 ChooseABC = ( ( 1.5 * ABCest ) <= BCest );
391/*
392* BLACS topologies are enforced iff M and N are strictly greater than the
393* logical block size returned by pilaenv_. Otherwise, it is assumed that the
394* routine calling this routine has already selected an adequate topology.
395*/
396 nb = pilaenv_( &ctxt, C2F_CHAR( &type->type ) );
397 ForceTop = ( ( *M > nb ) && ( *N > nb ) );
398
399 rbtop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_GET );
400 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_GET );
401 cbtop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_GET );
402 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_GET );
403
404 if( ChooseABC )
405 {
406 if( ForceTop )
407 {
408 rbtopsave = rbtop; rctopsave = rctop;
409 cbtopsave = cbtop; cctopsave = cctop;
410
411 if( lside )
412 {
413/*
414* No clear winner for the ring topologies, so that if a ring topology is
415* already selected, keep it.
416*/
417 if( ( rbtop != CTOP_DRING ) && ( rbtop != CTOP_IRING ) &&
418 ( rbtop != CTOP_SRING ) )
419 rbtop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_IRING );
420 if( ( ( cbtop != CTOP_DRING ) && ( cbtop != CTOP_IRING ) &&
421 ( cbtop != CTOP_SRING ) ) || ( cbtop != cctop ) )
422 {
423 cbtop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_IRING );
424 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_IRING );
425/*
426* Remove the next 2 lines when the BLACS combine operations support ring
427* topologies
428*/
429 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_DEFAULT );
430 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_DEFAULT );
431 }
432 }
433 else
434 {
435/*
436* No clear winner for the ring topologies, so that if a ring topology is
437* already selected, keep it.
438*/
439 if( ( cbtop != CTOP_DRING ) && ( cbtop != CTOP_IRING ) &&
440 ( cbtop != CTOP_SRING ) )
441 cbtop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_IRING );
442 if( ( ( rbtop != CTOP_DRING ) && ( rbtop != CTOP_IRING ) &&
443 ( rbtop != CTOP_SRING ) ) || ( rbtop != rctop ) )
444 {
445 rbtop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_IRING );
446 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_IRING );
447/*
448* Remove the next 2 lines when the BLACS combine operations support ring
449* topologies
450*/
451 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_DEFAULT );
452 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_DEFAULT );
453 }
454 }
455 }
456 if( lside )
457 DirAB = ( rbtop == CTOP_DRING ? CBACKWARD : CFORWARD );
458 else
459 DirAB = ( cbtop == CTOP_DRING ? CBACKWARD : CFORWARD );
460
461 PB_CpsymmAB( type, &DirAB, NOCONJG, &SideOp, &UploA, *M, *N,
462 ((char *)ALPHA), ((char *)A), Ai, Aj, Ad, ((char *)B), Bi,
463 Bj, Bd, ((char *)BETA), ((char *)C), Ci, Cj, Cd );
464 }
465 else
466 {
467 if( ForceTop )
468 {
469 rbtopsave = rbtop; rctopsave = rctop;
470 cbtopsave = cbtop; cctopsave = cctop;
471
472 if( lside )
473 {
474/*
475* No clear winner for the ring topologies, so that if a ring topology is
476* already selected, keep it.
477*/
478 if( ( ( rbtop != CTOP_DRING ) && ( rbtop != CTOP_IRING ) &&
479 ( rbtop != CTOP_SRING ) ) || ( rbtop != rctop ) )
480 {
481 rbtop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_IRING );
482 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_IRING );
483/*
484* Remove the next 2 lines when the BLACS combine operations support ring
485* topologies
486*/
487 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_DEFAULT );
488 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_DEFAULT );
489 }
490 cbtop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_DEFAULT );
491 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_DEFAULT );
492 }
493 else
494 {
495/*
496* No clear winner for the ring topologies, so that if a ring topology is
497* already selected, keep it.
498*/
499 if( ( ( cbtop != CTOP_DRING ) && ( cbtop != CTOP_IRING ) &&
500 ( cbtop != CTOP_SRING ) ) || ( cbtop != cctop ) )
501 {
502 cbtop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_IRING );
503 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_IRING );
504/*
505* Remove the next 2 lines when the BLACS combine operations support ring
506* topologies
507*/
508 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_DEFAULT );
509 cctop = *PB_Ctop( &ctxt, COMBINE, COLUMN, TOP_DEFAULT );
510 }
511 rbtop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_DEFAULT );
512 rctop = *PB_Ctop( &ctxt, COMBINE, ROW, TOP_DEFAULT );
513 }
514 }
515 if( lside )
516 DirAB = ( ( rbtop == CTOP_DRING || rctop == CTOP_DRING ) ?
518 else
519 DirAB = ( ( cbtop == CTOP_DRING || cctop == CTOP_DRING ) ?
521
522 PB_CpsymmBC( type, &DirAB, NOCONJG, &SideOp, &UploA, *M, *N,
523 ((char *)ALPHA), ((char *)A), Ai, Aj, Ad, ((char *)B), Bi,
524 Bj, Bd, ((char *)BETA), ((char *)C), Ci, Cj, Cd );
525 }
526/*
527* Restore the BLACS topologies when necessary.
528*/
529 if( ForceTop )
530 {
531 rbtopsave = *PB_Ctop( &ctxt, BCAST, ROW, &rbtopsave );
532 rctopsave = *PB_Ctop( &ctxt, COMBINE, ROW, &rctopsave );
533 cbtopsave = *PB_Ctop( &ctxt, BCAST, COLUMN, &cbtopsave );
534 cctopsave = *PB_Ctop( &ctxt, COMBINE, COLUMN, &cctopsave );
535 }
536/*
537* End of PDSYMM
538*/
539}
#define Int
Definition Bconfig.h:22
#define REAL_PART
Definition pblas.h:139
#define F2C_CHAR(a)
Definition pblas.h:124
#define CBRATIO
Definition pblas.h:37
#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 TOP_IRING
Definition PBblacs.h:52
#define CTOP_SRING
Definition PBblacs.h:29
#define TOP_DEFAULT
Definition PBblacs.h:51
#define ROW
Definition PBblacs.h:46
void Cblacs_gridinfo()
#define BCAST
Definition PBblacs.h:48
#define CTOP_IRING
Definition PBblacs.h:27
#define CTOP_DRING
Definition PBblacs.h:28
#define ALL
Definition PBblas.h:50
#define CLEFT
Definition PBblas.h:29
#define CBACKWARD
Definition PBblas.h:39
#define NOCONJG
Definition PBblas.h:45
#define CUPPER
Definition PBblas.h:26
#define CRIGHT
Definition PBblas.h:30
#define CFORWARD
Definition PBblas.h:38
#define CLOWER
Definition PBblas.h:25
#define pilaenv_
Definition PBpblas.h:44
#define pdsymm_
Definition PBpblas.h:157
#define CTXT_
Definition PBtools.h:38
#define MAX(a_, b_)
Definition PBtools.h:77
#define MB_
Definition PBtools.h:43
void PB_Cabort()
#define ONE
Definition PBtools.h:64
void PB_Cchkmat()
void PB_Cwarn()
char * PB_Ctop()
void PB_Cplapad()
void PB_Cplascal()
#define RSRC_
Definition PBtools.h:45
#define TWO
Definition PBtools.h:65
void PB_CpsymmBC()
void PB_CpsymmAB()
void PB_CargFtoC()
#define CSRC_
Definition PBtools.h:46
#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 DNROC(n_, nb_, p_)
Definition PBtools.h:111
char type
Definition pblas.h:331
char * zero
Definition pblas.h:335