14 #include "../PBpblas.h"
15 #include "../PBtools.h"
16 #include "../PBblacs.h"
17 #include "../PBblas.h"
21 char * ALPHA,
char * XC,
int LDXC,
char * XR,
int LDXR,
22 char * A,
int IA,
int JA,
int * DESCA,
TZSYR_T SYR )
24 void PB_Cpsyr(
TYPE, UPLO, N, K, ALPHA, XC, LDXC, XR, LDXR, A, IA,
30 int IA, JA, K, LDXC, LDXR, N;
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;
228 PB_Cainfog2l( N, N, IA, JA, DESCA, nprow, npcol, myrow, mycol, &Aimb1,
229 &Ainb1, &Amp, &Anq, &Aii, &Ajj, &Arow, &Acol, &Arrow, &Arcol );
234 if( ( Amp <= 0 ) || ( Anq <= 0 ) )
return;
236 Amb = DESCA[
MB_ ]; Anb = DESCA[
NB_ ]; Ald = DESCA[
LLD_];
237 IsRowRepl = ( ( Arow < 0 ) || ( nprow == 1 ) );
238 IsColRepl = ( ( Acol < 0 ) || ( npcol == 1 ) );
241 if( IsRowRepl && IsColRepl )
243 SYR(
TYPE, UPLO, Amp, Anq, K, 0, ALPHA, XC, LDXC, XR, LDXR,
Mptr( A, Aii,
244 Ajj, Ald, size ), Ald );
248 XCinc = size; XRinc = LDXR * size;
255 PB_Cbinfo( 0, Amp, Anq, Aimb1, Ainb1, Amb, Anb, Arrow, Arcol, &lcmt00,
256 &mblks, &nblks, &imbloc, &inbloc, &lmbloc, &lnbloc, &ilow, &low,
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 );
268 GoSouth = ( lcmt00 > iupp );
269 GoEast = ( lcmt00 < ilow );
273 if( ( !( GoSouth ) ) && ( !( GoEast ) ) )
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 );
285 GoSouth = !( GoEast = ( ( lcmt00 - ( iupp - upp + pmb ) ) < ilow ) );
294 if( upper && ( 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,
301 Aii += imbloc; Xii += imbloc; m1 -= imbloc;
310 if( lower && ( 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,
317 Ajj += inbloc; Xjj += inbloc; n1 -= inbloc;
327 lcmt00 -= ( iupp - upp + pmb ); mblks--; Aoffi += imbloc; Xoffi += imbloc;
332 while( ( mblks > 0 ) && ( lcmt00 > upp ) )
333 { lcmt00 -= pmb; mblks--; Aoffi += Amb; Xoffi += Amb; }
337 tmp1 =
MIN( Aoffi, iimax ) - Aii + 1;
338 if( upper && ( tmp1 > 0 ) )
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 ),
343 Aii += tmp1; Xii += tmp1; m1 -= tmp1;
348 if( mblks <= 0 )
return;
355 lcmt = lcmt00; mblkd = mblks; ioffd = Aoffi; ioffx = Xoffi;
358 while( ( mblkd > 0 ) && ( lcmt >= ilow ) )
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,
367 lcmt00 = lcmt; lcmt -= pmb;
368 mblks = mblkd; mblkd--;
369 Aoffi = ioffd; ioffd += mbloc;
370 Xoffi = ioffx; ioffx += mbloc;
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 ),
381 tmp1 = Aoffi - Aii + 1;
384 lcmt00 += low - ilow + qnb;
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 ),
395 Aii = Aoffi + 1; Ajj = Aoffj + 1;
396 Xii = Xoffi + 1; Xjj = Xoffj + 1;
404 lcmt00 += low - ilow + qnb; nblks--; Aoffj += inbloc; Xoffj += inbloc;
409 while( ( nblks > 0 ) && ( lcmt00 < low ) )
410 { lcmt00 += qnb; nblks--; Aoffj += Anb; Xoffj += Anb; }
414 tmp1 =
MIN( Aoffj, jjmax ) - Ajj + 1;
415 if( lower && ( tmp1 > 0 ) )
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;
424 if( nblks <= 0 )
return;
431 lcmt = lcmt00; nblkd = nblks; joffd = Aoffj; joffx = Xoffj;
434 while( ( nblkd > 0 ) && ( lcmt <= iupp ) )
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 ),
443 lcmt00 = lcmt; lcmt += qnb;
444 nblks = nblkd; nblkd--;
445 Aoffj = joffd; joffd += nbloc;
446 Xoffj = joffx; joffx += nbloc;
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 ),
457 tmp1 = Aoffj - Ajj + 1;
460 lcmt00 -= ( iupp - upp + pmb );
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;
479 if( nblks == 1 ) nbloc = lnbloc;
484 while( ( mblks > 0 ) && ( lcmt00 > upp ) )
485 { lcmt00 -= pmb; mblks--; Aoffi += Amb; Xoffi += Amb; }
489 tmp1 =
MIN( Aoffi, iimax ) - Aii + 1;
490 if( upper && ( tmp1 > 0 ) )
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 ),
502 if( mblks <= 0 )
return;
509 lcmt = lcmt00; mblkd = mblks; ioffd = Aoffi; ioffx = Xoffi;
512 while( ( mblkd > 0 ) && ( lcmt >= low ) )
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,
521 lcmt00 = lcmt; lcmt -= pmb;
522 mblks = mblkd; mblkd--;
523 Aoffi = ioffd; Xoffi = ioffx;
524 ioffd += mbloc; ioffx += mbloc;
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 ),
535 tmp1 =
MIN( Aoffi, iimax ) - Aii + 1;
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 ),
549 Aii = Aoffi + 1; Ajj = Aoffj + 1;
550 Xii = Xoffi + 1; Xjj = Xoffj + 1;