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__
picopy_(int * N,int * X,int * IX,int * JX,int * DESCX,int * INCX,int * Y,int * IY,int * JY,int * DESCY,int * INCY)20 void picopy_( int * N,
21 int * X, int * IX, int * JX, int * DESCX, int * INCX,
22 int * Y, int * IY, int * JY, int * DESCY, int * INCY )
23 #else
24 void picopy_( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, INCY )
25 /*
26 * .. Scalar Arguments ..
27 */
28 int * INCX, * INCY, * IX, * IY, * JX, * JY, * N;
29 /*
30 * .. Array Arguments ..
31 */
32 int * DESCX, * DESCY;
33 int * X, * Y;
34 #endif
35 {
36 /*
37 * Purpose
38 * =======
39 *
40 * PICOPY copies one subvector into another,
41 *
42 * sub( Y ) := sub( X ),
43 *
44 * where
45 *
46 * sub( X ) denotes X(IX,JX:JX+N-1) if INCX = M_X,
47 * X(IX:IX+N-1,JX) if INCX = 1 and INCX <> M_X, and,
48 *
49 * sub( Y ) denotes Y(IY,JY:JY+N-1) if INCY = M_Y,
50 * Y(IY:IY+N-1,JY) if INCY = 1 and INCY <> M_Y.
51 *
52 * Notes
53 * =====
54 *
55 * A description vector is associated with each 2D block-cyclicly dis-
56 * tributed matrix. This vector stores the information required to
57 * establish the mapping between a matrix entry and its corresponding
58 * process and memory location.
59 *
60 * In the following comments, the character _ should be read as
61 * "of the distributed matrix". Let A be a generic term for any 2D
62 * block cyclicly distributed matrix. Its description vector is DESC_A:
63 *
64 * NOTATION STORED IN EXPLANATION
65 * ---------------- --------------- ------------------------------------
66 * DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
67 * CTXT_A (global) DESCA[ CTXT_ ] The BLACS context handle, indicating
68 * the NPROW x NPCOL BLACS process grid
69 * A is distributed over. The context
70 * itself is global, but the handle
71 * (the integer value) may vary.
72 * M_A (global) DESCA[ M_ ] The number of rows in the distribu-
73 * ted matrix A, M_A >= 0.
74 * N_A (global) DESCA[ N_ ] The number of columns in the distri-
75 * buted matrix A, N_A >= 0.
76 * IMB_A (global) DESCA[ IMB_ ] The number of rows of the upper left
77 * block of the matrix A, IMB_A > 0.
78 * INB_A (global) DESCA[ INB_ ] The number of columns of the upper
79 * left block of the matrix A,
80 * INB_A > 0.
81 * MB_A (global) DESCA[ MB_ ] The blocking factor used to distri-
82 * bute the last M_A-IMB_A rows of A,
83 * MB_A > 0.
84 * NB_A (global) DESCA[ NB_ ] The blocking factor used to distri-
85 * bute the last N_A-INB_A columns of
86 * A, NB_A > 0.
87 * RSRC_A (global) DESCA[ RSRC_ ] The process row over which the first
88 * row of the matrix A is distributed,
89 * NPROW > RSRC_A >= 0.
90 * CSRC_A (global) DESCA[ CSRC_ ] The process column over which the
91 * first column of A is distributed.
92 * NPCOL > CSRC_A >= 0.
93 * LLD_A (local) DESCA[ LLD_ ] The leading dimension of the local
94 * array storing the local blocks of
95 * the distributed matrix A,
96 * IF( Lc( 1, N_A ) > 0 )
97 * LLD_A >= MAX( 1, Lr( 1, M_A ) )
98 * ELSE
99 * LLD_A >= 1.
100 *
101 * Let K be the number of rows of a matrix A starting at the global in-
102 * dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
103 * that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
104 * receive if these K rows were distributed over NPROW processes. If K
105 * is the number of columns of a matrix A starting at the global index
106 * JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
107 * lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
108 * these K columns were distributed over NPCOL processes.
109 *
110 * The values of Lr() and Lc() may be determined via a call to the func-
111 * tion PB_Cnumroc:
112 * Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
113 * Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
114 *
115 * Arguments
116 * =========
117 *
118 * N (global input) INTEGER
119 * On entry, N specifies the length of the subvectors to be
120 * copied. N must be at least zero.
121 *
122 * X (local input) INTEGER array
123 * On entry, X is an array of dimension (LLD_X, Kx), where LLD_X
124 * is at least MAX( 1, Lr( 1, IX ) ) when INCX = M_X and
125 * MAX( 1, Lr( 1, IX+N-1 ) ) otherwise, and, Kx is at least
126 * Lc( 1, JX+N-1 ) when INCX = M_X and Lc( 1, JX ) otherwise.
127 * Before entry, this array contains the local entries of the
128 * matrix X.
129 *
130 * IX (global input) INTEGER
131 * On entry, IX specifies X's global row index, which points to
132 * the beginning of the submatrix sub( X ).
133 *
134 * JX (global input) INTEGER
135 * On entry, JX specifies X's global column index, which points
136 * to the beginning of the submatrix sub( X ).
137 *
138 * DESCX (global and local input) INTEGER array
139 * On entry, DESCX is an integer array of dimension DLEN_. This
140 * is the array descriptor for the matrix X.
141 *
142 * INCX (global input) INTEGER
143 * On entry, INCX specifies the global increment for the
144 * elements of X. Only two values of INCX are supported in
145 * this version, namely 1 and M_X. INCX must not be zero.
146 *
147 * Y (local output) INTEGER array
148 * On entry, Y is an array of dimension (LLD_Y, Ky), where LLD_Y
149 * is at least MAX( 1, Lr( 1, IY ) ) when INCY = M_Y and
150 * MAX( 1, Lr( 1, IY+N-1 ) ) otherwise, and, Ky is at least
151 * Lc( 1, JY+N-1 ) when INCY = M_Y and Lc( 1, JY ) otherwise.
152 * Before entry, this array contains the local entries of the
153 * matrix Y. On exit, sub( Y ) is overwritten with sub( X ).
154 *
155 * IY (global input) INTEGER
156 * On entry, IY specifies Y's global row index, which points to
157 * the beginning of the submatrix sub( Y ).
158 *
159 * JY (global input) INTEGER
160 * On entry, JY specifies Y's global column index, which points
161 * to the beginning of the submatrix sub( Y ).
162 *
163 * DESCY (global and local input) INTEGER array
164 * On entry, DESCY is an integer array of dimension DLEN_. This
165 * is the array descriptor for the matrix Y.
166 *
167 * INCY (global input) INTEGER
168 * On entry, INCY specifies the global increment for the
169 * elements of Y. Only two values of INCY are supported in
170 * this version, namely 1 and M_Y. INCY must not be zero.
171 *
172 * -- Written on April 1, 1998 by
173 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
174 *
175 * ---------------------------------------------------------------------
176 */
177 /*
178 * .. Local Scalars ..
179 */
180 int Xi, Xj, Yi, Yj, ctxt, info, mycol, myrow, npcol, nprow;
181 PBTYP_T * type;
182 /*
183 * .. Local Arrays ..
184 */
185 int Xd[DLEN_], Yd[DLEN_];
186 /* ..
187 * .. Executable Statements ..
188 *
189 */
190 PB_CargFtoC( *IX, *JX, DESCX, &Xi, &Xj, Xd );
191 PB_CargFtoC( *IY, *JY, DESCY, &Yi, &Yj, Yd );
192 #ifndef NO_ARGCHK
193 /*
194 * Test the input parameters
195 */
196 Cblacs_gridinfo( ( ctxt = Xd[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
197 if( !( info = ( ( nprow == -1 ) ? -( 501 + CTXT_ ) : 0 ) ) )
198 {
199 PB_Cchkvec( ctxt, "PICOPY", "X", *N, 1, Xi, Xj, Xd, *INCX, 5, &info );
200 PB_Cchkvec( ctxt, "PICOPY", "Y", *N, 1, Yi, Yj, Yd, *INCY, 10, &info );
201 }
202 if( info ) { PB_Cabort( ctxt, "PICOPY", info ); return; }
203 #endif
204 /*
205 * Quick return if possible
206 */
207 if( *N == 0 ) return;
208 /*
209 * Get type structure
210 */
211 type = PB_Citypeset();
212 /*
213 * Start the operations
214 */
215 if( *INCX == Xd[M_] )
216 {
217 PB_Cpaxpby( type, NOCONJG, 1, *N, type->one, ((char *) X), Xi,
218 Xj, Xd, ROW, type->zero, ((char *) Y), Yi, Yj, Yd,
219 ( *INCY == Yd[M_] ? ROW : COLUMN ) );
220 }
221 else
222 {
223 PB_Cpaxpby( type, NOCONJG, *N, 1, type->one, ((char *) X), Xi,
224 Xj, Xd, COLUMN, type->zero, ((char *) Y), Yi, Yj, Yd,
225 ( *INCY == Yd[M_] ? ROW : COLUMN ) );
226 }
227 /*
228 * End of PICOPY
229 */
230 }
231