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__
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)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 }
556