ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_CptrsmAB0.c
Go to the documentation of this file.
1 /* ---------------------------------------------------------------------
2 *
3 * -- PBLAS auxiliary 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 PB_CptrsmAB0( PBTYP_T * TYPE, char * SIDE, char * UPLO, char * DIAG,
21  int M, int N, char * ALPHA, char * A, int IA, int JA,
22  int * DESCA, char * B, int IB, int JB, int * DESCB,
23  char * * C, int * DESCC, int * CFREE )
24 #else
25 void PB_CptrsmAB0( TYPE, SIDE, UPLO, DIAG, M, N, ALPHA, A, IA, JA, DESCA,
26  B, IB, JB, DESCB, C, DESCC, CFREE )
27 /*
28 * .. Scalar Arguments ..
29 */
30  char * DIAG, * SIDE, * UPLO;
31  int * CFREE, IA, IB, JA, JB, M, N;
32  char * ALPHA;
33  PBTYP_T * TYPE;
34 /*
35 * .. Array Arguments ..
36 */
37  int * DESCA, * DESCB, * DESCC;
38  char * A, * B, * * C;
39 #endif
40 {
41 /*
42 * .. Local Scalars ..
43 */
44  char btop, * negone, * one, * talpha, * zero;
45  int Acol, Acurcol, Acurrow, Aii, Aimb, Aimb1, Ainb, Ainb1, Ajj,
46  Ald, Almb1, Alnb1, Amb, Amp0, Anq0, An, Anb, Arow, Bcol, Bii,
47  Bimb, Bimb1, Binb, Binb1, Bjj, Bld, Bmb, Bmp0, Bnb, Bnq0,
48  Brow, Cld, ctxt, k=1, kb, kblks, kbprev, ktmp, lside, mycol,
49  myrow, npcol, nprow, size, upper;
50  char * Aptr = NULL, * Aptr0 = NULL, * Bptr = NULL, * Bptr0 = NULL,
51  * Cptr = NULL;
52  MMADD_T mmadd;
53  GEBR2D_T brecv;
54  GEBS2D_T bsend;
55  GEMM_T gemm;
56  TRSM_T trsm;
57 /* ..
58 * .. Executable Statements ..
59 *
60 */
61  size = TYPE->size;
62  lside = ( Mupcase( SIDE[0] ) == CLEFT );
63 /*
64 * Retrieve process grid information
65 */
66  Cblacs_gridinfo( ( ctxt = DESCA[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
67 /*
68 * Retrieve sub( A )'s local information: Aii, Ajj, Arow, Acol, Ald
69 */
70  Ald = DESCA[LLD_];
71  PB_Cinfog2l( IA, JA, DESCA, nprow, npcol, myrow, mycol, &Aii, &Ajj,
72  &Arow, &Acol );
73 /*
74 * Retrieve sub( B )'s local information: Bii, Bjj, Brow, Bcol, Bld ...
75 */
76  Bimb = DESCB[IMB_]; Binb = DESCB[INB_];
77  Bmb = DESCB[MB_ ]; Bnb = DESCB[NB_ ]; Bld = DESCB[LLD_];
78  PB_Cinfog2l( IB, JB, DESCB, nprow, npcol, myrow, mycol, &Bii, &Bjj,
79  &Brow, &Bcol );
80 /*
81 * Shorcuts when sub( B ) spans only one process row or column
82 */
83  if( lside )
84  {
85  if( !( PB_Cspan( M, IB, Bimb, Bmb, DESCB[RSRC_], nprow ) ) )
86  {
87  *CFREE = 0;
88  Binb1 = PB_Cfirstnb( N, JB, Binb, Bnb );
89  PB_Cdescset( DESCC, M, N, M, Binb1, Bmb, Bnb, Brow, Bcol, ctxt, Bld );
90  Bnq0 = PB_Cnumroc( N, 0, Binb1, Bnb, mycol, Bcol, npcol );
91 
92  if( ( Bnq0 > 0 ) &&
93  ( ( ( Brow >= 0 ) && ( myrow == Brow ) ) || ( Brow < 0 ) ) )
94  {
95  *C = Mptr( B, Bii, Bjj, Bld, size );
96  TYPE->Ftrsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
97  C2F_CHAR( DIAG ), &M, &Bnq0, ALPHA, Mptr( A, Aii, Ajj,
98  Ald, size ), &Ald, *C, &Bld );
99  }
100  return;
101  }
102  }
103  else
104  {
105  if( !( PB_Cspan( N, JB, Binb, Bnb, DESCB[CSRC_], npcol ) ) )
106  {
107  *CFREE = 0;
108  Bimb1 = PB_Cfirstnb( M, IB, Bimb, Bmb );
109  PB_Cdescset( DESCC, M, N, Bimb1, N, Bmb, Bnb, Brow, Bcol, ctxt, Bld );
110  Bmp0 = PB_Cnumroc( M, 0, Bimb1, Bmb, myrow, Brow, nprow );
111 
112  if( ( Bmp0 > 0 ) &&
113  ( ( ( Bcol >= 0 ) && ( mycol == Bcol ) ) || ( Bcol < 0 ) ) )
114  {
115  *C = Mptr( B, Bii, Bjj, Bld, size );
116  TYPE->Ftrsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
117  C2F_CHAR( DIAG ), &Bmp0, &N, ALPHA, Mptr( A, Aii, Ajj,
118  Ald, size ), &Ald, *C, &Bld );
119  }
120  return;
121  }
122  }
123 /*
124 * Handle the general case now
125 */
126  An = ( lside ? M : N );
127  upper = ( Mupcase( UPLO[0] ) == CUPPER );
128  talpha = ALPHA;
129  negone = TYPE->negone; one = TYPE->one; zero = TYPE->zero;
130  brecv = TYPE->Cgebr2d; bsend = TYPE->Cgebs2d; mmadd = TYPE->Fmmadd;
131  gemm = TYPE->Fgemm; trsm = TYPE->Ftrsm;
132 /*
133 * Compute more local information for sub( A ) and sub( B )
134 */
135  Aimb = DESCA[IMB_]; Ainb = DESCA[INB_];
136  Amb = DESCA[MB_ ]; Anb = DESCA[NB_ ];
137  Aimb1 = PB_Cfirstnb( An, IA, Aimb, Amb );
138  Almb1 = PB_Clastnb ( An, IA, Aimb, Amb );
139  Amp0 = PB_Cnumroc( An, 0, Aimb1, Amb, myrow, Arow, nprow );
140  Ainb1 = PB_Cfirstnb( An, JA, Ainb, Anb );
141  Alnb1 = PB_Clastnb ( An, JA, Ainb, Anb );
142  Anq0 = PB_Cnumroc( An, 0, Ainb1, Anb, mycol, Acol, npcol );
143  if( ( Amp0 > 0 ) && ( Anq0 > 0 ) ) Aptr0 = Mptr( A, Aii, Ajj, Ald, size );
144 
145  Bimb1 = PB_Cfirstnb( M, IB, Bimb, Bmb );
146  Bmp0 = PB_Cnumroc( M, 0, Bimb1, Bmb, myrow, Brow, nprow );
147  Binb1 = PB_Cfirstnb( N, JB, Binb, Bnb );
148  Bnq0 = PB_Cnumroc( N, 0, Binb1, Bnb, mycol, Bcol, npcol );
149  if( ( Bmp0 > 0 ) && ( Bnq0 > 0 ) ) Bptr0 = Mptr( B, Bii, Bjj, Bld, size );
150 
151  if( lside )
152  {
153  Cld = M;
154  PB_Cdescset( DESCC, M, N, M, Binb1, Bmb, Bnb, -1, Bcol, ctxt, Cld );
155  if( Bnq0 > 0 ) { Cptr = *C = PB_Cmalloc( M * Bnq0 * size ); *CFREE = 1; }
156  else { *C = NULL; *CFREE = 0; return; }
157 
158  kblks = ( An > Aimb1 ? ( An - Aimb1 - 1 ) / Amb + 2 : 1 );
159  btop = *PB_Ctop( &ctxt, BCAST, COLUMN, TOP_GET );
160 
161  if( upper )
162  {
163  Acurrow = PB_Cindxg2p( An-1, Aimb1, Amb, Arow, Arow, nprow );
164  kb = Almb1;
165  Bptr = Mptr( Bptr0, Bmp0 - kb, 0, Bld, size );
166  Cptr = Mptr( *C, An - kb, 0, Cld, size );
167 /*
168 * Solve last block of rows of sub( B ) and broadcast it vertically to update
169 * the rest of sub( B )
170 */
171  if( myrow == Acurrow )
172  {
173  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
174  C2F_CHAR( DIAG ), &kb, &Bnq0, ALPHA, Mptr( Aptr0, Amp0-kb,
175  Anq0-kb, Ald, size ), &Ald, Bptr, &Bld );
176  bsend( ctxt, COLUMN, &btop, kb, Bnq0, Bptr, Bld );
177  mmadd( &kb, &Bnq0, one, Bptr, &Bld, zero, Cptr, &Cld );
178  Amp0 -= kb;
179  Bmp0 -= kb;
180  }
181  else
182  {
183  brecv( ctxt, COLUMN, &btop, kb, Bnq0, Cptr, Cld, Acurrow, mycol );
184  }
185  Acurrow = MModSub1( Acurrow, nprow );
186  An -= ( kbprev = kb );
187  Anq0 -= kb;
188  kblks -= 1;
189 /*
190 * Lookahead
191 */
192  while( kblks > 0 )
193  {
194  kb = ( kblks == 1 ? Aimb1 : Amb );
195 
196  Aptr = Mptr( Aptr0, 0, Anq0, Ald, size );
197  Bptr = Mptr( Bptr0, Bmp0 - kb, 0, Bld, size );
198  Cptr = Mptr( *C, An, 0, Cld, size );
199 
200  if( myrow == Acurrow )
201  {
202 /*
203 * Update the current block of rows of sub( B ) with block of rows of sub( B )
204 * of previous step
205 */
206  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &kb, &Bnq0,
207  &kbprev, negone, Mptr( Aptr, Amp0-kb, 0, Ald, size ),
208  &Ald, Cptr, &Cld, talpha, Bptr, &Bld );
209 /*
210 * Solve the current block of rows of sub( B )
211 */
212  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
213  C2F_CHAR( DIAG ), &kb, &Bnq0, one, Mptr( Aptr, Amp0-kb,
214  -kb, Ald, size ), &Ald, Bptr, &Bld );
215 /*
216 * Broadcast the current block of rows of sub( B ) for next update
217 */
218  bsend( ctxt, COLUMN, &btop, kb, Bnq0, Bptr, Bld );
219  mmadd( &kb, &Bnq0, one, Bptr, &Bld, zero, Mptr( Cptr, -kb, 0,
220  Cld, size ), &Cld );
221 /*
222 * Finish update of the remaining blocks of rows of sub( B ) with block of rows
223 * of sub( B ) of previous step
224 */
225  if( ( ktmp = Amp0 - kb ) > 0 )
226  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &ktmp, &Bnq0,
227  &kbprev, negone, Aptr, &Ald, Cptr, &Cld, talpha, Bptr0,
228  &Bld );
229  Amp0 -= kb;
230  Bmp0 -= kb;
231  }
232  else
233  {
234 /*
235 * Update the remaining rows of sub( B ) with block of rows of sub( B ) of
236 * previous step
237 */
238  if( Amp0 > 0 )
239  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Amp0, &Bnq0,
240  &kbprev, negone, Aptr, &Ald, Cptr, &Cld, talpha, Bptr0,
241  &Bld );
242 /*
243 * Receive the current block of rows of sub( B ) for next update
244 */
245  brecv( ctxt, COLUMN, &btop, kb, Bnq0, Mptr( Cptr, -kb, 0, Cld,
246  size ), Cld, Acurrow, mycol );
247  }
248 
249  Acurrow = MModSub1( Acurrow, nprow );
250  An -= ( kbprev = kb );
251  Anq0 -= kb;
252  talpha = one;
253  kblks -= 1;
254  }
255  }
256  else
257  {
258  Acurrow = Arow;
259  kb = Aimb1;
260 /*
261 * Solve first block of rows of sub( B ) and broadcast it vertically to update
262 * the rest of sub( B )
263 */
264  if( myrow == Acurrow )
265  {
266  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
267  C2F_CHAR( DIAG ), &kb, &Bnq0, ALPHA, Aptr0, &Ald, Bptr0,
268  &Bld );
269  bsend( ctxt, COLUMN, &btop, kb, Bnq0, Bptr0, Bld );
270  mmadd( &kb, &Bnq0, one, Bptr0, &Bld, zero, Cptr, &Cld );
271  Amp0 -= kb;
272  Aptr0 = Mptr( Aptr0, kb, 0, Ald, size );
273  Bptr0 = Mptr( Bptr0, kb, 0, Bld, size );
274  }
275  else
276  {
277  brecv( ctxt, COLUMN, &btop, kb, Bnq0, Cptr, Cld, Acurrow, mycol );
278  }
279  Acurrow = MModAdd1( Acurrow, nprow );
280  kbprev = kb;
281  Cptr = Mptr( Cptr, kb, 0, Cld, size );
282  Aptr0 = Mptr( Aptr0, 0, kb, Ald, size );
283  k += 1;
284 /*
285 * Lookahead
286 */
287  while( k <= kblks )
288  {
289  kb = ( k == kblks ? Almb1 : Amb );
290 
291  if( myrow == Acurrow )
292  {
293 /*
294 * Update the current block of rows of sub( B ) with block of rows of sub( B )
295 * of previous step
296 */
297  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &kb, &Bnq0,
298  &kbprev, negone, Mptr( Aptr0, 0, -kbprev, Ald, size ),
299  &Ald, Mptr( Cptr, -kbprev, 0, Cld, size ), &Cld, talpha,
300  Bptr0, &Bld );
301 /*
302 * Solve the current block of rows of sub( B )
303 */
304  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
305  C2F_CHAR( DIAG ), &kb, &Bnq0, one, Aptr0, &Ald, Bptr0,
306  &Bld );
307 /*
308 * Broadcast the current block of rows of sub( B ) for next update
309 */
310  bsend( ctxt, COLUMN, &btop, kb, Bnq0, Bptr0, Bld );
311  mmadd( &kb, &Bnq0, one, Bptr0, &Bld, zero, Cptr, &Cld );
312 /*
313 * Finish update of the remaining blocks of rows of sub( B ) with block of rows
314 * of sub( B ) of previous step
315 */
316  if( ( ktmp = Amp0 - kb ) > 0 )
317  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &ktmp, &Bnq0,
318  &kbprev, negone, Mptr( Aptr0, kb, -kbprev, Ald, size ),
319  &Ald, Mptr( Cptr, -kbprev, 0, Cld, size ), &Cld, talpha,
320  Mptr( Bptr0, kb, 0, Bld, size ), &Bld );
321  Amp0 -= kb;
322  Aptr0 = Mptr( Aptr0, kb, 0, Ald, size );
323  Bptr0 = Mptr( Bptr0, kb, 0, Bld, size );
324  }
325  else
326  {
327 /*
328 * Update the remaining rows of sub( B ) with block of rows of sub( B ) of
329 * previous step
330 */
331  if( Amp0 > 0 )
332  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Amp0, &Bnq0,
333  &kbprev, negone, Mptr( Aptr0, 0, -kbprev, Ald, size ),
334  &Ald, Mptr( Cptr, -kbprev, 0, Cld, size ), &Cld, talpha,
335  Bptr0, &Bld );
336 /*
337 * Receive the current block of rows of sub( B ) for next update
338 */
339  brecv( ctxt, COLUMN, &btop, kb, Bnq0, Cptr, Cld, Acurrow,
340  mycol );
341  }
342 
343  Acurrow = MModAdd1( Acurrow, nprow );
344  kbprev = kb;
345  Cptr = Mptr( Cptr, kb, 0, Cld, size );
346  Aptr0 = Mptr( Aptr0, 0, kb, Ald, size );
347  talpha = one;
348  k += 1;
349  }
350  }
351  }
352  else
353  {
354  Cld = MAX( 1, Bmp0 );
355  PB_Cdescset( DESCC, M, N, Bimb1, N, Bmb, Bnb, Brow, -1, ctxt, Cld );
356  if( Bmp0 > 0 ) { Cptr = *C = PB_Cmalloc( Bmp0 * N * size ); *CFREE = 1; }
357  else { *C = NULL; *CFREE = 0; return; }
358 
359  kblks = ( An > Ainb1 ? ( An - Ainb1 - 1 ) / Anb + 2 : 1 );
360  btop = *PB_Ctop( &ctxt, BCAST, ROW, TOP_GET );
361 
362  if( upper )
363  {
364  Acurcol = Acol;
365  kb = Ainb1;
366 /*
367 * Solve first block of columns of sub( B ) and broadcast it horizontally to
368 * update the rest of sub( B )
369 */
370  if( mycol == Acurcol )
371  {
372  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
373  C2F_CHAR( DIAG ), &Bmp0, &kb, ALPHA, Aptr0, &Ald, Bptr0,
374  &Bld );
375  bsend( ctxt, ROW, &btop, Bmp0, kb, Bptr0, Bld );
376  mmadd( &Bmp0, &kb, one, Bptr0, &Bld, zero, Cptr, &Cld );
377  Anq0 -= kb;
378  Aptr0 = Mptr( Aptr0, 0, kb, Ald, size );
379  Bptr0 = Mptr( Bptr0, 0, kb, Bld, size );
380  }
381  else
382  {
383  brecv( ctxt, ROW, &btop, Bmp0, kb, Cptr, Cld, myrow, Acurcol );
384  }
385  Acurcol = MModAdd1( Acurcol, npcol );
386  kbprev = kb;
387  k += 1;
388  Cptr = Mptr( Cptr, 0, kb, Cld, size );
389  Aptr0 = Mptr( Aptr0, kb, 0, Ald, size );
390 /*
391 * Lookahead
392 */
393  while( k <= kblks )
394  {
395  kb = ( k == kblks ? Alnb1 : Anb );
396 
397  if( mycol == Acurcol )
398  {
399 /*
400 * Update the current block of columns of sub( B ) with block of columns of
401 * sub( B ) of previous step
402 */
403  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &kb,
404  &kbprev, negone, Mptr( Cptr, 0, -kbprev, Cld, size ), &Cld,
405  Mptr( Aptr0, -kbprev, 0, Ald, size ), &Ald, talpha, Bptr0,
406  &Bld );
407 /*
408 * Solve the current block of columns of sub( B )
409 */
410  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
411  C2F_CHAR( DIAG ), &Bmp0, &kb, one, Aptr0, &Ald, Bptr0,
412  &Bld );
413 /*
414 * Broadcast the current block of columns of sub( B ) for next update
415 */
416  bsend( ctxt, ROW, &btop, Bmp0, kb, Bptr0, Bld );
417  mmadd( &Bmp0, &kb, one, Bptr0, &Bld, zero, Cptr, &Cld );
418 /*
419 * Finish update of the remaining blocks of columns of sub( B ) with block of
420 * columns of sub( B ) of previous step
421 */
422  if( ( ktmp = Anq0 - kb ) > 0 )
423  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &ktmp,
424  &kbprev, negone, Mptr( Cptr, 0, -kbprev, Cld, size ),
425  &Cld, Mptr( Aptr0, -kbprev, kb, Ald, size ), &Ald,
426  talpha, Mptr( Bptr0, 0, kb, Bld, size ), &Bld );
427  Anq0 -= kb;
428  Aptr0 = Mptr( Aptr0, 0, kb, Ald, size );
429  Bptr0 = Mptr( Bptr0, 0, kb, Bld, size );
430  }
431  else
432  {
433 /*
434 * Update the remaining columns of sub( B ) with block of columns of sub( B )
435 * of previous step
436 */
437  if( Anq0 > 0 )
438  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &Anq0,
439  &kbprev, negone, Mptr( Cptr, 0, -kbprev, Cld, size ),
440  &Cld, Mptr( Aptr0, -kbprev, 0, Ald, size ), &Ald,
441  talpha, Bptr0, &Bld );
442 /*
443 * Receive the current block of columns of sub( B ) for next update
444 */
445  brecv( ctxt, ROW, &btop, Bmp0, kb, Cptr, Cld, myrow, Acurcol );
446  }
447 
448  Acurcol = MModAdd1( Acurcol, npcol );
449  kbprev = kb;
450  Cptr = Mptr( Cptr, 0, kb, Cld, size );
451  Aptr0 = Mptr( Aptr0, kb, 0, Ald, size );
452  talpha = one;
453  k += 1;
454  }
455  }
456  else
457  {
458  Acurcol = PB_Cindxg2p( An-1, Ainb1, Anb, Acol, Acol, npcol );
459  kb = Alnb1;
460  Bptr = Mptr( Bptr0, 0, Bnq0 - kb, Bld, size );
461  Cptr = Mptr( *C, 0, An - kb, Cld, size );
462 /*
463 * Solve last block of columns of sub( B ) and broadcast it horizontally to
464 * update the rest of sub( B )
465 */
466  if( mycol == Acurcol )
467  {
468  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
469  C2F_CHAR( DIAG ), &Bmp0, &kb, ALPHA, Mptr( Aptr0, Amp0-kb,
470  Anq0-kb, Ald, size ), &Ald, Bptr, &Bld );
471  bsend( ctxt, ROW, &btop, Bmp0, kb, Bptr, Bld );
472  mmadd( &Bmp0, &kb, one, Bptr, &Bld, zero, Cptr, &Cld );
473  Anq0 -= kb;
474  Bnq0 -= kb;
475  }
476  else
477  {
478  brecv( ctxt, ROW, &btop, Bmp0, kb, Cptr, Cld, myrow, Acurcol );
479  }
480  Acurcol = MModSub1( Acurcol, npcol );
481  An -= ( kbprev = kb );
482  Amp0 -= kb;
483  kblks -= 1;
484 /*
485 * Lookahead
486 */
487  while( kblks > 0 )
488  {
489  kb = ( kblks == 1 ? Ainb1 : Anb );
490 
491  Aptr = Mptr( Aptr0, Amp0, 0, Ald, size );
492  Bptr = Mptr( Bptr0, 0, Bnq0 - kb, Bld, size );
493  Cptr = Mptr( *C, 0, An, Cld, size );
494 
495  if( mycol == Acurcol )
496  {
497 /*
498 * Update the current block of columns of sub( B ) with block of columns of
499 * sub( B ) of previous step
500 */
501  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &kb,
502  &kbprev, negone, Cptr, &Cld, Mptr( Aptr, 0, Anq0-kb, Ald,
503  size ), &Ald, talpha, Bptr, &Bld );
504 /*
505 * Solve the current block of columns of sub( B )
506 */
507  trsm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ),
508  C2F_CHAR( DIAG ), &Bmp0, &kb, one, Mptr( Aptr, -kb,
509  Anq0-kb, Ald, size ), &Ald, Bptr, &Bld );
510 /*
511 * Broadcast the current block of columns of sub( B ) for next update
512 */
513  bsend( ctxt, ROW, &btop, Bmp0, kb, Bptr, Bld );
514  mmadd( &Bmp0, &kb, one, Bptr, &Bld, zero, Mptr( Cptr, 0, -kb,
515  Cld, size ), &Cld );
516 /*
517 * Finish update of the remaining blocks of columns of sub( B ) with block of
518 * columns of sub( B ) of previous step
519 */
520  if( ( ktmp = Anq0 - kb ) > 0 )
521  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &ktmp,
522  &kbprev, negone, Cptr, &Cld, Aptr, &Ald, talpha, Bptr0,
523  &Bld );
524  Anq0 -= kb;
525  Bnq0 -= kb;
526  }
527  else
528  {
529 /*
530 * Update the remaining columns of sub( B ) with block of columns of sub( B )
531 * of previous step
532 */
533  if( Anq0 > 0 )
534  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &Bmp0, &Anq0,
535  &kbprev, negone, Cptr, &Cld, Aptr, &Ald, talpha, Bptr0,
536  &Bld );
537 /*
538 * Receive the current block of columns of sub( B ) for next update
539 */
540  brecv( ctxt, ROW, &btop, Bmp0, kb, Mptr( Cptr, 0, -kb, Cld,
541  size ), Cld, myrow, Acurcol );
542  }
543 
544  Acurcol = MModSub1( Acurcol, npcol );
545  An -= ( kbprev = kb );
546  Amp0 -= kb;
547  talpha = one;
548  kblks -= 1;
549  }
550  }
551  }
552 /*
553 * End of PB_CptrsmAB0
554 */
555 }
GEBR2D_T
void(* GEBR2D_T)()
Definition: pblas.h:281
TYPE
#define TYPE
Definition: clamov.c:7
ROW
#define ROW
Definition: PBblacs.h:46
MB_
#define MB_
Definition: PBtools.h:43
NB_
#define NB_
Definition: PBtools.h:44
COLUMN
#define COLUMN
Definition: PBblacs.h:45
CSRC_
#define CSRC_
Definition: PBtools.h:46
TRSM_T
F_VOID_FCT(* TRSM_T)()
Definition: pblas.h:321
PB_Cfirstnb
int PB_Cfirstnb()
PB_Clastnb
int PB_Clastnb()
GEMM_T
F_VOID_FCT(* GEMM_T)()
Definition: pblas.h:313
NOTRAN
#define NOTRAN
Definition: PBblas.h:44
LLD_
#define LLD_
Definition: PBtools.h:47
IMB_
#define IMB_
Definition: PBtools.h:41
PB_Cdescset
void PB_Cdescset()
MModAdd1
#define MModAdd1(I, d)
Definition: PBtools.h:100
MMADD_T
F_VOID_FCT(* MMADD_T)()
Definition: pblas.h:284
PB_Cindxg2p
int PB_Cindxg2p()
TOP_GET
#define TOP_GET
Definition: PBblacs.h:50
PB_Ctop
char * PB_Ctop()
RSRC_
#define RSRC_
Definition: PBtools.h:45
BCAST
#define BCAST
Definition: PBblacs.h:48
PB_Cinfog2l
void PB_Cinfog2l()
PB_Cnumroc
int PB_Cnumroc()
PB_Cmalloc
char * PB_Cmalloc()
INB_
#define INB_
Definition: PBtools.h:42
C2F_CHAR
#define C2F_CHAR(a)
Definition: pblas.h:121
PB_Cspan
int PB_Cspan()
MModSub1
#define MModSub1(I, d)
Definition: PBtools.h:105
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
CUPPER
#define CUPPER
Definition: PBblas.h:26
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CLEFT
#define CLEFT
Definition: PBblas.h:29
CTXT_
#define CTXT_
Definition: PBtools.h:38
GEBS2D_T
void(* GEBS2D_T)()
Definition: pblas.h:280
PB_CptrsmAB0
void PB_CptrsmAB0(PBTYP_T *TYPE, char *SIDE, char *UPLO, char *DIAG, int M, int N, char *ALPHA, char *A, int IA, int JA, int *DESCA, char *B, int IB, int JB, int *DESCB, char **C, int *DESCC, int *CFREE)
Definition: PB_CptrsmAB0.c:25