ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pdscal_.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 pdscal_( int * N, double * ALPHA,
21  double * X, int * IX, int * JX, int * DESCX, int * INCX )
22 #else
23 void pdscal_( N, ALPHA, X, IX, JX, DESCX, INCX )
24 /*
25 * .. Scalar Arguments ..
26 */
27  int * INCX, * IX, * JX, * N;
28  double * ALPHA;
29 /*
30 * .. Array Arguments ..
31 */
32  int * DESCX;
33  double * X;
34 #endif
35 {
36 /*
37 * Purpose
38 * =======
39 *
40 * PDSCAL 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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 /*
161 * .. Local Arrays ..
162 */
163  int Xd[DLEN_];
164 /* ..
165 * .. Executable Statements ..
166 *
167 */
168  PB_CargFtoC( *IX, *JX, DESCX, &Xi, &Xj, Xd );
169 #ifndef NO_ARGCHK
170 /*
171 * Test the input parameters
172 */
173  Cblacs_gridinfo( ( ctxt = Xd[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
174  if( !( info = ( ( nprow == -1 ) ? -( 601 + CTXT_ ) : 0 ) ) )
175  PB_Cchkvec( ctxt, "PDSCAL", "X", *N, 1, Xi, Xj, Xd, *INCX, 6, &info );
176  if( info ) { PB_Cabort( ctxt, "PDSCAL", info ); return; }
177 #endif
178 /*
179 * Quick return if possible
180 */
181  if( *N == 0 ) return;
182 /*
183 * Retrieve process grid information
184 */
185 #ifdef NO_ARGCHK
186  Cblacs_gridinfo( Xd[CTXT_], &nprow, &npcol, &myrow, &mycol );
187 #endif
188 /*
189 * Retrieve sub( X )'s local information: Xii, Xjj, Xrow, Xcol
190 */
191  PB_Cinfog2l( Xi, Xj, Xd, nprow, npcol, myrow, mycol, &Xii, &Xjj, &Xrow,
192  &Xcol );
193 /*
194 * Start the operations
195 */
196  if( *INCX == Xd[M_] )
197  {
198 /*
199 * sub( X ) resides in (a) process row(s)
200 */
201  if( ( myrow == Xrow ) || ( Xrow < 0 ) )
202  {
203  if( ALPHA[REAL_PART] == ONE ) return;
204 /*
205 * Make sure I own some data and scale sub( X )
206 */
207  Xnq = PB_Cnumroc( *N, Xj, Xd[INB_], Xd[NB_], mycol, Xd[CSRC_], npcol );
208  if( Xnq > 0 )
209  {
210  Xld = Xd[LLD_];
211  if( ALPHA[REAL_PART] == ZERO )
212  {
213  dset_( &Xnq, ((char *) ALPHA), ((char *)(X+(Xii+Xjj*Xld))),
214  &Xld );
215  }
216  else
217  {
218  dscal_( &Xnq, ((char *) ALPHA), ((char *)(X+(Xii+Xjj*Xld))),
219  &Xld );
220  }
221  }
222  }
223  return;
224  }
225  else
226  {
227 /*
228 * sub( X ) resides in (a) process column(s)
229 */
230  if( ( mycol == Xcol ) || ( Xcol < 0 ) )
231  {
232  if( ALPHA[REAL_PART] == ONE ) return;
233 /*
234 * Make sure I own some data and scale sub( X )
235 */
236  Xnp = PB_Cnumroc( *N, Xi, Xd[IMB_], Xd[MB_], myrow, Xd[RSRC_], nprow );
237  if( Xnp > 0 )
238  {
239  if( ALPHA[REAL_PART] == ZERO )
240  {
241  dset_( &Xnp, ((char *) ALPHA),
242  ((char *)( X+(Xii+Xjj*Xd[LLD_]) )), INCX );
243  }
244  else
245  {
246  dscal_( &Xnp, ((char *) ALPHA),
247  ((char *)( X+(Xii+Xjj*Xd[LLD_]) )), INCX );
248  }
249  }
250  }
251  return;
252  }
253 /*
254 * End of PDSCAL
255 */
256 }
M_
#define M_
Definition: PBtools.h:39
pdscal_
void pdscal_(int *N, double *ALPHA, double *X, int *IX, int *JX, int *DESCX, int *INCX)
Definition: pdscal_.c:23
MB_
#define MB_
Definition: PBtools.h:43
NB_
#define NB_
Definition: PBtools.h:44
CSRC_
#define CSRC_
Definition: PBtools.h:46
dset_
F_VOID_FCT dset_()
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()
ONE
#define ONE
Definition: PBtools.h:64
RSRC_
#define RSRC_
Definition: PBtools.h:45
PB_CargFtoC
void PB_CargFtoC()
PB_Cinfog2l
void PB_Cinfog2l()
PB_Cnumroc
int PB_Cnumroc()
INB_
#define INB_
Definition: PBtools.h:42
Cblacs_gridinfo
void Cblacs_gridinfo()
pblas.h
CTXT_
#define CTXT_
Definition: PBtools.h:38
dscal_
F_VOID_FCT dscal_()