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