static void RsymvL(const int N, const TYPE *A, const int lda, const TYPE *X,
const SCALAR beta, TYPE *Y)
{
int mb, nb, jb, jbs, j, m;
const TYPE *x0=X, *A0=A;
const SCALAR alpha=beta;
TYPE *y0=Y;
ATL_GetPartSYMV(A, lda, &mb, &nb);
for (j=0; j < N; j += nb)
{
jb = N-j;
jb = Mmin(jb,nb);
refsymvL(jb, alpha, A, lda, X, 1, beta, Y, 1);
m = N-j-jb;
if (m)
{
jbs = jb SHIFT; X += jbs; Y += jbs;
gemvT(jb, m, alpha, A+jbs, lda, X, 1, beta, y0, 1);
gemvN(m, jb, alpha, A+jbs, lda, x0, 1, beta, Y, 1);
A += jbs*(lda+1); x0 = X; y0 = Y;
}
}
}
void Mjoin(PATL,symv)
(const enum ATLAS_UPLO Uplo, const int N, const SCALAR alpha,
const TYPE *A, const int lda, const TYPE *X, const int incX,
const SCALAR beta, TYPE *Y, const int incY)
{
int mb, nb, jb, mb1, incA1, incA, incXY, incXY1, n, j;
const int lda2=(lda SHIFT);
const TYPE *x0=X, *x1, *A0=A, *A1;
TYPE *y1, *y0=Y;
assert(incX==1 && incY==1 && Uplo == AtlasLower);
#ifdef TREAL
assert(alpha == ATL_rone && beta == ATL_rone);
#else
assert(*alpha == ATL_rone && *beta == ATL_rone);
assert(alpha[1] == ATL_rzero && beta[1] == ATL_rzero);
#endif
ATL_GetPartSYMV(A, lda, &mb, &nb);
mb1 = N - ( (N-1) / mb ) * mb;
incA1 = nb * lda2; incXY1 = (nb SHIFT);
incA = incXY = mb SHIFT;
n = (N-mb)SHIFT;
A += n; X += n; Y += n;
for (n=N-mb; n > 0; n -= mb, A -= incA, X -= incXY, Y -= incXY)
{
RsymvL(mb, A+n*lda2, lda, X, beta, Y);
for (j=0, A1=A, x1=x0, y1=y0; j < n; j += nb, A1 += incA1, x1 += incXY1,
y1 += incXY1)
{
jb = n - j;
jb = Mmin(jb, nb);
gemvT(jb, mb, alpha, A1, lda, X, 1, beta, y1, 1);
gemvN(mb, jb, alpha, A1, lda, x1, 1, beta, Y, 1);
}
}
RsymvL(mb1, A0, lda, x0, beta, y0);
}
void Mjoin( PATL, hemv )
(
const enum ATLAS_UPLO UPLO,
const int N,
const SCALAR ALPHA,
const TYPE * A,
const int LDA,
const TYPE * X,
const int INCX,
const SCALAR BETA,
TYPE * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* Mjoin( PATL, hemv ) performs the matrix-vector operation
*
* y := alpha * A * x + beta * y,
*
* where alpha and beta are scalars, x and y are n-element vectors and A
* is an n by n Hermitian matrix.
*
* This is a blocked version of the algorithm. For a more detailed des-
* cription of the arguments of this function, see the reference imple-
* mentation in the ATLAS/src/blas/reference directory.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
void (*gemv0)( const int, const int, const SCALAR,
const TYPE *, const int, const TYPE *, const int,
const SCALAR, TYPE *, const int );
void (*gemv1)( const int, const int, const SCALAR,
const TYPE *, const int, const TYPE *, const int,
const SCALAR, TYPE *, const int );
void (*gemvN)( const int, const int, const SCALAR,
const TYPE *, const int, const TYPE *, const int,
const SCALAR, TYPE *, const int );
#ifdef TREAL
TYPE alphaY, beta0;
#define lda2 LDA
#define one ATL_rone
#define zero ATL_rzero
void * vx = NULL, * vy = NULL;
TYPE * x, * y;
TYPE * A0, * A1, * x0, * x1, * y00, * y0, * y1;
#else
const int lda2 = ( LDA SHIFT );
const TYPE * alphaY, * beta0;
const TYPE one [2] = { ATL_rone, ATL_rzero },
zero[2] = { ATL_rzero, ATL_rzero };
void * vx = NULL, * vy = NULL;
TYPE * x, * y;
TYPE * A0, * A1, * x0, * x1, * y00, * y0, * y1;
#endif
int incA, incA1, incXY, incXY1, j, jb, mb, mb1, n, nb;
/* ..
* .. Executable Statements ..
*
*/
if( N == 0 ) return;
if( SCALAR_IS_ZERO( ALPHA ) )
{
if( !( SCALAR_IS_ONE( BETA ) ) ) Mjoin( PATL, scal )( N, BETA, Y, INCY );
return;
}
if( ( INCX != 1 ) || ( ( INCY == 1 ) && !( SCALAR_IS_ONE( ALPHA ) ) ) )
{
vx = (void *)malloc( ATL_Cachelen + ATL_MulBySize( N ) );
ATL_assert( vx ); x = ATL_AlignPtr( vx );
Mjoin( PATL, cpsc )( N, ALPHA, X, INCX, x, 1 );
alphaY = one;
}
else { x = (TYPE *)(X); alphaY = ALPHA; }
if( ( INCY != 1 ) || !( SCALAR_IS_ONE( alphaY ) ) )
{
vy = malloc( ATL_Cachelen + ATL_MulBySize( N ) );
ATL_assert( vy ); y00 = y = ATL_AlignPtr( vy );
beta0 = zero;
}
else { y00 = y = (TYPE *)(Y); beta0 = BETA; }
if( SCALAR_IS_ZERO( beta0 ) ) gemv0 = Mjoin( PATL, gemvC_a1_x1_b0_y1 );
else if( SCALAR_IS_ONE ( beta0 ) ) gemv0 = Mjoin( PATL, gemvC_a1_x1_b1_y1 );
else gemv0 = Mjoin( PATL, gemvC_a1_x1_bX_y1 );
gemv1 = Mjoin( PATL, gemvC_a1_x1_b1_y1 );
gemvN = Mjoin( PATL, gemvS_a1_x1_b1_y1 );
ATL_GetPartSYMV( A, LDA, &mb, &nb );
mb1 = N - ( ( N - 1 ) / mb ) * mb;
incA1 = nb * lda2; incXY1 = (nb SHIFT);
if( UPLO == AtlasUpper )
{
incA = ( incXY = (mb SHIFT) ) + mb * lda2;
A0 = (TYPE *)(A) + mb * lda2; x0 = x + incXY; y0 = y + incXY;
for( n = N - mb; n > 0; n -= mb, A0 += incA, A += incA, x0 += incXY,
x += incXY, y0 += incXY, y += incXY )
{
Mjoin( PATL, hemvU )( mb, A, LDA, x, beta0, y );
for( j = 0, A1 = A0, x1 = x0, y1 = y0; j < n;
j += nb, A1 += incA1, x1 += incXY1, y1 += incXY1 )
{
jb = n - j; jb = Mmin( jb, nb );
gemv0( jb, mb, one, A1, LDA, x, 1, beta0, y1, 1 );
gemvN( mb, jb, one, A1, LDA, x1, 1, one, y, 1 );
}
beta0 = one; gemv0 = gemv1;
}
Mjoin( PATL, hemvU )( mb1, A, LDA, x, beta0, y );
}
else
{
incA = incXY = (mb SHIFT);
A0 = (TYPE *)(A); x0 = x; y0 = y;
for( n = N - mb, A += ((N-mb) SHIFT), x += ((N-mb) SHIFT),
y += ((N-mb) SHIFT); n > 0; n -= mb, A -= incA, x -= incXY,
y -= incXY )
{
Mjoin( PATL, hemvL )( mb, A+n*lda2, LDA, x, beta0, y );
for( j = 0, A1 = (TYPE *)(A), x1 = x0, y1 = y0; j < n;
j += nb, A1 += incA1, x1 += incXY1, y1 += incXY1 )
{
jb = n - j; jb = Mmin( jb, nb );
gemv0( jb, mb, one, A1, LDA, x, 1, beta0, y1, 1 );
gemvN( mb, jb, one, A1, LDA, x1, 1, one, y, 1 );
}
beta0 = one; gemv0 = gemv1;
}
Mjoin( PATL, hemvL )( mb1, A0, LDA, x0, beta0, y0 );
}
if( vx ) free( vx );
if( vy )
{ Mjoin( PATL, axpby )( N, alphaY, y00, 1, BETA, Y, INCY ); free( vy ); }
/*
* End of Mjoin( PATL, hemv )
*/
}
static void ATL_symvL
(
ATL_symvK_t symvK,
const int NB,
ATL_CINT N,
const TYPE *A,
ATL_CINT lda,
const TYPE *x,
TYPE *y,
const TYPE *xt,
TYPE *yt
)
{
const TYPE one[2] = {ATL_rone, ATL_rzero};
ATL_INT Mmb2;
ATL_INT Mmb, mr, MB, j;
const size_t incA = (NB SHIFT)*lda;
const size_t opsize = ((size_t)(N+8)*(N+4))*(sizeof(TYPE)>>1)SHIFT;
void (*gemvT)(ATL_CINT, ATL_CINT, const SCALAR, const TYPE*, ATL_CINT,
const TYPE*, ATL_CINT, const SCALAR, TYPE*, ATL_CINT);
void (*gemvN)(ATL_CINT, ATL_CINT, const SCALAR, const TYPE*, ATL_CINT,
const TYPE*, ATL_CINT, const SCALAR, TYPE*, ATL_CINT);
if (opsize > MY_CE)
{
gemvT = Mjoin(PATL,gemvT);
gemvN = Mjoin(PATL,gemvN_L2);
}
else if (opsize <= ATL_MulBySize(ATL_L1elts))
{
gemvT = Mjoin(PATL,gemvT_L1);
gemvN = Mjoin(PATL,gemvN_L1);
}
else
{
gemvT = Mjoin(PATL,gemvT_L2);
gemvN = Mjoin(PATL,gemvN_L2);
}
/*
* Choose MB such that A is retained in L2 cache for second GEMV call
* If partial block is tiny, absorbe it into last block since cache is not
* precise anyway.
*/
MB = ATL_DivBySize(MY_CE) / NB;
MB = (MB > N || MB < 240) ? N : MB;
Mmb2 = Mmb+Mmb;
for (j=0; j < N; j += NB, A += incA)
{
const register size_t j2 = j+j;
register int i, nb=N-j;
nb = (nb >= NB) ? NB : nb;
symvK(AtlasLower, nb, one, A+j2, lda, x+j2, 1, one, y+j2, 1);
for (i=j+nb; i < N; i += MB)
{
const register size_t i2 = i+i;
register int mb = N-i;
mb = (mb >= MB) ? MB : mb;
gemvT(mb, nb, one, A+i2, lda, xt+i2, 1, one, yt+j2, 1);
gemvN(mb, nb, one, A+i2, lda, x+j2, 1, one, y+i2, 1);
}
}
}
