ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Cpsyr.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_Cpsyr( PBTYP_T * TYPE, char * UPLO, int N, int K,
21  char * ALPHA, char * XC, int LDXC, char * XR, int LDXR,
22  char * A, int IA, int JA, int * DESCA, TZSYR_T SYR )
23 #else
24 void PB_Cpsyr( TYPE, UPLO, N, K, ALPHA, XC, LDXC, XR, LDXR, A, IA,
25  JA, DESCA, SYR )
26 /*
27 * .. Scalar Arguments ..
28 */
29  char * UPLO;
30  int IA, JA, K, LDXC, LDXR, N;
31  char * ALPHA;
32  PBTYP_T * TYPE;
33  TZSYR_T SYR;
34 /*
35 * .. Array Arguments ..
36 */
37  int * DESCA;
38  char * A, * XC, * XR;
39 #endif
40 {
41 /*
42 * Purpose
43 * =======
44 *
45 * PB_Cpsyr performs a symmetric or Hermitian rank-k update of the sub-
46 * matrix sub( A ) denoting A( IA:IA+N-1, JA:JA+N-1 ).
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 * TYPE (local input) pointer to a PBTYP_T structure
115 * On entry, TYPE is a pointer to a structure of type PBTYP_T,
116 * that contains type information (See pblas.h).
117 *
118 * UPLO (global input) pointer to CHAR
119 * On entry, UPLO specifies whether the local pieces of
120 * the array A containing the upper or lower triangular part
121 * of the symmetric or Hermitian submatrix sub( A ) are to be
122 * referenced as follows:
123 *
124 * UPLO = 'U' or 'u' Only the local pieces corresponding to
125 * the upper triangular part of the sym-
126 * metric or Hermitian submatrix sub( A )
127 * are to be referenced,
128 *
129 * UPLO = 'L' or 'l' Only the local pieces corresponding to
130 * the lower triangular part of the sym-
131 * metric or Hermitian submatrix sub( A )
132 * are to be referenced.
133 *
134 * N (global input) INTEGER
135 * On entry, N specifies the order of the submatrix sub( A ).
136 * N must be at least zero.
137 *
138 * K (global input) INTEGER
139 * On entry, K specifies the local number of columns of the lo-
140 * cal array XC and the local number of rows of the local array
141 * XR. K mut be at least zero.
142 *
143 * ALPHA (global input) pointer to CHAR
144 * On entry, ALPHA specifies the scalar alpha.
145 *
146 * XC (local input) pointer to CHAR
147 * On entry, XC is an array of dimension (LDXC,K). Before entry,
148 * this array contains the local entries of the matrix XC.
149 *
150 * LDXC (local input) INTEGER
151 * On entry, LDXC specifies the leading dimension of the array
152 * XC. LDXC must be at least max( 1, Lp( IA, N ) ).
153 *
154 * XR (local input) pointer to CHAR
155 * On entry, XR is an array of dimension (LDXR,Kx), where Kx is
156 * at least Lc( JA, N ). Before entry, this array contains the
157 * local entries of the matrix XR.
158 *
159 * LDXR (local input) INTEGER
160 * On entry, LDXR specifies the leading dimension of the array
161 * XR. LDXR must be at least max( 1, K ).
162 *
163 * A (local input/local output) pointer to CHAR
164 * On entry, A is an array of dimension (LLD_A, Ka), where Ka is
165 * at least Lc( 1, JA+N-1 ). Before entry, this array contains
166 * the local entries of the matrix A.
167 * Before entry with UPLO = 'U' or 'u', this array contains
168 * the local entries corresponding to the upper triangular part
169 * of the @(syhec) submatrix sub( A ), and the local entries
170 * corresponding to the strictly lower triangular of sub( A )
171 * are not referenced. On exit, the upper triangular part of
172 * sub( A ) is overwritten by the upper triangular part of the
173 * updated submatrix.
174 * Before entry with UPLO = 'L' or 'l', this array contains
175 * the local entries corresponding to the lower triangular part
176 * of the @(syhec) submatrix sub( A ), and the local entries
177 * corresponding to the strictly upper triangular of sub( A )
178 * are not referenced. On exit, the lower triangular part of
179 * sub( A ) is overwritten by the lower triangular part of the
180 * updated submatrix.
181 *
182 * IA (global input) INTEGER
183 * On entry, IA specifies A's global row index, which points to
184 * the beginning of the submatrix sub( A ).
185 *
186 * JA (global input) INTEGER
187 * On entry, JA specifies A's global column index, which points
188 * to the beginning of the submatrix sub( A ).
189 *
190 * DESCA (global and local input) INTEGER array
191 * On entry, DESCA is an integer array of dimension DLEN_. This
192 * is the array descriptor for the matrix A.
193 *
194 * SYR (local input) pointer to function of type TZSYR_T
195 * On entry, SYR specifies the function performing the update of
196 * a single block.
197 *
198 * -- Written on April 1, 1998 by
199 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
200 *
201 * ---------------------------------------------------------------------
202 */
203 /*
204 * .. Local Scalars ..
205 */
206  int Acol, Arow, Aii, Aimb1, Ainb1, Ajj, Ald, Amp, Amb, Anb, Anq,
207  Aoffi, Aoffj, Arcol, Arrow, GoEast, GoSouth, IsColRepl,
208  IsRowRepl, XCinc, XRinc, Xii=0, Xjj=0, Xoffi=-1, Xoffj=-1,
209  iimax, ilow, imbloc, inbloc, ioffd, ioffx, iupp, jjmax, joffd,
210  joffx, lcmt, lcmt00, lmbloc, lnbloc, low, lower, m1, mbloc,
211  mblkd, mblks, mycol, myrow, n1, nbloc, nblkd, nblks, npcol,
212  nprow, pmb, qnb, size, tmp1, upp, upper;
213 /* ..
214 * .. Executable Statements ..
215 *
216 */
217 /*
218 * Quick return if possible
219 */
220  if( N <= 0 ) return;
221 /*
222 * Retrieve process grid information
223 */
224  Cblacs_gridinfo( DESCA[CTXT_], &nprow, &npcol, &myrow, &mycol );
225 /*
226 * Retrieve sub( A )'s local information: Aii, Ajj, Arow, Acol ...
227 */
228  PB_Cainfog2l( N, N, IA, JA, DESCA, nprow, npcol, myrow, mycol, &Aimb1,
229  &Ainb1, &Amp, &Anq, &Aii, &Ajj, &Arow, &Acol, &Arrow, &Arcol );
230 /*
231 * Quick return if I don't own any of sub( A ) or if sub( A ) is replicated in
232 * all processes.
233 */
234  if( ( Amp <= 0 ) || ( Anq <= 0 ) ) return;
235 
236  Amb = DESCA[ MB_ ]; Anb = DESCA[ NB_ ]; Ald = DESCA[LLD_];
237  IsRowRepl = ( ( Arow < 0 ) || ( nprow == 1 ) );
238  IsColRepl = ( ( Acol < 0 ) || ( npcol == 1 ) );
239  size = TYPE->size;
240 
241  if( IsRowRepl && IsColRepl )
242  {
243  SYR( TYPE, UPLO, Amp, Anq, K, 0, ALPHA, XC, LDXC, XR, LDXR, Mptr( A, Aii,
244  Ajj, Ald, size ), Ald );
245  return;
246  }
247 
248  XCinc = size; XRinc = LDXR * size;
249  upper = ( Mupcase( UPLO[0] ) == CUPPER );
250  lower = ( Mupcase( UPLO[0] ) == CLOWER );
251 /*
252 * Initialize lcmt00, mblks, nblks, imbloc, inbloc, lmbloc, lnbloc, ilow, low,
253 * iupp, and upp.
254 */
255  PB_Cbinfo( 0, Amp, Anq, Aimb1, Ainb1, Amb, Anb, Arrow, Arcol, &lcmt00,
256  &mblks, &nblks, &imbloc, &inbloc, &lmbloc, &lnbloc, &ilow, &low,
257  &iupp, &upp );
258 
259  iimax = ( Aoffi = Aii - 1 ) + ( m1 = Amp );
260  jjmax = ( Aoffj = Ajj - 1 ) + ( n1 = Anq );
261  pmb = ( IsRowRepl ? Amb : nprow * Amb );
262  qnb = ( IsColRepl ? Anb : npcol * Anb );
263 /*
264 * Handle separately the first row and/or column of the LCM table. Update the
265 * LCM value of the curent block lcmt00, as well as the number of rows and
266 * columns mblks and nblks remaining in the LCM table.
267 */
268  GoSouth = ( lcmt00 > iupp );
269  GoEast = ( lcmt00 < ilow );
270 /*
271 * Go through the table looking for blocks owning diagonal entries.
272 */
273  if( ( !( GoSouth ) ) && ( !( GoEast ) ) )
274  {
275 /*
276 * The upper left block owns diagonal entries lcmt00 >= ilow && lcmt00 <= iupp
277 */
278  SYR( TYPE, UPLO, imbloc, inbloc, K, lcmt00, ALPHA, XC+Xii*XCinc, LDXC,
279  XR+Xjj*XRinc, LDXR, Mptr( A, Aii, Ajj, Ald, size ), Ald );
280 /*
281 * Decide whether one should go south or east in the table: Go east if
282 * the block below the current one only owns lower entries. If this block,
283 * however, owns diagonals, then go south.
284 */
285  GoSouth = !( GoEast = ( ( lcmt00 - ( iupp - upp + pmb ) ) < ilow ) );
286 
287  if( GoSouth )
288  {
289 /*
290 * When the upper triangular part of sub( A ) should be updated and one is
291 * planning to go south in the table, it is neccessary to take care of the
292 * remaining columns of these imbloc rows immediately.
293 */
294  if( upper && ( Anq > inbloc ) )
295  {
296  tmp1 = Anq - inbloc;
297  SYR( TYPE, ALL, imbloc, tmp1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
298  XR+(Xjj+inbloc)*XRinc, LDXR, Mptr( A, Aii, Ajj+inbloc, Ald,
299  size ), Ald );
300  }
301  Aii += imbloc; Xii += imbloc; m1 -= imbloc;
302  }
303  else
304  {
305 /*
306 * When the lower triangular part of sub( A ) should be updated and one is
307 * planning to go east in the table, it is neccessary to take care of the
308 * remaining rows of these inbloc columns immediately.
309 */
310  if( lower && ( Amp > imbloc ) )
311  {
312  tmp1 = Amp - imbloc;
313  SYR( TYPE, ALL, tmp1, inbloc, K, 0, ALPHA, XC+(Xii+imbloc)*XCinc,
314  LDXC, XR+Xjj*XRinc, LDXR, Mptr( A, Aii+imbloc, Ajj, Ald,
315  size ), Ald );
316  }
317  Ajj += inbloc; Xjj += inbloc; n1 -= inbloc;
318  }
319  }
320 
321  if( GoSouth )
322  {
323 /*
324 * Go one step south in the LCM table. Adjust the current LCM value as well as
325 * the local row indexes in A and XC.
326 */
327  lcmt00 -= ( iupp - upp + pmb ); mblks--; Aoffi += imbloc; Xoffi += imbloc;
328 /*
329 * While there are blocks remaining that own upper entries, keep going south.
330 * Adjust the current LCM value as well as the local row indexes in A and XC.
331 */
332  while( ( mblks > 0 ) && ( lcmt00 > upp ) )
333  { lcmt00 -= pmb; mblks--; Aoffi += Amb; Xoffi += Amb; }
334 /*
335 * Update the upper triangular part of sub( A ) we just skipped when necessary.
336 */
337  tmp1 = MIN( Aoffi, iimax ) - Aii + 1;
338  if( upper && ( tmp1 > 0 ) )
339  {
340  SYR( TYPE, ALL, tmp1, n1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
341  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, Aii, Aoffj+1, Ald, size ),
342  Ald );
343  Aii += tmp1; Xii += tmp1; m1 -= tmp1;
344  }
345 /*
346 * Return if no more row in the LCM table.
347 */
348  if( mblks <= 0 ) return;
349 /*
350 * lcmt00 <= upp. The current block owns either diagonals or lower entries.
351 * Save the current position in the LCM table. After this column has been
352 * completely taken care of, re-start from this row and the next column of
353 * the LCM table.
354 */
355  lcmt = lcmt00; mblkd = mblks; ioffd = Aoffi; ioffx = Xoffi;
356 
357  mbloc = Amb;
358  while( ( mblkd > 0 ) && ( lcmt >= ilow ) )
359  {
360 /*
361 * A block owning diagonals lcmt00 >= ilow && lcmt00 <= upp has been found.
362 */
363  if( mblkd == 1 ) mbloc = lmbloc;
364  SYR( TYPE, UPLO, mbloc, inbloc, K, lcmt, ALPHA, XC+(ioffx+1)*XCinc,
365  LDXC, XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, ioffd+1, Aoffj+1, Ald,
366  size ), Ald );
367  lcmt00 = lcmt; lcmt -= pmb;
368  mblks = mblkd; mblkd--;
369  Aoffi = ioffd; ioffd += mbloc;
370  Xoffi = ioffx; ioffx += mbloc;
371  }
372 /*
373 * Update the lower triangular part of sub( A ).
374 */
375  tmp1 = m1 - ioffd + Aii - 1;
376  if( lower && ( tmp1 > 0 ) )
377  SYR( TYPE, ALL, tmp1, inbloc, K, 0, ALPHA, XC+(ioffx+1)*XCinc, LDXC,
378  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, ioffd+1, Aoffj+1, Ald, size ),
379  Ald );
380 
381  tmp1 = Aoffi - Aii + 1;
382  m1 -= tmp1;
383  n1 -= inbloc;
384  lcmt00 += low - ilow + qnb;
385  nblks--;
386  Aoffj += inbloc;
387  Xoffj += inbloc;
388 /*
389 * Update the upper triangular part of sub( A ).
390 */
391  if( upper && ( tmp1 > 0 ) && ( n1 > 0 ) )
392  SYR( TYPE, ALL, tmp1, n1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
393  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, Aii, Aoffj+1, Ald, size ),
394  Ald );
395  Aii = Aoffi + 1; Ajj = Aoffj + 1;
396  Xii = Xoffi + 1; Xjj = Xoffj + 1;
397  }
398  else if( GoEast )
399  {
400 /*
401 * Go one step east in the LCM table. Adjust the current LCM value as well as
402 * the local column index in A and XR.
403 */
404  lcmt00 += low - ilow + qnb; nblks--; Aoffj += inbloc; Xoffj += inbloc;
405 /*
406 * While there are blocks remaining that own lower entries, keep going east.
407 * Adjust the current LCM value as well as the local column index in A and XR.
408 */
409  while( ( nblks > 0 ) && ( lcmt00 < low ) )
410  { lcmt00 += qnb; nblks--; Aoffj += Anb; Xoffj += Anb; }
411 /*
412 * Update the lower triangular part of sub( A ).
413 */
414  tmp1 = MIN( Aoffj, jjmax ) - Ajj + 1;
415  if( lower && ( tmp1 > 0 ) )
416  {
417  SYR( TYPE, ALL, m1, tmp1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
418  XR+Xjj*XRinc, LDXR, Mptr( A, Aii, Ajj, Ald, size ), Ald );
419  Ajj += tmp1; Xjj += tmp1; n1 -= tmp1;
420  }
421 /*
422 * Return if no more column in the LCM table.
423 */
424  if( nblks <= 0 ) return;
425 /*
426 * lcmt00 >= low. The current block owns either diagonals or upper entries.
427 * Save the current position in the LCM table. After this row has been
428 * completely taken care of, re-start from this column and the next row of
429 * the LCM table.
430 */
431  lcmt = lcmt00; nblkd = nblks; joffd = Aoffj; joffx = Xoffj;
432 
433  nbloc = Anb;
434  while( ( nblkd > 0 ) && ( lcmt <= iupp ) )
435  {
436 /*
437 * A block owning diagonals lcmt00 >= low && lcmt00 <= iupp has been found.
438 */
439  if( nblkd == 1 ) nbloc = lnbloc;
440  SYR( TYPE, UPLO, imbloc, nbloc, K, lcmt, ALPHA, XC+Xii*XCinc, LDXC,
441  XR+(joffx+1)*XRinc, LDXR, Mptr( A, Aii, joffd+1, Ald, size ),
442  Ald );
443  lcmt00 = lcmt; lcmt += qnb;
444  nblks = nblkd; nblkd--;
445  Aoffj = joffd; joffd += nbloc;
446  Xoffj = joffx; joffx += nbloc;
447  }
448 /*
449 * Update the upper triangular part of sub( A ).
450 */
451  tmp1 = n1 - joffd + Ajj - 1;
452  if( upper && ( tmp1 > 0 ) )
453  SYR( TYPE, ALL, imbloc, tmp1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
454  XR+(joffx+1)*XRinc, LDXR, Mptr( A, Aii, (joffd+1), Ald, size ),
455  Ald );
456 
457  tmp1 = Aoffj - Ajj + 1;
458  m1 -= imbloc;
459  n1 -= tmp1;
460  lcmt00 -= ( iupp - upp + pmb );
461  mblks--;
462  Aoffi += imbloc;
463  Xoffi += imbloc;
464 /*
465 * Update the lower triangular part of sub( A ).
466 */
467  if( lower && ( m1 > 0 ) && ( tmp1 > 0 ) )
468  SYR( TYPE, ALL, m1, tmp1, K, 0, ALPHA, XC+(Xoffi+1)*XCinc, LDXC,
469  XR+Xjj*XRinc, LDXR, Mptr( A, Aoffi+1, Ajj, Ald, size ), Ald );
470  Aii = Aoffi + 1; Ajj = Aoffj + 1;
471  Xii = Xoffi + 1; Xjj = Xoffj + 1;
472  }
473 /*
474 * Loop over the remaining columns of the LCM table.
475 */
476  nbloc = Anb;
477  while( nblks > 0 )
478  {
479  if( nblks == 1 ) nbloc = lnbloc;
480 /*
481 * While there are blocks remaining that own upper entries, keep going south.
482 * Adjust the current LCM value as well as the local row index in A and XC.
483 */
484  while( ( mblks > 0 ) && ( lcmt00 > upp ) )
485  { lcmt00 -= pmb; mblks--; Aoffi += Amb; Xoffi += Amb; }
486 /*
487 * Update the upper triangular part of sub( A ).
488 */
489  tmp1 = MIN( Aoffi, iimax ) - Aii + 1;
490  if( upper && ( tmp1 > 0 ) )
491  {
492  SYR( TYPE, ALL, tmp1, n1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
493  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, Aii, Aoffj+1, Ald, size ),
494  Ald );
495  Aii += tmp1;
496  Xii += tmp1;
497  m1 -= tmp1;
498  }
499 /*
500 * Return if no more row in the LCM table.
501 */
502  if( mblks <= 0 ) return;
503 /*
504 * lcmt00 <= upp. The current block owns either diagonals or lower entries.
505 * Save the current position in the LCM table. After this column has been
506 * completely taken care of, re-start from this row and the next column of
507 * the LCM table.
508 */
509  lcmt = lcmt00; mblkd = mblks; ioffd = Aoffi; ioffx = Xoffi;
510 
511  mbloc = Amb;
512  while( ( mblkd > 0 ) && ( lcmt >= low ) )
513  {
514 /*
515 * A block owning diagonals lcmt00 >= low && lcmt00 <= upp has been found.
516 */
517  if( mblkd == 1 ) mbloc = lmbloc;
518  SYR( TYPE, UPLO, mbloc, nbloc, K, lcmt, ALPHA, XC+(ioffx+1)*XCinc,
519  LDXC, XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, ioffd+1, Aoffj+1, Ald,
520  size ), Ald );
521  lcmt00 = lcmt; lcmt -= pmb;
522  mblks = mblkd; mblkd--;
523  Aoffi = ioffd; Xoffi = ioffx;
524  ioffd += mbloc; ioffx += mbloc;
525  }
526 /*
527 * Update the lower triangular part of sub( A ).
528 */
529  tmp1 = m1 - ioffd + Aii - 1;
530  if( lower && ( tmp1 > 0 ) )
531  SYR( TYPE, ALL, tmp1, nbloc, K, 0, ALPHA, XC+(ioffx+1)*XCinc, LDXC,
532  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, ioffd+1, Aoffj+1, Ald, size ),
533  Ald );
534 
535  tmp1 = MIN( Aoffi, iimax ) - Aii + 1;
536  m1 -= tmp1;
537  n1 -= nbloc;
538  lcmt00 += qnb;
539  nblks--;
540  Aoffj += nbloc;
541  Xoffj += nbloc;
542 /*
543 * Update the upper triangular part of sub( A ).
544 */
545  if( upper && ( tmp1 > 0 ) && ( n1 > 0 ) )
546  SYR( TYPE, ALL, tmp1, n1, K, 0, ALPHA, XC+Xii*XCinc, LDXC,
547  XR+(Xoffj+1)*XRinc, LDXR, Mptr( A, Aii, Aoffj+1, Ald, size ),
548  Ald );
549  Aii = Aoffi + 1; Ajj = Aoffj + 1;
550  Xii = Xoffi + 1; Xjj = Xoffj + 1;
551  }
552 /*
553 * End of PB_Cpsyr
554 */
555 }
TYPE
#define TYPE
Definition: clamov.c:7
MB_
#define MB_
Definition: PBtools.h:43
NB_
#define NB_
Definition: PBtools.h:44
PB_Cainfog2l
void PB_Cainfog2l()
LLD_
#define LLD_
Definition: PBtools.h:47
PB_Cbinfo
void PB_Cbinfo()
CLOWER
#define CLOWER
Definition: PBblas.h:25
ALL
#define ALL
Definition: PBblas.h:50
PB_Cpsyr
void PB_Cpsyr(PBTYP_T *TYPE, char *UPLO, int N, int K, char *ALPHA, char *XC, int LDXC, char *XR, int LDXR, char *A, int IA, int JA, int *DESCA, TZSYR_T SYR)
Definition: PB_Cpsyr.c:24
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
Cblacs_gridinfo
void Cblacs_gridinfo()
PBTYP_T
Definition: pblas.h:325
Mupcase
#define Mupcase(C)
Definition: PBtools.h:83
CUPPER
#define CUPPER
Definition: PBblas.h:26
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CTXT_
#define CTXT_
Definition: PBtools.h:38
TZSYR_T
void(* TZSYR_T)()
Definition: pblas.h:425