ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Cptradd.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_Cptradd( PBTYP_T * TYPE, char * DIRECAC, char * UPLO, char * TRANS,
21  int M, int N, char * ALPHA, char * A, int IA, int JA,
22  int * DESCA, char * BETA, char * C, int IC, int JC,
23  int * DESCC )
24 #else
25 void PB_Cptradd( TYPE, DIRECAC, UPLO, TRANS, M, N, ALPHA, A, IA, JA, DESCA,
26  BETA, C, IC, JC, DESCC )
27 /*
28 * .. Scalar Arguments ..
29 */
30  char * DIRECAC, * TRANS, * UPLO;
31  int IA, IC, JA, JC, M, N;
32  char * ALPHA, * BETA;
33  PBTYP_T * TYPE;
34 /*
35 * .. Array Arguments ..
36 */
37  int * DESCA, * DESCC;
38  char * A, * C;
39 #endif
40 {
41 /*
42 * Purpose
43 * =======
44 *
45 * PB_Cptradd adds a trapezoidal matrix to another
46 *
47 * sub( C ) := beta*sub( C ) + alpha*op( sub( A ) )
48 *
49 * where
50 *
51 * sub( C ) denotes C(IC:IC+M-1,JC:JC+N-1), and, op( X ) is one of
52 *
53 * op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ).
54 *
55 * Thus, op( sub( A ) ) denotes A(IA:IA+M-1,JA:JA+N-1) if TRANS = 'N',
56 * A(IA:IA+N-1,JA:JA+M-1)' if TRANS = 'T',
57 * conjg(A(IA:IA+N-1,JA:JA+M-1)') if TRANS = 'C',
58 *
59 * Alpha and beta are scalars, sub( C ) and op( sub( A ) ) are m by n
60 * upper or lower trapezoidal submatrices.
61 *
62 * Notes
63 * =====
64 *
65 * A description vector is associated with each 2D block-cyclicly dis-
66 * tributed matrix. This vector stores the information required to
67 * establish the mapping between a matrix entry and its corresponding
68 * process and memory location.
69 *
70 * In the following comments, the character _ should be read as
71 * "of the distributed matrix". Let A be a generic term for any 2D
72 * block cyclicly distributed matrix. Its description vector is DESC_A:
73 *
74 * NOTATION STORED IN EXPLANATION
75 * ---------------- --------------- ------------------------------------
76 * DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
77 * CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
78 * the NPROW x NPCOL BLACS process grid
79 * A is distributed over. The context
80 * itself is global, but the handle
81 * (the integer value) may vary.
82 * M_A (global) DESCA[ M_ ] The number of rows in the distribu-
83 * ted matrix A, M_A >= 0.
84 * N_A (global) DESCA[ N_ ] The number of columns in the distri-
85 * buted matrix A, N_A >= 0.
86 * IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
87 * block of the matrix A, IMB_A > 0.
88 * INB_A (global) DESCA[ INB_ ] The number of columns of the upper
89 * left block of the matrix A,
90 * INB_A > 0.
91 * MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
92 * bute the last M_A-IMB_A rows of A,
93 * MB_A > 0.
94 * NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
95 * bute the last N_A-INB_A columns of
96 * A, NB_A > 0.
97 * RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
98 * row of the matrix A is distributed,
99 * NPROW > RSRC_A >= 0.
100 * CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
101 * first column of A is distributed.
102 * NPCOL > CSRC_A >= 0.
103 * LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
104 * array storing the local blocks of
105 * the distributed matrix A,
106 * IF( Lc( 1, N_A ) > 0 )
107 * LLD_A >= MAX( 1, Lr( 1, M_A ) )
108 * ELSE
109 * LLD_A >= 1.
110 *
111 * Let K be the number of rows of a matrix A starting at the global in-
112 * dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
113 * that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
114 * receive if these K rows were distributed over NPROW processes. If K
115 * is the number of columns of a matrix A starting at the global index
116 * JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
117 * lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
118 * these K columns were distributed over NPCOL processes.
119 *
120 * The values of Lr() and Lc() may be determined via a call to the func-
121 * tion PB_Cnumroc:
122 * Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
123 * Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
124 *
125 * Arguments
126 * =========
127 *
128 * TYPE (local input) pointer to a PBTYP_T structure
129 * On entry, TYPE is a pointer to a structure of type PBTYP_T,
130 * that contains type information (See pblas.h).
131 *
132 * DIRECAC (global input) pointer to CHAR
133 * On entry, DIRECAC specifies the direction in which the rows
134 * or columns of sub( A ) and sub( C ) should be looped over as
135 * follows:
136 * DIRECA = 'F' or 'f' forward or increasing,
137 * DIRECA = 'B' or 'b' backward or decreasing.
138 *
139 * UPLO (global input) pointer to CHAR
140 * On entry, UPLO specifies whether the local pieces of the
141 * array C containing the upper or lower triangular part of the
142 * triangular submatrix sub( C ) is to be referenced as follows:
143 *
144 * UPLO = 'U' or 'u' Only the local pieces corresponding to
145 * the upper triangular part of the
146 * triangular submatrix sub( C ) is to be
147 * referenced,
148 *
149 * UPLO = 'L' or 'l' Only the local pieces corresponding to
150 * the lower triangular part of the
151 * triangular submatrix sub( C ) is to be
152 * referenced.
153 *
154 * TRANS (global input) pointer to CHAR
155 * On entry, TRANS specifies the form of op( sub( A ) ) to be
156 * used in the matrix addition as follows:
157 *
158 * TRANS = 'N' or 'n' op( sub( A ) ) = sub( A ),
159 *
160 * TRANS = 'T' or 't' op( sub( A ) ) = sub( A )',
161 *
162 * TRANS = 'C' or 'c' op( sub( A ) ) = conjg( sub( A )' ).
163 *
164 * M (global input) INTEGER
165 * On entry, M specifies the number of rows of the submatrices
166 * sub( A ) and sub( C ). M must be at least zero.
167 *
168 * N (global input) INTEGER
169 * On entry, N specifies the number of columns of the submatri-
170 * ces sub( A ) and sub( C ). N must be at least zero.
171 *
172 * ALPHA (global input) pointer to CHAR
173 * On entry, ALPHA specifies the scalar alpha. When ALPHA is
174 * supplied as zero then the local entries of the array A
175 * corresponding to the entries of the submatrix sub( A ) need
176 * not be set on input.
177 *
178 * A (local input) pointer to CHAR
179 * On entry, A is an array of dimension (LLD_A, Ka), where Ka is
180 * at least Lc( 1, JA+N-1 ). Before entry, this array contains
181 * the local entries of the matrix A.
182 *
183 * IA (global input) INTEGER
184 * On entry, IA specifies A's global row index, which points to
185 * the beginning of the submatrix sub( A ).
186 *
187 * JA (global input) INTEGER
188 * On entry, JA specifies A's global column index, which points
189 * to the beginning of the submatrix sub( A ).
190 *
191 * DESCA (global and local input) INTEGER array
192 * On entry, DESCA is an integer array of dimension DLEN_. This
193 * is the array descriptor for the matrix A.
194 *
195 * BETA (global input) pointer to CHAR
196 * On entry, BETA specifies the scalar beta. When BETA is
197 * supplied as zero then the local entries of the array C
198 * corresponding to the entries of the submatrix sub( C ) need
199 * not be set on input.
200 *
201 * C (local input/local output) pointer to CHAR
202 * On entry, C is an array of dimension (LLD_C, Kc), where Kc is
203 * at least Lc( 1, JC+N-1 ). Before entry, this array contains
204 * the local entries of the matrix C.
205 * On exit, the entries of this array corresponding to the local
206 * entries of the submatrix sub( C ) are overwritten by the
207 * local entries of the m by n updated submatrix.
208 *
209 * IC (global input) INTEGER
210 * On entry, IC specifies C's global row index, which points to
211 * the beginning of the submatrix sub( C ).
212 *
213 * JC (global input) INTEGER
214 * On entry, JC specifies C's global column index, which points
215 * to the beginning of the submatrix sub( C ).
216 *
217 * DESCC (global and local input) INTEGER array
218 * On entry, DESCC is an integer array of dimension DLEN_. This
219 * is the array descriptor for the matrix C.
220 *
221 * -- Written on April 1, 1998 by
222 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
223 *
224 * ---------------------------------------------------------------------
225 */
226 /*
227 * .. Local Scalars ..
228 */
229  char Dir, * one, * zero;
230  int Afr, conjg, k, kb, kbb, kend, kstart, kstep, ktmp;
231 /*
232 * .. Local Arrays ..
233 */
234  int DBUFA[DLEN_];
235  char * Aptr = NULL;
236 /* ..
237 * .. Executable Statements ..
238 *
239 */
240 /*
241 * sub( C ) := beta * sub( C )
242 */
243  PB_Cplascal( TYPE, UPLO, NOCONJG, M, N, BETA, C, IC, JC, DESCC );
244 
245  one = TYPE->one; zero = TYPE->zero;
246  kb = pilaenv_( &DESCC[CTXT_], C2F_CHAR( &TYPE->type ) );
247 
248  if( Mupcase( DIRECAC[0] ) == CFORWARD )
249  {
250  Dir = CFORWARD;
251  kstart = 0; kend = ( ( MIN( M, N ) - 1 ) / kb + 1 ) * kb; kstep = kb;
252  }
253  else
254  {
255  Dir = CBACKWARD;
256  kstart = ( ( MIN( M, N ) - 1 ) / kb ) * kb; kend = kstep = -kb;
257  }
258 
259  if( Mupcase( TRANS[0] ) == CNOTRAN )
260  {
261  if( Mupcase( UPLO [0] ) == CUPPER )
262  {
263  if( M >= N )
264  {
265  for( k = kstart; k != kend; k += kstep )
266  {
267  kbb = N - k; kbb = MIN( kbb, kb ); ktmp = k + kbb;
268 /*
269 * Accumulate A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
270 */
271  PB_CGatherV( TYPE, ALLOCATE, &Dir, ktmp, kbb, A, IA, JA+k, DESCA,
272  COLUMN, &Aptr, DBUFA, &Afr );
273 /*
274 * Scale A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 ) by ALPHA
275 */
276  PB_Cplascal( TYPE, ALL, NOCONJG, ktmp, kbb, ALPHA, Aptr, 0, 0,
277  DBUFA );
278 /*
279 * Zero lower triangle of A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
280 */
281  if( kbb > 1 )
282  PB_Cplapad( TYPE, LOWER, NOCONJG, kbb-1, kbb-1, zero, zero,
283  Aptr, k+1, 0, DBUFA );
284 /*
285 * C( IC:IC+k+kbb-1, JC+k:JC+k+kbb-1 ) += A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
286 */
287  PB_CScatterV( TYPE, &Dir, ktmp, kbb, Aptr, 0, 0, DBUFA, COLUMN,
288  one, C, IC, JC+k, DESCC, COLUMN );
289 
290  if( Afr ) free( Aptr );
291  }
292  }
293  else
294  {
295  for( k = kstart; k != kend; k += kstep )
296  {
297  kbb = M - k; kbb = MIN( kbb, kb ); ktmp = N - k;
298 /*
299 * Accumulate A( IA+k:IA+k+kbb-1, JA+k:JA+N-1 )
300 */
301  PB_CGatherV( TYPE, ALLOCATE, &Dir, kbb, ktmp, A, IA+k, JA+k,
302  DESCA, ROW, &Aptr, DBUFA, &Afr );
303 /*
304 * Scale A( IA+k:IA+k+kbb-1, JA+k:JA+N-1 ) by ALPHA
305 */
306  PB_Cplascal( TYPE, ALL, NOCONJG, kbb, ktmp, ALPHA, Aptr, 0, 0,
307  DBUFA );
308 /*
309 * Zero lower triangle of A( IA+k:IA+k+kbb-1, JA+k:JA+N-1 )
310 */
311  if( kbb > 1 )
312  PB_Cplapad( TYPE, LOWER, NOCONJG, kbb-1, kbb-1, zero, zero,
313  Aptr, 1, 0, DBUFA );
314 /*
315 * C( IC+k:IC+k+kbb-1, JC+k:JC+N-1 ) += A( IA+k:IA+k+kbb-1, JA+k:JA+N-1 )
316 */
317  PB_CScatterV( TYPE, &Dir, kbb, ktmp, Aptr, 0, 0, DBUFA, ROW,
318  one, C, IC+k, JC+k, DESCC, ROW );
319 
320  if( Afr ) free( Aptr );
321  }
322  }
323  }
324  else
325  {
326  if( M >= N )
327  {
328  for( k = kstart; k != kend; k += kstep )
329  {
330  kbb = N - k; kbb = MIN( kbb, kb ); ktmp = M - k;
331 /*
332 * Accumulate A( IA+k:IA+M-1, JA+k:JA+k+kbb-1 )
333 */
334  PB_CGatherV( TYPE, ALLOCATE, &Dir, ktmp, kbb, A, IA+k, JA+k,
335  DESCA, COLUMN, &Aptr, DBUFA, &Afr );
336 /*
337 * Scale A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 ) by ALPHA
338 */
339  PB_Cplascal( TYPE, ALL, NOCONJG, ktmp, kbb, ALPHA, Aptr, 0, 0,
340  DBUFA );
341 /*
342 * Zero upper triangle of A( IA+k:IA+M-1, JA+k:JA+k+kbb-1 )
343 */
344  if( kbb > 1 )
345  PB_Cplapad( TYPE, UPPER, NOCONJG, kbb-1, kbb-1, zero, zero,
346  Aptr, 0, 1, DBUFA );
347 /*
348 * C( IC:IC+k+kbb-1, JC+k:JC+k+kbb-1 ) += A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
349 */
350  PB_CScatterV( TYPE, &Dir, ktmp, kbb, Aptr, 0, 0, DBUFA, COLUMN,
351  one, C, IC+k, JC+k, DESCC, COLUMN );
352 
353  if( Afr ) free( Aptr );
354  }
355  }
356  else
357  {
358  for( k = kstart; k != kend; k += kstep )
359  {
360  kbb = M - k; kbb = MIN( kbb, kb ); ktmp = k + kbb;
361 /*
362 * Accumulate A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 )
363 */
364  PB_CGatherV( TYPE, ALLOCATE, &Dir, kbb, ktmp, A, IA+k, JA,
365  DESCA, ROW, &Aptr, DBUFA, &Afr );
366 /*
367 * Scale A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 ) by ALPHA
368 */
369  PB_Cplascal( TYPE, ALL, NOCONJG, kbb, ktmp, ALPHA, Aptr, 0, 0,
370  DBUFA );
371 /*
372 * Zero upper triangle of A( IA+k:IA+k+kbb-1, JA+k:JA:JA+k+kbb-1 )
373 */
374  if( kbb > 1 )
375  PB_Cplapad( TYPE, UPPER, NOCONJG, kbb-1, kbb-1, zero, zero,
376  Aptr, 0, k+1, DBUFA );
377 /*
378 * C( IC+k:IC+k+kbb-1, JC:JC+k+kbb-1 ) += A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 )
379 */
380  PB_CScatterV( TYPE, &Dir, kbb, ktmp, Aptr, 0, 0, DBUFA, ROW,
381  one, C, IC+k, JC, DESCC, ROW );
382 
383  if( Afr ) free( Aptr );
384  }
385  }
386  }
387  }
388  else
389  {
390  conjg = ( Mupcase( TRANS[0] ) == CCOTRAN );
391 
392  if( Mupcase( UPLO [0] ) == CUPPER )
393  {
394  if( M >= N )
395  {
396  for( k = kstart; k != kend; k += kstep )
397  {
398  kbb = N - k; kbb = MIN( kbb, kb ); ktmp = k + kbb;
399 /*
400 * Accumulate A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 )
401 */
402  PB_CGatherV( TYPE, ALLOCATE, &Dir, kbb, ktmp, A, IA+k, JA, DESCA,
403  ROW, &Aptr, DBUFA, &Afr );
404 /*
405 * Scale A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 ) by ALPHA
406 */
407  if( conjg )
408  PB_Cplacnjg( TYPE, kbb, ktmp, ALPHA, Aptr, 0, 0, DBUFA );
409  else
410  PB_Cplascal( TYPE, ALL, NOCONJG, kbb, ktmp, ALPHA, Aptr,
411  0, 0, DBUFA );
412 /*
413 * Zero upper triangle of A( IA+k:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
414 */
415  if( kbb > 1 )
416  PB_Cplapad( TYPE, UPPER, NOCONJG, kbb-1, kbb-1, zero, zero,
417  Aptr, 0, k+1, DBUFA );
418 /*
419 * C( IC:IC+k+kbb-1, JC+k:JC+k+kbb-1 ) += A( IA+k:IA+k+kbb-1, JA:JA+k+kbb-1 )'
420 */
421  PB_CScatterV( TYPE, &Dir, kbb, ktmp, Aptr, 0, 0, DBUFA, ROW,
422  one, C, IC, JC+k, DESCC, COLUMN );
423 
424  if( Afr ) free( Aptr );
425  }
426  }
427  else
428  {
429  for( k = kstart; k != kend; k += kstep )
430  {
431  kbb = M - k; kbb = MIN( kbb, kb ); ktmp = N - k;
432 /*
433 * Accumulate A( IA+k:IA+N-1, JA+k:JA+k+kbb-1 )
434 */
435  PB_CGatherV( TYPE, ALLOCATE, &Dir, ktmp, kbb, A, IA+k, JA+k,
436  DESCA, COLUMN, &Aptr, DBUFA, &Afr );
437 /*
438 * Scale A( IA+k:IA+N-1, JA+k:JA+k+kbb-1 ) by ALPHA
439 */
440  if( conjg )
441  PB_Cplacnjg( TYPE, ktmp, kbb, ALPHA, Aptr, 0, 0, DBUFA );
442  else
443  PB_Cplascal( TYPE, ALL, NOCONJG, ktmp, kbb, ALPHA, Aptr,
444  0, 0, DBUFA );
445 /*
446 * Zero upper triangle of A( IA+k:IA+N-1, JA+k:JA+k+kbb-1 )
447 */
448  if( kbb > 1 )
449  PB_Cplapad( TYPE, UPPER, NOCONJG, kbb-1, kbb-1, zero, zero,
450  Aptr, 0, 1, DBUFA );
451 /*
452 * C( IC+k:IC+k+kbb-1, JC+k:JC+N-1 ) += A( IA+k:IA+N-1, JA+k:JA+k+kbb-1 )'
453 */
454  PB_CScatterV( TYPE, &Dir, ktmp, kbb, Aptr, 0, 0, DBUFA, COLUMN,
455  one, C, IC+k, JC+k, DESCC, ROW );
456 
457  if( Afr ) free( Aptr );
458  }
459  }
460  }
461  else
462  {
463  if( M >= N )
464  {
465  for( k = kstart; k != kend; k += kstep )
466  {
467  kbb = N - k; kbb = MIN( kbb, kb ); ktmp = M - k;
468 /*
469 * Accumulate A( IA+k:IA+k+kbb-1, JA+k:JA+M-1 )
470 */
471  PB_CGatherV( TYPE, ALLOCATE, &Dir, kbb, ktmp, A, IA+k, JA+k,
472  DESCA, ROW, &Aptr, DBUFA, &Afr );
473 /*
474 * Scale A( IA+k:IA+k+kbb-1, JA+k:JA+M-1 ) by ALPHA
475 */
476  if( conjg )
477  PB_Cplacnjg( TYPE, kbb, ktmp, ALPHA, Aptr, 0, 0, DBUFA );
478  else
479  PB_Cplascal( TYPE, ALL, NOCONJG, kbb, ktmp, ALPHA, Aptr,
480  0, 0, DBUFA );
481 /*
482 * Zero lower triangle of A( IA+k:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
483 */
484  if( kbb > 1 )
485  PB_Cplapad( TYPE, LOWER, NOCONJG, kbb-1, kbb-1, zero, zero,
486  Aptr, 1, 0, DBUFA );
487 /*
488 * C( IC:IC+k+kbb-1, JC+k:JC+k+kbb-1 ) += A( IA+k:IA+k+kbb-1, JA+k:JA+M-1 )'
489 */
490  PB_CScatterV( TYPE, &Dir, kbb, ktmp, Aptr, 0, 0, DBUFA, ROW,
491  one, C, IC+k, JC+k, DESCC, COLUMN );
492 
493  if( Afr ) free( Aptr );
494  }
495  }
496  else
497  {
498  for( k = kstart; k != kend; k += kstep )
499  {
500  kbb = M - k; kbb = MIN( kbb, kb ); ktmp = k + kbb;
501 /*
502 * Accumulate A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )
503 */
504  PB_CGatherV( TYPE, ALLOCATE, &Dir, ktmp, kbb, A, IA, JA+k,
505  DESCA, COLUMN, &Aptr, DBUFA, &Afr );
506 /*
507 * Scale A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 ) by ALPHA
508 */
509  if( conjg )
510  PB_Cplacnjg( TYPE, ktmp, kbb, ALPHA, Aptr, 0, 0, DBUFA );
511  else
512  PB_Cplascal( TYPE, ALL, NOCONJG, ktmp, kbb, ALPHA, Aptr,
513  0, 0, DBUFA );
514 /*
515 * Zero lower triangle of A( IA+k:IA+k+kbb-1, JA+k:JA:JA+k+kbb-1 )
516 */
517  if( kbb > 1 )
518  PB_Cplapad( TYPE, LOWER, NOCONJG, kbb-1, kbb-1, zero, zero,
519  Aptr, k+1, 0, DBUFA );
520 /*
521 * C( IC+k:IC+k+kbb-1, JC:JC+k+kbb-1 ) += A( IA:IA+k+kbb-1, JA+k:JA+k+kbb-1 )'
522 */
523  PB_CScatterV( TYPE, &Dir, ktmp, kbb, Aptr, 0, 0, DBUFA, COLUMN,
524  one, C, IC+k, JC, DESCC, ROW );
525 
526  if( Afr ) free( Aptr );
527  }
528  }
529  }
530  }
531 /*
532 * End of PB_Cptradd
533 */
534 }
TYPE
#define TYPE
Definition: clamov.c:7
ROW
#define ROW
Definition: PBblacs.h:46
COLUMN
#define COLUMN
Definition: PBblacs.h:45
ALLOCATE
#define ALLOCATE
Definition: PBblas.h:68
PB_CScatterV
void PB_CScatterV()
CCOTRAN
#define CCOTRAN
Definition: PBblas.h:22
NOCONJG
#define NOCONJG
Definition: PBblas.h:45
DLEN_
#define DLEN_
Definition: PBtools.h:48
UPPER
#define UPPER
Definition: PBblas.h:52
pilaenv_
int pilaenv_()
PB_Cplascal
void PB_Cplascal()
PB_CGatherV
void PB_CGatherV()
PB_Cplapad
void PB_Cplapad()
CNOTRAN
#define CNOTRAN
Definition: PBblas.h:18
CFORWARD
#define CFORWARD
Definition: PBblas.h:38
ALL
#define ALL
Definition: PBblas.h:50
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
LOWER
#define LOWER
Definition: PBblas.h:51
C2F_CHAR
#define C2F_CHAR(a)
Definition: pblas.h:121
PB_Cplacnjg
void PB_Cplacnjg()
PBTYP_T
Definition: pblas.h:325
Mupcase
#define Mupcase(C)
Definition: PBtools.h:83
CUPPER
#define CUPPER
Definition: PBblas.h:26
CBACKWARD
#define CBACKWARD
Definition: PBblas.h:39
CTXT_
#define CTXT_
Definition: PBtools.h:38
PB_Cptradd
void PB_Cptradd(PBTYP_T *TYPE, char *DIRECAC, char *UPLO, char *TRANS, int M, int N, char *ALPHA, char *A, int IA, int JA, int *DESCA, char *BETA, char *C, int IC, int JC, int *DESCC)
Definition: PB_Cptradd.c:25