SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
PB_Cptran.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__
20void PB_Cptran( PBTYP_T * TYPE, char * CONJUG, Int M, Int N,
21 char * ALPHA, char * A, Int IA, Int JA, Int * DESCA,
22 char * BETA, char * C, Int IC, Int JC, Int * DESCC )
23#else
24void PB_Cptran( TYPE, CONJUG, M, N, ALPHA, A, IA, JA, DESCA, BETA,
25 C, IC, JC, DESCC )
26/*
27* .. Scalar Arguments ..
28*/
29 char * CONJUG;
30 Int IA, IC, JA, JC, M, N;
31 char * ALPHA, * BETA;
32 PBTYP_T * TYPE;
33/*
34* .. Array Arguments ..
35*/
36 Int * DESCA, * DESCC;
37 char * A, * C;
38#endif
39{
40/*
41* Purpose
42* =======
43*
44* PB_Cptran transposes a matrix
45*
46* sub( C ) := beta*sub( C ) + alpha*op( sub( A ) )
47*
48* where
49*
50* sub( C ) denotes C(IC:IC+M-1,JC:JC+N-1),
51*
52* sub( A ) denotes A(IA:IA+N-1,JA:JA+M-1), and,
53*
54* op( X ) = X' or op( X ) = conjg( X )'.
55*
56* Beta is a scalar, sub( C ) is an m by n submatrix, and sub( A ) is an
57* n by m submatrix.
58*
59* Notes
60* =====
61*
62* A description vector is associated with each 2D block-cyclicly dis-
63* tributed matrix. This vector stores the information required to
64* establish the mapping between a matrix entry and its corresponding
65* process and memory location.
66*
67* In the following comments, the character _ should be read as
68* "of the distributed matrix". Let A be a generic term for any 2D
69* block cyclicly distributed matrix. Its description vector is DESC_A:
70*
71* NOTATION STORED IN EXPLANATION
72* ---------------- --------------- ------------------------------------
73* DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
74* CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
75* the NPROW x NPCOL BLACS process grid
76* A is distributed over. The context
77* itself is global, but the handle
78* (the integer value) may vary.
79* M_A (global) DESCA[ M_ ] The number of rows in the distribu-
80* ted matrix A, M_A >= 0.
81* N_A (global) DESCA[ N_ ] The number of columns in the distri-
82* buted matrix A, N_A >= 0.
83* IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
84* block of the matrix A, IMB_A > 0.
85* INB_A (global) DESCA[ INB_ ] The number of columns of the upper
86* left block of the matrix A,
87* INB_A > 0.
88* MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
89* bute the last M_A-IMB_A rows of A,
90* MB_A > 0.
91* NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
92* bute the last N_A-INB_A columns of
93* A, NB_A > 0.
94* RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
95* row of the matrix A is distributed,
96* NPROW > RSRC_A >= 0.
97* CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
98* first column of A is distributed.
99* NPCOL > CSRC_A >= 0.
100* LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
101* array storing the local blocks of
102* the distributed matrix A,
103* IF( Lc( 1, N_A ) > 0 )
104* LLD_A >= MAX( 1, Lr( 1, M_A ) )
105* ELSE
106* LLD_A >= 1.
107*
108* Let K be the number of rows of a matrix A starting at the global in-
109* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
110* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
111* receive if these K rows were distributed over NPROW processes. If K
112* is the number of columns of a matrix A starting at the global index
113* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
114* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
115* these K columns were distributed over NPCOL processes.
116*
117* The values of Lr() and Lc() may be determined via a call to the func-
118* tion PB_Cnumroc:
119* Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
120* Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
121*
122* Arguments
123* =========
124*
125* TYPE (local input) pointer to a PBTYP_T structure
126* On entry, TYPE is a pointer to a structure of type PBTYP_T,
127* that contains type information (See pblas.h).
128*
129* CONJUG (global input) pointer to CHAR
130* On entry, CONJUG specifies whether conjg( sub( A ) ) or
131* sub( A ) should be added to sub( C ) as follows:
132* CONJUG = 'N' or 'n':
133* sub( C ) := beta*sub( C ) + alpha*sub( A )'
134* otherwise
135* sub( C ) := beta*sub( C ) + alpha*conjg( sub( A ) )'.
136*
137* M (global input) INTEGER
138* On entry, M specifies the number of rows of the submatrix
139* sub( C ) and the number of columns of the submatrix sub( A ).
140* M must be at least zero.
141*
142* N (global input) INTEGER
143* On entry, N specifies the number of columns of the submatrix
144* sub( C ) and the number of rows of the submatrix sub( A ). N
145* must be at least zero.
146*
147* ALPHA (global input) pointer to CHAR
148* On entry, ALPHA specifies the scalar alpha. When ALPHA is
149* supplied as zero then the local entries of the array A
150* corresponding to the entries of the submatrix sub( A ) need
151* not be set on input.
152*
153* A (local input) pointer to CHAR
154* On entry, A is an array of dimension (LLD_A, Ka), where Ka is
155* at least Lc( 1, JA+M-1 ). Before entry, this array contains
156* the local entries of the matrix A.
157*
158* IA (global input) INTEGER
159* On entry, IA specifies A's global row index, which points to
160* the beginning of the submatrix sub( A ).
161*
162* JA (global input) INTEGER
163* On entry, JA specifies A's global column index, which points
164* to the beginning of the submatrix sub( A ).
165*
166* DESCA (global and local input) INTEGER array
167* On entry, DESCA is an integer array of dimension DLEN_. This
168* is the array descriptor for the matrix A.
169*
170* BETA (global input) pointer to CHAR
171* On entry, BETA specifies the scalar beta. When BETA is
172* supplied as zero then the local entries of the array C
173* corresponding to the entries of the submatrix sub( C ) need
174* not be set on input.
175*
176* C (local input/local output) pointer to CHAR
177* On entry, C is an array of dimension (LLD_C, Kc), where Kc is
178* at least Lc( 1, JC+N-1 ). Before entry, this array contains
179* the local entries of the matrix C.
180* On exit, the entries of this array corresponding to the local
181* entries of the submatrix sub( C ) are overwritten by the
182* local entries of the m by n updated submatrix.
183*
184* IC (global input) INTEGER
185* On entry, IC specifies C's global row index, which points to
186* the beginning of the submatrix sub( C ).
187*
188* JC (global input) INTEGER
189* On entry, JC specifies C's global column index, which points
190* to the beginning of the submatrix sub( C ).
191*
192* DESCC (global and local input) INTEGER array
193* On entry, DESCC is an integer array of dimension DLEN_. This
194* is the array descriptor for the matrix C.
195*
196* -- Written on April 1, 1998 by
197* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
198*
199* ---------------------------------------------------------------------
200*/
201/*
202* .. Local Scalars ..
203*/
204 char Aroc, Croc, * one, * talpha, * tbeta, * zero;
205 Int ACnD, ACnR, Abufld, AcurrocR, Afr, AiD, AiR, AiiD, AiiR,
206 AinbD, AinbR, Ainb1D, Ainb1R, AisR, Akk, Ald, AmyprocD,
207 AmyprocR, AnbD, AnbR, AnpD, AnpR, AnprocsD, AnprocsR, Aoff,
208 ArocD, ArocR, AsrcR, Cbufld, CcurrocR, Cfr, CiD, CiR, CiiD,
209 CiiR, CinbD, CinbR, Cinb1D, Cinb1R, CisR, Ckk, Cld, CmyprocD,
210 CmyprocR, CnbD, CnbR, CnpD, CnpR, CnprocsD, CnprocsR, Coff,
211 CrocD, CrocR, CsrcR, ctxt, col2row, gcdPQ, k, kb, kbb, l,
212 lcmPQ, lcmb, maxp, maxq, mycol, myrow, ncpq, npcol, npq,
213 nprow, nrpq, p, q, size;
214 PB_VM_T VM;
215/*
216* .. Local Arrays ..
217*/
218 Int DBUFA[DLEN_], DBUFC[DLEN_];
219 char * Abuf = NULL, * Cbuf = NULL;
220/* ..
221* .. Executable Statements ..
222*
223*/
224/*
225* Retrieve process grid information
226*/
227 Cblacs_gridinfo( ( ctxt = DESCC[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
228/*
229* Loop over the rows of sub( C ) when M <= N, and the columns of sub( C )
230* otherwise.
231*/
232 col2row = ( ( M <= N ) || ( nprow == 1 ) || ( DESCA[RSRC_] == -1 ) );
233
234 if( col2row )
235 {
236 AinbR = DESCA[INB_]; AnbR = DESCA[NB_]; AsrcR = DESCA[CSRC_];
237 CinbR = DESCC[IMB_]; CnbR = DESCC[MB_]; CsrcR = DESCC[RSRC_];
238/*
239* If sub( A ) only spans one process column and sub( C ) spans only one process
240* row, then there is no need to pack the data.
241*/
242 if( !( PB_Cspan( M, JA, AinbR, AnbR, AsrcR, npcol ) ) &&
243 !( PB_Cspan( M, IC, CinbR, CnbR, CsrcR, nprow ) ) )
244 {
245 PB_Cpaxpby( TYPE, CONJUG, N, M, ALPHA, A, IA, JA, DESCA, COLUMN, BETA,
246 C, IC, JC, DESCC, ROW );
247 return;
248 }
249/*
250* Compute local information for sub( A ) and sub( C )
251*/
252 ACnR = M; ACnD = N;
253 AmyprocD = CmyprocR = myrow; AnprocsD = CnprocsR = nprow;
254 AmyprocR = CmyprocD = mycol; CnprocsD = AnprocsR = npcol;
255 AiD = IA; AiR = JA; Aroc = CCOLUMN;
256 AinbD = DESCA[IMB_]; AnbD = DESCA[MB_]; Ald = DESCA[LLD_];
257 PB_Cinfog2l( IA, JA, DESCA, AnprocsD, AnprocsR, AmyprocD, AmyprocR,
258 &AiiD, &AiiR, &ArocD, &ArocR );
259 CiD = JC; CiR = IC; Croc = CROW;
260 CinbD = DESCC[INB_]; CnbD = DESCC[NB_]; Cld = DESCC[LLD_];
261 PB_Cinfog2l( IC, JC, DESCC, CnprocsR, CnprocsD, CmyprocR, CmyprocD,
262 &CiiR, &CiiD, &CrocR, &CrocD );
263 }
264 else
265 {
266 AinbR = DESCA[IMB_]; AnbR = DESCA[MB_]; AsrcR = DESCA[RSRC_];
267 CinbR = DESCC[INB_]; CnbR = DESCC[NB_]; CsrcR = DESCC[CSRC_];
268/*
269* If sub( A ) only spans one process row and sub( C ) spans only one process
270* column, then there is no need to pack the data.
271*/
272 if( !( PB_Cspan( N, IA, AinbR, AnbR, AsrcR, nprow ) ) &&
273 !( PB_Cspan( N, JC, CinbR, CnbR, CsrcR, npcol ) ) )
274 {
275 PB_Cpaxpby( TYPE, CONJUG, N, M, ALPHA, A, IA, JA, DESCA, ROW, BETA, C,
276 IC, JC, DESCC, COLUMN );
277 return;
278 }
279/*
280* Compute local information for sub( A ) and sub( C )
281*/
282 ACnD = M; ACnR = N;
283 AmyprocR = CmyprocD = myrow; AnprocsR = CnprocsD = nprow;
284 AmyprocD = CmyprocR = mycol; AnprocsD = CnprocsR = npcol;
285
286 AiD = JA; AiR = IA; Aroc = CROW;
287 AinbD = DESCA[INB_]; AnbD = DESCA[NB_]; Ald = DESCA[LLD_];
288 PB_Cinfog2l( IA, JA, DESCA, AnprocsR, AnprocsD, AmyprocR, AmyprocD,
289 &AiiR, &AiiD, &ArocR, &ArocD );
290 CiD = IC; CiR = JC; Croc = CCOLUMN;
291 CinbD = DESCC[IMB_]; CnbD = DESCC[MB_]; Cld = DESCC[LLD_];
292 PB_Cinfog2l( IC, JC, DESCC, CnprocsD, CnprocsR, CmyprocD, CmyprocR,
293 &CiiD, &CiiR, &CrocD, &CrocR );
294 }
295
296 size = TYPE->size; one = TYPE->one; zero = TYPE->zero;
297 kb = pilaenv_( &ctxt, C2F_CHAR( &TYPE->type ) );
298
299 Ainb1D = PB_Cfirstnb( ACnD, AiD, AinbD, AnbD );
300 AnpD = PB_Cnumroc( ACnD, 0, Ainb1D, AnbD, AmyprocD, ArocD, AnprocsD );
301 Ainb1R = PB_Cfirstnb( ACnR, AiR, AinbR, AnbR );
302 AisR = ( ( AsrcR < 0 ) || ( AnprocsR == 1 ) );
303
304 Cinb1D = PB_Cfirstnb( ACnD, CiD, CinbD, CnbD );
305 CnpD = PB_Cnumroc( ACnD, 0, Cinb1D, CnbD, CmyprocD, CrocD, CnprocsD );
306 Cinb1R = PB_Cfirstnb( ACnR, CiR, CinbR, CnbR );
307 CisR = ( ( CsrcR < 0 ) || ( CnprocsR == 1 ) );
308
309 lcmb = PB_Clcm( ( maxp = ( CisR ? 1 : CnprocsR ) ) * CnbR,
310 ( maxq = ( AisR ? 1 : AnprocsR ) ) * AnbR );
311 gcdPQ = PB_Cgcd( maxp, maxq );
312 lcmPQ = ( maxp / gcdPQ ) * maxq;
313/*
314* Loop over the processes of the virtual grid
315*/
316 for( k = 0; k < gcdPQ; k++ )
317 {
318 p = 0; q = k;
319
320 for( l = 0; l < lcmPQ; l++ )
321 {
322 AcurrocR = ( AisR ? -1 : MModAdd( ArocR, q, AnprocsR ) );
323 CcurrocR = ( CisR ? -1 : MModAdd( CrocR, p, CnprocsR ) );
324
325 if( ( AisR || ( AmyprocR == AcurrocR ) ) ||
326 ( CisR || ( CmyprocR == CcurrocR ) ) )
327 {
328 Ckk = CiiR; Akk = AiiR;
329/*
330* Initialize local virtual matrix in process (p,q)
331*/
332 CnpR = PB_Cnumroc( ACnR, 0, Cinb1R, CnbR, CcurrocR, CrocR,
333 CnprocsR );
334 AnpR = PB_Cnumroc( ACnR, 0, Ainb1R, AnbR, AcurrocR, ArocR,
335 AnprocsR );
336 PB_CVMinit( &VM, 0, CnpR, AnpR, Cinb1R, Ainb1R, CnbR, AnbR, p, q,
337 maxp, maxq, lcmb );
338/*
339* Find how many diagonals in this virtual process
340*/
341 npq = PB_CVMnpq( &VM );
342/*
343* Re-adjust the number of rows or columns to be (un)packed, in order to
344* average the message sizes.
345*/
346 if( npq ) kbb = npq / ( ( npq - 1 ) / kb + 1 );
347
348 if( col2row )
349 {
350 while( npq )
351 {
352 kbb = MIN( kbb, npq );
353/*
354* Find out how many columns of sub( A ) and rows of sub( C ) are contiguous
355*/
356 PB_CVMcontig( &VM, &nrpq, &ncpq, &Coff, &Aoff );
357/*
358* Compute the descriptor DBUFA for the buffer that will contained the packed
359* columns of sub( A ).
360*/
361 if( ( Afr = ( ncpq < kbb ) ) != 0 )
362 {
363/*
364* If columns of sub( A ) are not contiguous, then allocate the buffer and
365* pack the kbb columns of sub( A ).
366*/
367 Abufld = MAX( 1, AnpD );
368 if( AisR || ( AmyprocR == AcurrocR ) )
369 {
370 Abuf = PB_Cmalloc( AnpD * kbb * size );
371 PB_CVMpack( TYPE, &VM, COLUMN, &Aroc, PACKING, NOTRAN,
372 kbb, AnpD, one, Mptr( A, AiiD, Akk, Ald,
373 size ), Ald, zero, Abuf, Abufld );
374 }
375 }
376 else
377 {
378/*
379* Otherwise, re-use sub( A ) directly.
380*/
381 Abufld = Ald;
382 if( AisR || ( AmyprocR == AcurrocR ) )
383 Abuf = Mptr( A, AiiD, Akk+Aoff, Ald, size );
384 }
385 PB_Cdescset( DBUFA, ACnD, kbb, Ainb1D, kbb, AnbD, kbb, ArocD,
386 AcurrocR, ctxt, Abufld );
387/*
388* Compute the descriptor DBUFC for the buffer that will contained the packed
389* rows of sub( C ). Allocate it.
390*/
391 if( ( Cfr = ( nrpq < kbb ) ) != 0 )
392 {
393/*
394* If rows of sub( C ) are not contiguous, then allocate receiving buffer.
395*/
396 Cbufld = kbb; talpha = one; tbeta = zero;
397 if( CisR || ( CmyprocR == CcurrocR ) )
398 Cbuf = PB_Cmalloc( CnpD * kbb * size );
399 }
400 else
401 {
402/*
403* Otherwise, re-use sub( C ) directly.
404*/
405 Cbufld = Cld; talpha = ALPHA; tbeta = BETA;
406 if( CisR || ( CmyprocR == CcurrocR ) )
407 Cbuf = Mptr( C, Ckk+Coff, CiiD, Cld, size );
408 }
409 PB_Cdescset( DBUFC, kbb, ACnD, kbb, Cinb1D, kbb, CnbD,
410 CcurrocR, CrocD, ctxt, Cbufld );
411/*
412* Transpose the one-dimensional buffer Abuf into Cbuf.
413*/
414 PB_Cpaxpby( TYPE, CONJUG, ACnD, kbb, talpha, Abuf, 0, 0,
415 DBUFA, &Aroc, tbeta, Cbuf, 0, 0, DBUFC, &Croc );
416/*
417* Release the buffer containing the packed columns of sub( A )
418*/
419 if( Afr && ( AisR || ( AmyprocR == AcurrocR ) ) )
420 if( Abuf ) free( Abuf );
421/*
422* Unpack the kbb rows of sub( C ) and release the buffer containing them.
423*/
424 if( Cfr && ( CisR || ( CmyprocR == CcurrocR ) ) )
425 {
426 PB_CVMpack( TYPE, &VM, ROW, &Croc, UNPACKING, NOTRAN,
427 kbb, CnpD, BETA, Mptr( C, Ckk, CiiD, Cld,
428 size ), Cld, ALPHA, Cbuf, Cbufld );
429 if( Cbuf ) free( Cbuf );
430 }
431/*
432* Update the local column index of sub( A ) and the local row index of sub( C )
433*/
434 PB_CVMupdate( &VM, kbb, &Ckk, &Akk );
435 npq -= kbb;
436 }
437 }
438 else
439 {
440 while( npq )
441 {
442 kbb = MIN( kbb, npq );
443/*
444* Find out how many rows of sub( A ) and columns of sub( C ) are contiguous
445*/
446 PB_CVMcontig( &VM, &nrpq, &ncpq, &Coff, &Aoff );
447/*
448* Compute the descriptor DBUFA for the buffer that will contained the packed
449* rows of sub( A ).
450*/
451 if( ( Afr = ( ncpq < kbb ) ) != 0 )
452 {
453/*
454* If rows of sub( A ) are not contiguous, then allocate the buffer and pack
455* the kbb rows of sub( A ).
456*/
457 Abufld = kbb;
458 if( AisR || ( AmyprocR == AcurrocR ) )
459 {
460 Abuf = PB_Cmalloc( AnpD * kbb * size );
461 PB_CVMpack( TYPE, &VM, COLUMN, &Aroc, PACKING, NOTRAN,
462 kbb, AnpD, one, Mptr( A, Akk, AiiD, Ald,
463 size ), Ald, zero, Abuf, Abufld );
464 }
465 }
466 else
467 {
468/*
469* Otherwise, re-use sub( A ) directly.
470*/
471 Abufld = Ald;
472 if( AisR || ( AmyprocR == AcurrocR ) )
473 Abuf = Mptr( A, Akk+Aoff, AiiD, Ald, size );
474 }
475 PB_Cdescset( DBUFA, kbb, ACnD, kbb, Ainb1D, kbb, AnbD,
476 AcurrocR, ArocD, ctxt, Abufld );
477/*
478* Compute the descriptor DBUFC for the buffer that will contained the packed
479* columns of sub( C ). Allocate it.
480*/
481 if( ( Cfr = ( nrpq < kbb ) ) != 0 )
482 {
483/*
484* If columns of sub( C ) are not contiguous, then allocate receiving buffer.
485*/
486 Cbufld = MAX( 1, CnpD ); talpha = one; tbeta = zero;
487 if( CisR || ( CmyprocR == CcurrocR ) )
488 Cbuf = PB_Cmalloc( CnpD * kbb * size );
489 }
490 else
491 {
492 Cbufld = Cld; talpha = ALPHA; tbeta = BETA;
493 if( CisR || ( CmyprocR == CcurrocR ) )
494 Cbuf = Mptr( C, CiiD, Ckk+Coff, Cld, size );
495 }
496 PB_Cdescset( DBUFC, ACnD, kbb, Cinb1D, kbb, CnbD, kbb, CrocD,
497 CcurrocR, ctxt, Cbufld );
498/*
499* Transpose the one-dimensional buffer Abuf into Cbuf.
500*/
501 PB_Cpaxpby( TYPE, CONJUG, kbb, ACnD, talpha, Abuf, 0, 0,
502 DBUFA, &Aroc, tbeta, Cbuf, 0, 0, DBUFC, &Croc );
503/*
504* Release the buffer containing the packed rows of sub( A )
505*/
506 if( Afr && ( AisR || ( AmyprocR == AcurrocR ) ) )
507 if( Abuf ) free( Abuf );
508/*
509* Unpack the kbb columns of sub( C ) and release the buffer containing them.
510*/
511 if( Cfr && ( CisR || ( CmyprocR == CcurrocR ) ) )
512 {
513 PB_CVMpack( TYPE, &VM, ROW, &Croc, UNPACKING, NOTRAN,
514 kbb, CnpD, BETA, Mptr( C, CiiD, Ckk, Cld,
515 size ), Cld, ALPHA, Cbuf, Cbufld );
516 if( Cbuf ) free( Cbuf );
517 }
518/*
519* Update the local row index of sub( A ) and the local column index of sub( C )
520*/
521 PB_CVMupdate( &VM, kbb, &Ckk, &Akk );
522 npq -= kbb;
523 }
524 }
525 }
526 p = MModAdd1( p, maxp );
527 q = MModAdd1( q, maxq );
528 }
529 }
530/*
531* End of PB_Cptran
532*/
533}
#define Int
Definition Bconfig.h:22
#define C2F_CHAR(a)
Definition pblas.h:125
#define CCOLUMN
Definition PBblacs.h:20
#define COLUMN
Definition PBblacs.h:45
#define CROW
Definition PBblacs.h:21
#define ROW
Definition PBblacs.h:46
void Cblacs_gridinfo()
#define NOTRAN
Definition PBblas.h:44
#define pilaenv_
Definition PBpblas.h:44
#define CTXT_
Definition PBtools.h:38
#define UNPACKING
Definition PBtools.h:54
void PB_CVMinit()
Int PB_Cfirstnb()
#define MAX(a_, b_)
Definition PBtools.h:77
#define MB_
Definition PBtools.h:43
char * PB_Cmalloc()
void PB_Cinfog2l()
#define PACKING
Definition PBtools.h:53
void PB_Cptran()
#define MIN(a_, b_)
Definition PBtools.h:76
#define Mptr(a_, i_, j_, lda_, siz_)
Definition PBtools.h:132
#define LLD_
Definition PBtools.h:47
Int PB_Cnumroc()
Int PB_CVMpack()
void PB_CVMupdate()
Int PB_Cgcd()
#define RSRC_
Definition PBtools.h:45
void PB_Cdescset()
#define MModAdd1(I, d)
Definition PBtools.h:100
#define MModAdd(I1, I2, d)
Definition PBtools.h:97
#define INB_
Definition PBtools.h:42
Int PB_CVMnpq()
#define CSRC_
Definition PBtools.h:46
Int PB_Clcm()
#define IMB_
Definition PBtools.h:41
#define DLEN_
Definition PBtools.h:48
#define NB_
Definition PBtools.h:44
void PB_CVMcontig()
void PB_Cpaxpby()
Int PB_Cspan()
#define TYPE
Definition clamov.c:7