ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pcscal_.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__
20 void pcscal_( int * N, float * ALPHA,
21  float * X, int * IX, int * JX, int * DESCX, int * INCX )
22 #else
23 void pcscal_( N, ALPHA, X, IX, JX, DESCX, INCX )
24 /*
25 * .. Scalar Arguments ..
26 */
27  int * INCX, * IX, * JX, * N;
28  float * ALPHA;
29 /*
30 * .. Array Arguments ..
31 */
32  int * DESCX;
33  float * X;
34 #endif
35 {
36 /*
37 * Purpose
38 * =======
39 *
40 * PCSCAL multiplies an n element subvector sub( X ) by the scalar
41 * alpha,
42 *
43 * where
44 *
45 * sub( X ) denotes X(IX,JX:JX+N-1) if INCX = M_X,
46 * X(IX:IX+N-1,JX) if INCX = 1 and INCX <> M_X.
47 *
48 * Notes
49 * =====
50 *
51 * A description vector is associated with each 2D block-cyclicly dis-
52 * tributed matrix. This vector stores the information required to
53 * establish the mapping between a matrix entry and its corresponding
54 * process and memory location.
55 *
56 * In the following comments, the character _ should be read as
57 * "of the distributed matrix". Let A be a generic term for any 2D
58 * block cyclicly distributed matrix. Its description vector is DESC_A:
59 *
60 * NOTATION STORED IN EXPLANATION
61 * ---------------- --------------- ------------------------------------
62 * DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
63 * CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
64 * the NPROW x NPCOL BLACS process grid
65 * A is distributed over. The context
66 * itself is global, but the handle
67 * (the integer value) may vary.
68 * M_A (global) DESCA[ M_ ] The number of rows in the distribu-
69 * ted matrix A, M_A >= 0.
70 * N_A (global) DESCA[ N_ ] The number of columns in the distri-
71 * buted matrix A, N_A >= 0.
72 * IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
73 * block of the matrix A, IMB_A > 0.
74 * INB_A (global) DESCA[ INB_ ] The number of columns of the upper
75 * left block of the matrix A,
76 * INB_A > 0.
77 * MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
78 * bute the last M_A-IMB_A rows of A,
79 * MB_A > 0.
80 * NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
81 * bute the last N_A-INB_A columns of
82 * A, NB_A > 0.
83 * RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
84 * row of the matrix A is distributed,
85 * NPROW > RSRC_A >= 0.
86 * CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
87 * first column of A is distributed.
88 * NPCOL > CSRC_A >= 0.
89 * LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
90 * array storing the local blocks of
91 * the distributed matrix A,
92 * IF( Lc( 1, N_A ) > 0 )
93 * LLD_A >= MAX( 1, Lr( 1, M_A ) )
94 * ELSE
95 * LLD_A >= 1.
96 *
97 * Let K be the number of rows of a matrix A starting at the global in-
98 * dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
99 * that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
100 * receive if these K rows were distributed over NPROW processes. If K
101 * is the number of columns of a matrix A starting at the global index
102 * JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
103 * lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
104 * these K columns were distributed over NPCOL processes.
105 *
106 * The values of Lr() and Lc() may be determined via a call to the func-
107 * tion PB_Cnumroc:
108 * Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
109 * Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
110 *
111 * Arguments
112 * =========
113 *
114 * N (global input) INTEGER
115 * On entry, N specifies the length of the subvector sub( X ).
116 * N must be at least zero.
117 *
118 * ALPHA (global input) COMPLEX
119 * On entry, ALPHA specifies the scalar alpha. When ALPHA is
120 * supplied as zero then the local entries of the array X cor-
121 * responding to the entries of the subvector sub( X ) need not
122 * be set on input.
123 *
124 * X (local input/local output) COMPLEX array
125 * On entry, X is an array of dimension (LLD_X, Kx), where LLD_X
126 * is at least MAX( 1, Lr( 1, IX ) ) when INCX = M_X and
127 * MAX( 1, Lr( 1, IX+N-1 ) ) otherwise, and, Kx is at least
128 * Lc( 1, JX+N-1 ) when INCX = M_X and Lc( 1, JX ) otherwise.
129 * Before entry, this array contains the local entries of the
130 * matrix X. On exit, sub( X ) is overwritten with the scaled
131 * subvector.
132 *
133 * IX (global input) INTEGER
134 * On entry, IX specifies X's global row index, which points to
135 * the beginning of the submatrix sub( X ).
136 *
137 * JX (global input) INTEGER
138 * On entry, JX specifies X's global column index, which points
139 * to the beginning of the submatrix sub( X ).
140 *
141 * DESCX (global and local input) INTEGER array
142 * On entry, DESCX is an integer array of dimension DLEN_. This
143 * is the array descriptor for the matrix X.
144 *
145 * INCX (global input) INTEGER
146 * On entry, INCX specifies the global increment for the
147 * elements of X. Only two values of INCX are supported in
148 * this version, namely 1 and M_X. INCX must not be zero.
149 *
150 * -- Written on April 1, 1998 by
151 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
152 *
153 * ---------------------------------------------------------------------
154 */
155 /*
156 * .. Local Scalars ..
157 */
158  int Xcol, Xi, Xii, Xj, Xjj, Xld, Xnp, Xnq, Xrow, ctxt, info,
159  mycol, myrow, npcol, nprow;
160  PBTYP_T * type;
161 /*
162 * .. Local Arrays ..
163 */
164  int Xd[DLEN_];
165 /* ..
166 * .. Executable Statements ..
167 *
168 */
169  PB_CargFtoC( *IX, *JX, DESCX, &Xi, &Xj, Xd );
170 #ifndef NO_ARGCHK
171 /*
172 * Test the input parameters
173 */
174  Cblacs_gridinfo( ( ctxt = Xd[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
175  if( !( info = ( ( nprow == -1 ) ? -( 601 + CTXT_ ) : 0 ) ) )
176  PB_Cchkvec( ctxt, "PCSCAL", "X", *N, 1, Xi, Xj, Xd, *INCX, 6, &info );
177  if( info ) { PB_Cabort( ctxt, "PCSCAL", info ); return; }
178 #endif
179 /*
180 * Quick return if possible
181 */
182  if( *N == 0 ) return;
183 
184 /*
185 * Retrieve process grid information
186 */
187 #ifdef NO_ARGCHK
188  Cblacs_gridinfo( Xd[CTXT_], &nprow, &npcol, &myrow, &mycol );
189 #endif
190 /*
191 * Retrieve sub( X )'s local information: Xii, Xjj, Xrow, Xcol
192 */
193  PB_Cinfog2l( Xi, Xj, Xd, nprow, npcol, myrow, mycol, &Xii, &Xjj, &Xrow,
194  &Xcol );
195 /*
196 * Start the operations
197 */
198  if( *INCX == Xd[M_] )
199  {
200 /*
201 * sub( X ) resides in (a) process row(s)
202 */
203  if( ( myrow == Xrow ) || ( Xrow < 0 ) )
204  {
205  if ( ( ALPHA[REAL_PART] == ONE ) && ( ALPHA[IMAG_PART] == ZERO ) ) return;
206 /*
207 * Make sure I own some data and scale sub( X )
208 */
209  Xnq = PB_Cnumroc( *N, Xj, Xd[INB_], Xd[NB_], mycol, Xd[CSRC_], npcol );
210  if( Xnq > 0 )
211  {
212  Xld = Xd[LLD_];
213  type = PB_Cctypeset();
214  if( ( ALPHA[REAL_PART] == ZERO ) && ( ALPHA[IMAG_PART] == ZERO ) )
215  {
216  cset_( &Xnq, ((char *) ALPHA), Mptr( ((char *) X), Xii, Xjj,
217  Xld, type->size ), &Xld );
218  }
219  else
220  {
221  cscal_( &Xnq, ((char *) ALPHA), Mptr( ((char *) X), Xii,
222  Xjj, Xld, type->size ), &Xld );
223  }
224  }
225  }
226  return;
227  }
228  else
229  {
230 /*
231 * sub( X ) resides in (a) process column(s)
232 */
233  if( ( mycol == Xcol ) || ( Xcol < 0 ) )
234  {
235  if ( ( ALPHA[REAL_PART] == ONE ) && ( ALPHA[IMAG_PART] == ZERO ) ) return;
236 /*
237 * Make sure I own some data and scale sub( X )
238 */
239  Xnp = PB_Cnumroc( *N, Xi, Xd[IMB_], Xd[MB_], myrow, Xd[RSRC_], nprow );
240  if( Xnp > 0 )
241  {
242  type = PB_Cctypeset();
243  if( ( ALPHA[REAL_PART] == ZERO ) && ( ALPHA[IMAG_PART] == ZERO ) )
244  {
245  cset_( &Xnp, ((char *) ALPHA), Mptr( ((char *) X), Xii,
246  Xjj, Xd[LLD_], type->size ), INCX );
247  }
248  else
249  {
250  cscal_( &Xnp, ((char *) ALPHA), Mptr( ((char *) X), Xii,
251  Xjj, Xd[LLD_], type->size ), INCX );
252  }
253  }
254  }
255  return;
256  }
257 /*
258 * End of PCSCAL
259 */
260 }
M_
#define M_
Definition: PBtools.h:39
MB_
#define MB_
Definition: PBtools.h:43
NB_
#define NB_
Definition: PBtools.h:44
CSRC_
#define CSRC_
Definition: PBtools.h:46
PBblacs.h
PBtools.h
PBblas.h
REAL_PART
#define REAL_PART
Definition: pblas.h:135
PBpblas.h
DLEN_
#define DLEN_
Definition: PBtools.h:48
LLD_
#define LLD_
Definition: PBtools.h:47
ZERO
#define ZERO
Definition: PBtools.h:66
PB_Cchkvec
void PB_Cchkvec()
IMB_
#define IMB_
Definition: PBtools.h:41
PB_Cabort
void PB_Cabort()
cscal_
F_VOID_FCT cscal_()
ONE
#define ONE
Definition: PBtools.h:64
RSRC_
#define RSRC_
Definition: PBtools.h:45
PB_CargFtoC
void PB_CargFtoC()
pcscal_
void pcscal_(int *N, float *ALPHA, float *X, int *IX, int *JX, int *DESCX, int *INCX)
Definition: pcscal_.c:23
PBTYP_T::size
int size
Definition: pblas.h:329
PB_Cinfog2l
void PB_Cinfog2l()
PB_Cnumroc
int PB_Cnumroc()
cset_
F_VOID_FCT cset_()
INB_
#define INB_
Definition: PBtools.h:42
Cblacs_gridinfo
void Cblacs_gridinfo()
PBTYP_T
Definition: pblas.h:325
pblas.h
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CTXT_
#define CTXT_
Definition: PBtools.h:38
IMAG_PART
#define IMAG_PART
Definition: pblas.h:136
PB_Cctypeset
PBTYP_T * PB_Cctypeset()
Definition: PB_Cctypeset.c:19