ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Cplaprnt.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_Cplaprnt( PBTYP_T * TYPE, int M, int N,
21  char * A, int IA, int JA, int * DESCA,
22  int IRPRNT, int ICPRNT, char * CMATNM )
23 #else
24 void PB_Cplaprnt( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, CMATNM )
25 /*
26 * .. Scalar Arguments ..
27 */
28  int IA, ICPRNT, IRPRNT, JA, M, N;
29  PBTYP_T * TYPE;
30 /*
31 * .. Array Arguments ..
32 */
33  int * DESCA;
34  char * A, * CMATNM;
35 #endif
36 {
37 /*
38 * Purpose
39 * =======
40 *
41 * PB_Cplaprnt prints to the standard output the submatrix sub( A ) de-
42 * noting A(IA:IA+M-1,JA:JA+N-1). The local pieces of sub( A ) are sent
43 * and printed by the process of coordinates (IRPRNT, ICPRNT).
44 *
45 * Notes
46 * =====
47 *
48 * A description vector is associated with each 2D block-cyclicly dis-
49 * tributed matrix. This vector stores the information required to
50 * establish the mapping between a matrix entry and its corresponding
51 * process and memory location.
52 *
53 * In the following comments, the character _ should be read as
54 * "of the distributed matrix". Let A be a generic term for any 2D
55 * block cyclicly distributed matrix. Its description vector is DESC_A:
56 *
57 * NOTATION STORED IN EXPLANATION
58 * ---------------- --------------- ------------------------------------
59 * DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
60 * CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
61 * the NPROW x NPCOL BLACS process grid
62 * A is distributed over. The context
63 * itself is global, but the handle
64 * (the integer value) may vary.
65 * M_A (global) DESCA[ M_ ] The number of rows in the distribu-
66 * ted matrix A, M_A >= 0.
67 * N_A (global) DESCA[ N_ ] The number of columns in the distri-
68 * buted matrix A, N_A >= 0.
69 * IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
70 * block of the matrix A, IMB_A > 0.
71 * INB_A (global) DESCA[ INB_ ] The number of columns of the upper
72 * left block of the matrix A,
73 * INB_A > 0.
74 * MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
75 * bute the last M_A-IMB_A rows of A,
76 * MB_A > 0.
77 * NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
78 * bute the last N_A-INB_A columns of
79 * A, NB_A > 0.
80 * RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
81 * row of the matrix A is distributed,
82 * NPROW > RSRC_A >= 0.
83 * CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
84 * first column of A is distributed.
85 * NPCOL > CSRC_A >= 0.
86 * LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
87 * array storing the local blocks of
88 * the distributed matrix A,
89 * IF( Lc( 1, N_A ) > 0 )
90 * LLD_A >= MAX( 1, Lr( 1, M_A ) )
91 * ELSE
92 * LLD_A >= 1.
93 *
94 * Let K be the number of rows of a matrix A starting at the global in-
95 * dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
96 * that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
97 * receive if these K rows were distributed over NPROW processes. If K
98 * is the number of columns of a matrix A starting at the global index
99 * JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
100 * lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
101 * these K columns were distributed over NPCOL processes.
102 *
103 * The values of Lr() and Lc() may be determined via a call to the func-
104 * tion PB_Cnumroc:
105 * Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
106 * Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
107 *
108 * Arguments
109 * =========
110 *
111 * TYPE (local input) pointer to a PBTYP_T structure
112 * On entry, TYPE is a pointer to a structure of type PBTYP_T,
113 * that contains type information (See pblas.h).
114 *
115 * M (global input) INTEGER
116 * On entry, M specifies the number of rows of the submatrix
117 * sub( A ). M must be at least zero.
118 *
119 * N (global input) INTEGER
120 * On entry, N specifies the number of columns of the submatrix
121 * sub( A ). N must be at least zero.
122 *
123 * A (local input) pointer to CHAR
124 * On entry, A is an array of dimension (LLD_A, Ka), where Ka is
125 * at least Lc( 1, JA+N-1 ). Before entry, this array contains
126 * the local entries of the matrix A.
127 *
128 * IA (global input) INTEGER
129 * On entry, IA specifies A's global row index, which points to
130 * the beginning of the submatrix sub( A ).
131 *
132 * JA (global input) INTEGER
133 * On entry, JA specifies A's global column index, which points
134 * to the beginning of the submatrix sub( A ).
135 *
136 * DESCA (global and local input) INTEGER array
137 * On entry, DESCA is an integer array of dimension DLEN_. This
138 * is the array descriptor for the matrix A.
139 *
140 * IRPRNT (global input) INTEGER
141 * On entry, IRPRNT specifies the row index of the printing pro-
142 * cess.
143 *
144 * ICPRNT (global input) INTEGER
145 * On entry, ICPRNT specifies the column index of the printing
146 * process.
147 *
148 * CMATNM (global input) pointer to CHAR
149 * On entry, CMATNM is the name of the matrix to be printed.
150 *
151 * -- Written on April 1, 1998 by
152 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
153 *
154 * ---------------------------------------------------------------------
155 */
156 /*
157 * .. Local Scalars ..
158 */
159  int mycol, myrow, npcol, nprow, pcol, prow;
160 /* ..
161 * .. Executable Statements ..
162 *
163 */
164 /*
165 * Retrieve process grid information
166 */
167  Cblacs_gridinfo( DESCA[CTXT_], &nprow, &npcol, &myrow, &mycol );
168 /*
169 * When sub( A ) is replicated, each copy is printed for debugging purposes.
170 */
171  if( DESCA[ RSRC_ ] >= 0 )
172  {
173 /*
174 * sub( A ) is distributed onto the process rows of the grid
175 */
176  if( DESCA[ CSRC_ ] >= 0 )
177  {
178 /*
179 * sub( A ) is distributed onto the process columns of the grid
180 */
181  PB_Cplaprn2( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, CMATNM,
182  DESCA[ RSRC_ ], DESCA[ CSRC_ ] );
183  }
184  else
185  {
186 /*
187 * sub( A ) is replicated in every process column of the grid
188 */
189  for( pcol = 0; pcol < npcol; pcol++ )
190  {
191  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
192  (void) fprintf( stdout,
193  "Colum-replicated array -- copy in process column: %d\n", pcol );
194  PB_Cplaprn2( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, CMATNM,
195  DESCA[ RSRC_ ], pcol );
196  }
197  }
198  }
199  else
200  {
201 /*
202 * sub( A ) is replicated in every process row of the grid
203 */
204  if( DESCA[ CSRC_ ] >= 0 )
205  {
206 /*
207 * sub( A ) is distributed onto the process columns of the grid
208 */
209  for( prow = 0; prow < nprow; prow++ )
210  {
211  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
212  (void) fprintf( stdout,
213  "Row-replicated array -- copy in process row: %d\n", prow );
214  PB_Cplaprn2( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, CMATNM,
215  prow, DESCA[ CSRC_ ] );
216  }
217  }
218  else
219  {
220 /*
221 * sub( A ) is replicated in every process column of the grid
222 */
223  for( prow = 0; prow < nprow; prow++ )
224  {
225  for( pcol = 0; pcol < npcol; pcol++ )
226  {
227  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
228  (void) fprintf( stdout,
229  "Replicated array -- copy in process (%d,%d)\n", prow, pcol );
230  PB_Cplaprn2( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT,
231  CMATNM, prow, pcol );
232  }
233  }
234  }
235  }
236 /*
237 * End of PB_Cplaprnt
238 */
239 }
240 
241 #ifdef __STDC__
242 void PB_Cplaprn2( PBTYP_T * TYPE, int M, int N, char * A, int IA,
243  int JA, int * DESCA, int IRPRNT, int ICPRNT,
244  char * CMATNM, int PROW, int PCOL )
245 #else
246 void PB_Cplaprn2( TYPE, M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, CMATNM,
247  PROW, PCOL )
248 /*
249 * .. Scalar Arguments ..
250 */
251  int IA, ICPRNT, IRPRNT, JA, M, N, PCOL, PROW;
252  PBTYP_T * TYPE;
253 /*
254 * .. Array Arguments ..
255 */
256  int * DESCA;
257  char * A, * CMATNM;
258 #endif
259 {
260 /*
261 * .. Local Scalars ..
262 */
263  char type;
264  int Acol, Aii, AisColRep, AisRowRep, Ajj, Ald, Arow, ctxt, h, i,
265  ib, icurcol, icurrow, ii, in, j, jb, jj, jn, ldw, mycol,
266  myrow, npcol, nprow, size, usiz;
267 /*
268 * .. Local Arrays ..
269 */
270  char * buf = NULL;
271 /* ..
272 * .. Executable Statements ..
273 *
274 */
275 /*
276 * Retrieve process grid information
277 */
278  Cblacs_gridinfo( ( ctxt = DESCA[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
279 /*
280 * Retrieve sub( A )'s local information: Aii, Ajj, Arow, Acol ...
281 */
282  Ald = DESCA[LLD_];
283  PB_Cinfog2l( IA, JA, DESCA, nprow, npcol, myrow, mycol, &Aii, &Ajj, &Arow,
284  &Acol );
285 /*
286 * Save the local first index of each row and column sub( A )
287 */
288  ii = Aii;
289  jj = Ajj;
290 /*
291 * When sub( A ) is row-replicated, print the copy in process row PROW.
292 * Otherwise, print the distributed matrix rows starting in process row Arow.
293 */
294  if( Arow < 0 ) { AisRowRep = 1; icurrow = Arow = PROW; }
295  else { AisRowRep = 0; icurrow = Arow; }
296 /*
297 * When sub( A ) is column-replicated, print the copy in process column PCOL.
298 * Otherwise, print the distributed matrix columns starting in process column
299 * Acol.
300 */
301  if( Acol < 0 ) { AisColRep = 1; icurcol = Acol = PCOL; }
302  else { AisColRep = 0; icurcol = Acol; }
303 
304  type = TYPE->type; usiz = TYPE->usiz; size = TYPE->size;
305 /*
306 * Allocate buffer in printing process
307 */
308  ldw = MAX( DESCA[ IMB_ ], DESCA[ MB_ ] );
309  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
310  buf = PB_Cmalloc( ldw * size );
311 /*
312 * Handle the first block of column separately
313 */
314  jb = PB_Cfirstnb( N, JA, DESCA[INB_], DESCA[NB_] );
315  jn = JA + jb - 1;
316 
317  for( h = 0; h < jb; h++ )
318  {
319  ib = PB_Cfirstnb( M, IA, DESCA[IMB_], DESCA[MB_] );
320  in = IA + ib - 1;
321 
322  if( ( icurrow == IRPRNT ) && ( icurcol == ICPRNT ) )
323  {
324  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
325  {
326  PB_Cprnt( type, size, usiz, ib, Mptr( A, ii, jj+h, Ald, size ),
327  IA+1, JA+h+1, CMATNM );
328  }
329  }
330  else
331  {
332  if( ( myrow == icurrow ) && ( mycol == icurcol ) )
333  {
334  TYPE->Cgesd2d( ctxt, ib, 1, Mptr( A, ii, jj+h, Ald, size ), Ald,
335  IRPRNT, ICPRNT );
336  }
337  else if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
338  {
339  TYPE->Cgerv2d( ctxt, ib, 1, buf, ldw, icurrow, icurcol );
340  PB_Cprnt( type, size, usiz, ib, buf, IA+1, JA+h+1, CMATNM );
341  }
342  }
343 /*
344 * Go to next block of rows
345 */
346  if( myrow == icurrow ) ii += ib;
347  if( !( AisRowRep ) ) icurrow = MModAdd1( icurrow, nprow );
348 
349  Cblacs_barrier( ctxt, ALL );
350 /*
351 * Loop over remaining block of rows
352 */
353  for( i = in+1; i <= IA+M-1; i += DESCA[MB_] )
354  {
355  ib = MIN( DESCA[MB_], IA+M-i );
356  if( ( icurrow == IRPRNT ) && ( icurcol == ICPRNT ) )
357  {
358  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
359  {
360  PB_Cprnt( type, size, usiz, ib, Mptr( A, ii, jj+h, Ald, size ),
361  i+1, JA+h+1, CMATNM );
362  }
363  }
364  else
365  {
366  if( ( myrow == icurrow ) && ( mycol == icurcol ) )
367  {
368  TYPE->Cgesd2d( ctxt, ib, 1, Mptr( A, ii, jj+h, Ald, size ), Ald,
369  IRPRNT, ICPRNT );
370  }
371  else if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
372  {
373  TYPE->Cgerv2d( ctxt, ib, 1, buf, ldw, icurrow, icurcol );
374  PB_Cprnt( type, size, usiz, ib, buf, i+1, JA+h+1, CMATNM);
375  }
376  }
377 /*
378 * Go to next block of rows
379 */
380  if( myrow == icurrow ) ii += ib;
381  if( !( AisRowRep ) ) icurrow = MModAdd1( icurrow, nprow );
382 
383  Cblacs_barrier( ctxt, ALL );
384  }
385 /*
386 * Restart at the first row to be printed
387 */
388  ii = Aii;
389  icurrow = Arow;
390  }
391 /*
392 * Go to next block of columns
393 */
394  if( mycol == icurcol ) jj += jb;
395  if( !( AisColRep ) ) icurcol = MModAdd1( icurcol, npcol );
396 
397  Cblacs_barrier( ctxt, ALL );
398 /*
399 * Loop over remaining column blocks
400 */
401  for( j = jn+1; j <= JA+N-1; j += DESCA[NB_] )
402  {
403  jb = MIN( DESCA[NB_], JA+N-j );
404  for( h = 0; h < jb; h++ )
405  {
406  ib = PB_Cfirstnb( M, IA, DESCA[IMB_], DESCA[MB_] );
407  in = IA + ib - 1;
408 
409  if( ( icurrow == IRPRNT ) && ( icurcol == ICPRNT ) )
410  {
411  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
412  {
413  PB_Cprnt( type, size, usiz, ib, Mptr( A, ii, jj+h, Ald, size ),
414  IA+1, j+h+1, CMATNM );
415  }
416  }
417  else
418  {
419  if( ( myrow == icurrow ) && ( mycol == icurcol ) )
420  {
421  TYPE->Cgesd2d( ctxt, ib, 1, Mptr( A, ii, jj+h, Ald, size ), Ald,
422  IRPRNT, ICPRNT );
423  }
424  else if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
425  {
426  TYPE->Cgerv2d( ctxt, ib, 1, buf, ldw, icurrow, icurcol );
427  PB_Cprnt( type, size, usiz, ib, buf, IA+1, j+h+1, CMATNM );
428  }
429  }
430 /*
431 * Go to next block of rows
432 */
433  if( myrow == icurrow ) ii += ib;
434  if( !( AisRowRep ) ) icurrow = MModAdd1( icurrow, nprow );
435 
436  Cblacs_barrier( ctxt, ALL );
437 /*
438 * Loop over remaining block of rows
439 */
440  for( i = in+1; i <= IA+M-1; i += DESCA[MB_] )
441  {
442  ib = MIN( DESCA[MB_], IA+M-i );
443  if( ( icurrow == IRPRNT ) && ( icurcol == ICPRNT ) )
444  {
445  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
446  {
447  PB_Cprnt( type, size, usiz, ib, Mptr( A, ii, jj+h, Ald,
448  size ), i+1, j+h+1, CMATNM );
449  }
450  }
451  else
452  {
453  if( ( myrow == icurrow ) && ( mycol == icurcol ) )
454  {
455  TYPE->Cgesd2d( ctxt, ib, 1, Mptr( A, ii, jj+h, Ald, size ),
456  Ald, IRPRNT, ICPRNT );
457  }
458  else if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) )
459  {
460  TYPE->Cgerv2d( ctxt, ib, 1, buf, ldw, icurrow, icurcol );
461  PB_Cprnt( type, size, usiz, ib, buf, i+1, j+h+1, CMATNM );
462  }
463  }
464 /*
465 * Go to next block of rows
466 */
467  if( myrow == icurrow ) ii += ib;
468  if( !( AisRowRep ) ) icurrow = MModAdd1( icurrow, nprow );
469 
470  Cblacs_barrier( ctxt, ALL );
471  }
472 /*
473 * Restart at the first row to be printed
474 */
475  ii = Aii;
476  icurrow = Arow;
477  }
478 /*
479 * Go to next block of columns
480 */
481  if( mycol == icurcol ) jj += jb;
482  if( !( AisColRep ) ) icurcol = MModAdd1( icurcol, npcol );
483 
484  Cblacs_barrier( ctxt, ALL );
485  }
486 
487  if( ( myrow == IRPRNT ) && ( mycol == ICPRNT ) && ( buf ) ) free( buf );
488 /*
489 * End of PB_Cplaprn2
490 */
491 }
492 
493 #ifdef __STDC__
494 void PB_Cprnt( char TYPE, int SIZE, int USIZ, int N, char * A, int IA,
495  int JA, char * CMATNM )
496 #else
497 void PB_Cprnt( TYPE, SIZE, USIZ, N, A, IA, JA, CMATNM )
498 /*
499 * .. Scalar Arguments ..
500 */
501  int IA, JA, N, SIZE, TYPE, USIZ;
502 /*
503 * .. Array Arguments ..
504 */
505  char * A, * CMATNM;
506 #endif
507 {
508 /*
509 * .. Local Scalars ..
510 */
511  int k;
512 /* ..
513 * .. Executable Statements ..
514 *
515 */
516  if( TYPE == INT )
517  for( k = 0; k < N; k++ )
518  (void) fprintf( stdout, "%s(%6d,%6d)=%8d\n", CMATNM, IA+k, JA,
519  *((int *)(&A[k*SIZE])) );
520  else if( TYPE == SREAL )
521  for( k = 0; k < N; k++ )
522  (void) fprintf( stdout, "%s(%6d,%6d)=%16.8f\n", CMATNM, IA+k, JA,
523  *((float *)(&A[k*SIZE])) );
524  else if( TYPE == DREAL )
525  for( k = 0; k < N; k++ )
526  (void) fprintf( stdout, "%s(%6d,%6d)=%30.18f\n", CMATNM, IA+k, JA,
527  *((double *)(&A[k*SIZE])) );
528  else if( TYPE == SCPLX )
529  for( k = 0; k < N; k++ )
530  (void) fprintf( stdout, "%s(%6d,%6d)=%16.8f+i*(%16.8f)\n", CMATNM,
531  IA+k, JA, *((float *)(&A[k*SIZE])),
532  *((float *)(&A[k*SIZE+USIZ])) );
533  else if( TYPE == DCPLX )
534  for( k = 0; k < N; k++ )
535  (void) fprintf( stdout, "%s(%6d,%6d)=%30.18f+i*(%30.18f)\n", CMATNM,
536  IA+k, JA, *((double *)(&A[k*SIZE])),
537  *((double *)(&A[k*SIZE+USIZ])) );
538 /*
539 * End of PB_Cprnt
540 */
541 }
TYPE
#define TYPE
Definition: clamov.c:7
MB_
#define MB_
Definition: PBtools.h:43
NB_
#define NB_
Definition: PBtools.h:44
CSRC_
#define CSRC_
Definition: PBtools.h:46
PB_Cfirstnb
int PB_Cfirstnb()
DCPLX
#define DCPLX
Definition: pblas.h:472
LLD_
#define LLD_
Definition: PBtools.h:47
IMB_
#define IMB_
Definition: PBtools.h:41
MModAdd1
#define MModAdd1(I, d)
Definition: PBtools.h:100
INT
#define INT
Definition: pblas.h:468
PB_Cplaprn2
void PB_Cplaprn2(PBTYP_T *TYPE, int M, int N, char *A, int IA, int JA, int *DESCA, int IRPRNT, int ICPRNT, char *CMATNM, int PROW, int PCOL)
Definition: PB_Cplaprnt.c:246
RSRC_
#define RSRC_
Definition: PBtools.h:45
SREAL
#define SREAL
Definition: pblas.h:469
Cblacs_barrier
void Cblacs_barrier()
PB_Cinfog2l
void PB_Cinfog2l()
PB_Cmalloc
char * PB_Cmalloc()
PB_Cplaprnt
void PB_Cplaprnt(PBTYP_T *TYPE, int M, int N, char *A, int IA, int JA, int *DESCA, int IRPRNT, int ICPRNT, char *CMATNM)
Definition: PB_Cplaprnt.c:24
ALL
#define ALL
Definition: PBblas.h:50
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
INB_
#define INB_
Definition: PBtools.h:42
PB_Cprnt
void PB_Cprnt(int TYPE, int SIZE, int USIZ, int N, char *A, int IA, int JA, char *CMATNM)
Definition: PB_Cplaprnt.c:497
DREAL
#define DREAL
Definition: pblas.h:470
MAX
#define MAX(a_, b_)
Definition: PBtools.h:77
Cblacs_gridinfo
void Cblacs_gridinfo()
PBTYP_T
Definition: pblas.h:325
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CTXT_
#define CTXT_
Definition: PBtools.h:38
SCPLX
#define SCPLX
Definition: pblas.h:471