SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pdtrsm_.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 pdtrsm_( F_CHAR_T SIDE, F_CHAR_T UPLO, F_CHAR_T TRANS, F_CHAR_T DIAG,
21 Int * M, Int * N, double * ALPHA,
22 double * A, Int * IA, Int * JA, Int * DESCA,
23 double * B, Int * IB, Int * JB, Int * DESCB )
24#else
25void pdtrsm_( SIDE, UPLO, TRANS, DIAG, M, N, ALPHA,
26 A, IA, JA, DESCA, B, IB, JB, DESCB )
27/*
28* .. Scalar Arguments ..
29*/
30 F_CHAR_T DIAG, SIDE, TRANS, UPLO;
31 Int * IA, * IB, * JA, * JB, * M, * N;
32 double * ALPHA;
33/*
34* .. Array Arguments ..
35*/
36 Int * DESCA, * DESCB;
37 double * A, * B;
38#endif
39{
40/*
41* Purpose
42* =======
43*
44* PDTRSM solves one of the matrix equations
45*
46* op( sub( A ) )*X = alpha*sub( B ), or
47*
48* X*op( sub( A ) ) = alpha*sub( B ),
49*
50* where
51*
52* sub( A ) denotes A(IA:IA+M-1,JA:JA+M-1) if SIDE = 'L',
53* A(IA:IA+N-1,JA:JA+N-1) if SIDE = 'R', and,
54*
55* sub( B ) denotes B(IB:IB+M-1,JB:JB+N-1).
56*
57* Alpha is a scalar, X and sub( B ) are m by n submatrices, sub( A ) is
58* a unit, or non-unit, upper or lower triangular submatrix and op( Y )
59* is one of
60*
61* op( Y ) = Y or op( Y ) = Y'.
62*
63* The submatrix X is overwritten on sub( B ).
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* SIDE (global input) CHARACTER*1
132* On entry, SIDE specifies whether op( sub( A ) ) appears on
133* the left or right of X as follows:
134*
135* SIDE = 'L' or 'l' op( sub( A ) )*X = alpha*sub( B ),
136*
137* SIDE = 'R' or 'r' X*op( sub( A ) ) = alpha*sub( B ).
138*
139* UPLO (global input) CHARACTER*1
140* On entry, UPLO specifies whether the submatrix sub( A ) is
141* an upper or lower triangular submatrix as follows:
142*
143* UPLO = 'U' or 'u' sub( A ) is an upper triangular
144* submatrix,
145*
146* UPLO = 'L' or 'l' sub( A ) is a lower triangular
147* submatrix.
148*
149* TRANSA (global input) CHARACTER*1
150* On entry, TRANSA specifies the form of op( sub( A ) ) to be
151* used in the matrix multiplication as follows:
152*
153* TRANSA = 'N' or 'n' op( sub( A ) ) = sub( A ),
154*
155* TRANSA = 'T' or 't' op( sub( A ) ) = sub( A )',
156*
157* TRANSA = 'C' or 'c' op( sub( A ) ) = sub( A )'.
158*
159* DIAG (global input) CHARACTER*1
160* On entry, DIAG specifies whether or not sub( A ) is unit
161* triangular as follows:
162*
163* DIAG = 'U' or 'u' sub( A ) is assumed to be unit trian-
164* gular,
165*
166* DIAG = 'N' or 'n' sub( A ) is not assumed to be unit tri-
167* angular.
168*
169* M (global input) INTEGER
170* On entry, M specifies the number of rows of the submatrix
171* sub( B ). M must be at least zero.
172*
173* N (global input) INTEGER
174* On entry, N specifies the number of columns of the submatrix
175* sub( B ). N must be at least zero.
176*
177* ALPHA (global input) DOUBLE PRECISION
178* On entry, ALPHA specifies the scalar alpha. When ALPHA is
179* supplied as zero then the local entries of the array B
180* corresponding to the entries of the submatrix sub( B ) need
181* not be set on input.
182*
183* A (local input) DOUBLE PRECISION array
184* On entry, A is an array of dimension (LLD_A, Ka), where Ka is
185* at least Lc( 1, JA+M-1 ) when SIDE = 'L' or 'l' and is at
186* least Lc( 1, JA+N-1 ) otherwise. Before entry, this array
187* contains the local entries of the matrix A.
188* Before entry with UPLO = 'U' or 'u', this array contains the
189* local entries corresponding to the entries of the upper tri-
190* angular submatrix sub( A ), and the local entries correspon-
191* ding to the entries of the strictly lower triangular part of
192* the submatrix sub( A ) are not referenced.
193* Before entry with UPLO = 'L' or 'l', this array contains the
194* local entries corresponding to the entries of the lower tri-
195* angular submatrix sub( A ), and the local entries correspon-
196* ding to the entries of the strictly upper triangular part of
197* the submatrix sub( A ) are not referenced.
198* Note that when DIAG = 'U' or 'u', the local entries corres-
199* ponding to the diagonal elements of the submatrix sub( A )
200* are not referenced either, but are assumed to be unity.
201*
202* IA (global input) INTEGER
203* On entry, IA specifies A's global row index, which points to
204* the beginning of the submatrix sub( A ).
205*
206* JA (global input) INTEGER
207* On entry, JA specifies A's global column index, which points
208* to the beginning of the submatrix sub( A ).
209*
210* DESCA (global and local input) INTEGER array
211* On entry, DESCA is an integer array of dimension DLEN_. This
212* is the array descriptor for the matrix A.
213*
214* B (local input/local output) DOUBLE PRECISION array
215* On entry, B is an array of dimension (LLD_B, Kb), where Kb is
216* at least Lc( 1, JB+N-1 ). Before entry, this array contains
217* the local entries of the matrix B.
218* On exit, the local entries of this array corresponding to the
219* to the entries of the submatrix sub( B ) are overwritten by
220* the local entries of the m by n solution submatrix.
221*
222* IB (global input) INTEGER
223* On entry, IB specifies B's global row index, which points to
224* the beginning of the submatrix sub( B ).
225*
226* JB (global input) INTEGER
227* On entry, JB specifies B's global column index, which points
228* to the beginning of the submatrix sub( B ).
229*
230* DESCB (global and local input) INTEGER array
231* On entry, DESCB is an integer array of dimension DLEN_. This
232* is the array descriptor for the matrix B.
233*
234* -- Written on April 1, 1998 by
235* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
236*
237* ---------------------------------------------------------------------
238*/
239/*
240* .. Local Scalars ..
241*/
242 char DiagA, DirB, OpC, OpR, SideOp, TopC, TopR, TranOp, UploA,
243 Var, ctop, ctopsave, rtop, rtopsave;
244 Int Ai, Aj, Bi, Bj, ChooseAB, ForceTop, ctxt, info, itmp, lside,
245 mycol, myrow, nb, notran, nounit, npcol, nprow, upper;
246 double ABestL, ABestR, Best, tmp1, tmp2, tmp3, tmp4;
247 PBTYP_T * type;
248/*
249* .. Local Arrays ..
250*/
251 Int Ad[DLEN_], Bd[DLEN_];
252/* ..
253* .. Executable Statements ..
254*
255*/
256 lside = ( ( SideOp = Mupcase( F2C_CHAR( SIDE )[0] ) ) == CLEFT );
257 upper = ( ( UploA = Mupcase( F2C_CHAR( UPLO )[0] ) ) == CUPPER );
258 notran = ( ( TranOp = Mupcase( F2C_CHAR( TRANS )[0] ) ) == CNOTRAN );
259 nounit = ( ( DiagA = Mupcase( F2C_CHAR( DIAG )[0] ) ) == CNOUNIT );
260 PB_CargFtoC( *IA, *JA, DESCA, &Ai, &Aj, Ad );
261 PB_CargFtoC( *IB, *JB, DESCB, &Bi, &Bj, Bd );
262#ifndef NO_ARGCHK
263/*
264* Test the input parameters
265*/
266 Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
267 if( !( info = ( ( nprow == -1 ) ? -( 1101 + CTXT_ ) : 0 ) ) )
268 {
269 if( ( !lside ) && ( SideOp != CRIGHT ) )
270 {
271 PB_Cwarn( ctxt, __LINE__, "PDTRSM", "Illegal SIDE = %c\n", SideOp );
272 info = -1;
273 }
274 else if( ( !upper ) && ( UploA != CLOWER ) )
275 {
276 PB_Cwarn( ctxt, __LINE__, "PDTRSM", "Illegal UPLO = %c\n", UploA );
277 info = -2;
278 }
279 else if( ( !notran ) && ( TranOp != CTRAN ) && ( TranOp != CCOTRAN ) )
280 {
281 PB_Cwarn( ctxt, __LINE__, "PDTRSM", "Illegal TRANS = %c\n", TranOp );
282 info = -3;
283 }
284 else if( ( !nounit ) && ( DiagA != CUNIT ) )
285 {
286 PB_Cwarn( ctxt, __LINE__, "PDTRSM", "Illegal DIAG = %c\n", DiagA );
287 info = -4;
288 }
289 if( lside )
290 PB_Cchkmat( ctxt, "PDTRSM", "A", *M, 5, *M, 5, Ai, Aj, Ad, 11,
291 &info );
292 else
293 PB_Cchkmat( ctxt, "PDTRSM", "A", *N, 6, *N, 6, Ai, Aj, Ad, 11,
294 &info );
295 PB_Cchkmat( ctxt, "PDTRSM", "B", *M, 5, *N, 6, Bi, Bj, Bd, 15,
296 &info );
297 }
298 if( info ) { PB_Cabort( ctxt, "PDTRSM", info ); return; }
299#endif
300/*
301* Quick return if possible
302*/
303 if( *M == 0 || *N == 0 ) return;
304/*
305* Get type structure
306*/
307 type = PB_Cdtypeset();
308/*
309* And when alpha is zero
310*/
311 if( ALPHA[REAL_PART] == ZERO )
312 {
313 PB_Cplapad( type, ALL, NOCONJG, *M, *N, type->zero, type->zero,
314 ((char *) B), Bi, Bj, Bd );
315 return;
316 }
317/*
318* Start the operations
319*/
320#ifdef NO_ARGCHK
321 Cblacs_gridinfo( ( ctxt = Ad[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
322#endif
323/*
324* Algorithm selection is based on approximation of the communication volume
325* for distributed and aligned operands.
326*/
327 nb = pilaenv_( &ctxt, C2F_CHAR( &type->type ) );
328/*
329* ABestR, ABestL : both operands sub( A ) and sub( B ) are communicated
330* ( N >> M when SIDE is left and M >> N otherwise )
331* Best : only sub( B ) is communicated
332* ( M >> N when SIDE is left and N >> M otherwise )
333*/
334 if( lside )
335 {
336 if( notran )
337 {
338 tmp1 = DNROC( *M, Ad[MB_], nprow ); tmp4 = DNROC( *N, Bd[NB_], npcol );
339 ABestR = (double)(*M) *
340 ( ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp1 / TWO ) +
341 ( ( ( Bd[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp4 ) );
342 itmp = MIN( Ad[MB_], Ad[NB_] );
343 Best = (double)(*N) *
344 ( (double)(CEIL( *M, itmp )) * (double)(itmp) *
345 ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : ONE ) +
346 ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : ONE ) );
347 ChooseAB = ( ABestR <= ( 2.0 * Best ) );
348 }
349 else
350 {
351 tmp1 = DNROC( *M, Ad[MB_], nprow ); tmp2 = DNROC( *M, Ad[NB_], npcol );
352 tmp4 = DNROC( *N, Bd[NB_], npcol );
353 ABestL = (double)(*M) *
354 ( ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp1 / TWO ) +
355 CBRATIO *
356 ( ( ( Bd[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp4 ) );
357 ABestR = (double)(*M) *
358 ( ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp1 / TWO ) +
359 ( ( ( Bd[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp4 ) +
360 MAX( tmp2, tmp1 ) / TWO );
361 itmp = MIN( Ad[MB_], Ad[NB_] );
362 tmp2 = DNROC( *M, Ad[NB_], npcol ); tmp3 = DNROC( *M, Bd[MB_], nprow );
363 Best = (double)(*N) *
364 ( (double)(CEIL( *M, itmp )) * (double)(itmp) *
365 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : ONE ) +
366 ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : ONE ) ) +
367 MAX( tmp2, tmp3 ) );
368 ChooseAB = ( ( ABestL <= ( 2.0 * Best ) ) ||
369 ( ABestR <= ( 2.0 * Best ) ) );
370 }
371 }
372 else
373 {
374 if( notran )
375 {
376 tmp2 = DNROC( *N, Ad[NB_], npcol ); tmp3 = DNROC( *M, Bd[MB_], nprow );
377 ABestR = (double)(*N) *
378 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp2 / TWO ) +
379 ( ( ( Bd[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp3 ) );
380 itmp = MIN( Ad[MB_], Ad[NB_] );
381 Best = (double)(*M) *
382 ( (double)(CEIL( *N, itmp )) * (double)(itmp) *
383 ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : ONE ) +
384 ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : ONE ) );
385 ChooseAB = ( ABestR <= ( 2.0 * Best ) );
386 }
387 else
388 {
389 tmp1 = DNROC( *N, Ad[MB_], nprow ); tmp2 = DNROC( *N, Ad[NB_], npcol );
390 tmp3 = DNROC( *M, Bd[MB_], nprow );
391 ABestL = (double)(*N) *
392 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp2 / TWO ) +
393 CBRATIO *
394 ( ( ( Bd[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp3 ) );
395 ABestR = (double)(*N) *
396 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : tmp2 / TWO ) +
397 ( ( ( Bd[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : tmp3 ) +
398 MAX( tmp2, tmp1 ) / TWO );
399 itmp = MIN( Ad[MB_], Ad[NB_] );
400 tmp1 = DNROC( *N, Ad[MB_], nprow ); tmp4 = DNROC( *N, Bd[NB_], npcol );
401 Best = (double)(*M) *
402 ( (double)(CEIL( *N, itmp )) * (double)(itmp) *
403 ( ( ( ( Ad[RSRC_] == -1 ) || ( nprow == 1 ) ) ? ZERO : ONE ) +
404 ( ( ( Ad[CSRC_] == -1 ) || ( npcol == 1 ) ) ? ZERO : ONE ) ) +
405 MAX( tmp1, tmp4 ) );
406 ChooseAB = ( ( ABestL <= ( 2.0 * Best ) ) ||
407 ( ABestR <= ( 2.0 * Best ) ) );
408 }
409 }
410
411/*
412* Var can remain uninitialized but is nevertheless used in PB_CptrsmAB.c
413* provide a default here. TODO: does this make sense ?
414*==19891== at 0x44F81B: PB_CptrsmAB (PB_CptrsmAB.c:538)
415*==19891== by 0x427BE7: pdtrsm_ (pdtrsm_.c:488)
416*==19891== by 0x405E46: MAIN_ (pdblas3tim.f:727)
417*/
418 Var = CRIGHT;
419
420 if( ChooseAB )
421 {
422/*
423* BLACS topologies are enforced iff M and N are strictly greater than the
424* logical block size returned by pilaenv_. Otherwise, it is assumed that the
425* routine calling this routine has already selected an adequate topology.
426*/
427 ForceTop = ( ( *M > nb ) && ( *N > nb ) );
428
429 if( ForceTop )
430 {
431 if( lside )
432 {
433 if( notran )
434 {
435 OpR = CBCAST; OpC = CBCAST; Var = CRIGHT;
436 if( upper ) { TopR = TopC = CTOP_DRING; }
437 else { TopR = TopC = CTOP_IRING; }
438 }
439 else
440 {
441 if( ABestL <= ABestR )
442 {
443 OpR = CBCAST; OpC = CCOMBINE; Var = CLEFT;
444 if( upper ) { TopR = TopC = CTOP_IRING; }
445 else { TopR = TopC = CTOP_DRING; }
446 }
447 else
448 {
449 OpR = CBCAST; OpC = CBCAST; Var = CRIGHT;
450 if( upper ) { TopR = TopC = CTOP_IRING; }
451 else { TopR = TopC = CTOP_DRING; }
452 }
453 }
454 }
455 else
456 {
457 if( notran )
458 {
459 OpR = CBCAST; OpC = CBCAST; Var = CRIGHT;
460 if( upper ) { TopR = TopC = CTOP_IRING; }
461 else { TopR = TopC = CTOP_DRING; }
462 }
463 else
464 {
465 if( ABestL <= ABestR )
466 {
467 OpR = CCOMBINE; OpC = CBCAST; Var = CLEFT;
468 if( upper ) { TopR = TopC = CTOP_DRING; }
469 else { TopR = TopC = CTOP_IRING; }
470 }
471 else
472 {
473 OpR = CBCAST; OpC = CBCAST; Var = CRIGHT;
474 if( upper ) { TopR = TopC = CTOP_DRING; }
475 else { TopR = TopC = CTOP_IRING; }
476 }
477 }
478 }
479
480 rtop = *PB_Ctop( &ctxt, &OpR, ROW, TOP_GET );
481 ctop = *PB_Ctop( &ctxt, &OpC, COLUMN, TOP_GET );
482
483 if( ( rtopsave = rtop ) != TopR )
484 rtop = *PB_Ctop( &ctxt, &OpR, ROW, &TopR );
485 if( ( ctopsave = ctop ) != TopC )
486 ctop = *PB_Ctop( &ctxt, &OpC, COLUMN, &TopC );
487/*
488* Remove the next 4 lines when the BLACS combine operations support ring
489* topologies
490*/
491 if( OpR == CCOMBINE )
492 rtop = *PB_Ctop( &ctxt, &OpR, ROW, TOP_DEFAULT );
493 if( OpC == CCOMBINE )
494 ctop = *PB_Ctop( &ctxt, &OpC, COLUMN, TOP_DEFAULT );
495 }
496
497 PB_CptrsmAB( type, &Var, &SideOp, &UploA, ( notran ? NOTRAN : TRAN ),
498 &DiagA, *M, *N, ((char *)ALPHA), ((char *)A), Ai, Aj, Ad,
499 ((char *)B), Bi, Bj, Bd );
500/*
501* Restore the BLACS topologies when necessary.
502*/
503 if( ForceTop )
504 {
505 rtopsave = *PB_Ctop( &ctxt, &OpR, ROW, &rtopsave );
506 ctopsave = *PB_Ctop( &ctxt, &OpC, COLUMN, &ctopsave );
507 }
508 }
509 else
510 {
511/*
512* BLACS topologies are always enforced.
513*/
514 if( ( lside && notran ) || ( !lside && !notran ) )
515 {
516 OpR = CCOMBINE; OpC = CBCAST;
517 if( upper ) { TopR = TopC = CTOP_DRING; }
518 else { TopR = TopC = CTOP_IRING; }
519/*
520* Remove the next line when the BLACS combine operations support ring
521* topologies
522*/
523 TopR = CTOP_DEFAULT;
524 }
525 else
526 {
527 OpR = CBCAST; OpC = CCOMBINE;
528 if( upper ) { TopR = TopC = CTOP_IRING; }
529 else { TopR = TopC = CTOP_DRING; }
530/*
531* Remove the next line when the BLACS combine operations support ring
532* topologies
533*/
534 TopC = CTOP_DEFAULT;
535 }
536
537 rtop = *PB_Ctop( &ctxt, &OpR, ROW, TOP_GET );
538 ctop = *PB_Ctop( &ctxt, &OpC, COLUMN, TOP_GET );
539
540 if( ( rtopsave = rtop ) != TopR )
541 rtop = *PB_Ctop( &ctxt, &OpR, ROW, &TopR );
542 if( ( ctopsave = ctop ) != TopC )
543 ctop = *PB_Ctop( &ctxt, &OpC, COLUMN, &TopC );
544
545 if( lside ) DirB = ( rtop == CTOP_DRING ? CBACKWARD : CFORWARD );
546 else DirB = ( ctop == CTOP_DRING ? CBACKWARD : CFORWARD );
547
548 PB_CptrsmB( type, &DirB, &SideOp, &UploA, ( notran ? NOTRAN : TRAN ),
549 &DiagA, *M, *N, ((char *)ALPHA), ((char *)A), Ai, Aj, Ad,
550 ((char *)B), Bi, Bj, Bd );
551/*
552* Restore the BLACS topologies.
553*/
554 rtopsave = *PB_Ctop( &ctxt, &OpR, ROW, &rtopsave );
555 ctopsave = *PB_Ctop( &ctxt, &OpC, COLUMN, &ctopsave );
556 }
557/*
558* End of PDTRSM
559*/
560}
Int
#define Int
Definition Bconfig.h:22
REAL_PART
#define REAL_PART
Definition pblas.h:139
F2C_CHAR
#define F2C_CHAR(a)
Definition pblas.h:124
CBRATIO
#define CBRATIO
Definition pblas.h:37
C2F_CHAR
#define C2F_CHAR(a)
Definition pblas.h:125
F_CHAR_T
char * F_CHAR_T
Definition pblas.h:122
TOP_GET
#define TOP_GET
Definition PBblacs.h:50
COLUMN
#define COLUMN
Definition PBblacs.h:45
TOP_DEFAULT
#define TOP_DEFAULT
Definition PBblacs.h:51
CCOMBINE
#define CCOMBINE
Definition PBblacs.h:24
ROW
#define ROW
Definition PBblacs.h:46
CTOP_DEFAULT
#define CTOP_DEFAULT
Definition PBblacs.h:26
CBCAST
#define CBCAST
Definition PBblacs.h:23
Cblacs_gridinfo
void Cblacs_gridinfo()
CTOP_IRING
#define CTOP_IRING
Definition PBblacs.h:27
CTOP_DRING
#define CTOP_DRING
Definition PBblacs.h:28
NOTRAN
#define NOTRAN
Definition PBblas.h:44
ALL
#define ALL
Definition PBblas.h:50
CLEFT
#define CLEFT
Definition PBblas.h:29
TRAN
#define TRAN
Definition PBblas.h:46
CBACKWARD
#define CBACKWARD
Definition PBblas.h:39
CNOUNIT
#define CNOUNIT
Definition PBblas.h:33
NOCONJG
#define NOCONJG
Definition PBblas.h:45
CUPPER
#define CUPPER
Definition PBblas.h:26
CNOTRAN
#define CNOTRAN
Definition PBblas.h:18
CRIGHT
#define CRIGHT
Definition PBblas.h:30
CTRAN
#define CTRAN
Definition PBblas.h:20
CCOTRAN
#define CCOTRAN
Definition PBblas.h:22
CFORWARD
#define CFORWARD
Definition PBblas.h:38
CLOWER
#define CLOWER
Definition PBblas.h:25
CUNIT
#define CUNIT
Definition PBblas.h:32
pdtrsm_
#define pdtrsm_
Definition PBpblas.h:169
pilaenv_
#define pilaenv_
Definition PBpblas.h:44
CTXT_
#define CTXT_
Definition PBtools.h:38
MAX
#define MAX(a_, b_)
Definition PBtools.h:77
MB_
#define MB_
Definition PBtools.h:43
PB_Cabort
void PB_Cabort()
ONE
#define ONE
Definition PBtools.h:64
PB_CptrsmB
void PB_CptrsmB()
PB_Cchkmat
void PB_Cchkmat()
MIN
#define MIN(a_, b_)
Definition PBtools.h:76
PB_Cwarn
void PB_Cwarn()
PB_Ctop
char * PB_Ctop()
PB_Cplapad
void PB_Cplapad()
RSRC_
#define RSRC_
Definition PBtools.h:45
TWO
#define TWO
Definition PBtools.h:65
PB_CargFtoC
void PB_CargFtoC()
CSRC_
#define CSRC_
Definition PBtools.h:46
ZERO
#define ZERO
Definition PBtools.h:66
PB_Cdtypeset
PBTYP_T * PB_Cdtypeset()
Definition PB_Cdtypeset.c:19
Mupcase
#define Mupcase(C)
Definition PBtools.h:83
DLEN_
#define DLEN_
Definition PBtools.h:48
NB_
#define NB_
Definition PBtools.h:44
DNROC
#define DNROC(n_, nb_, p_)
Definition PBtools.h:111
PB_CptrsmAB
void PB_CptrsmAB()
CEIL
#define CEIL(a, b)
Definition PBtools.h:80
PBTYP_T::type
char type
Definition pblas.h:331
PBTYP_T::zero
char * zero
Definition pblas.h:335
PBTYP_T
Definition pblas.h:330