void ATL_zrefherkLN
(
const int N,
const int K,
const double ALPHA,
const double * A,
const int LDA,
const double BETA,
double * C,
const int LDC
)
{
/*
* Purpose
* =======
*
* ATL_zrefherkLN( ... )
*
* <=>
*
* ATL_zrefherk( AtlasLower, AtlasNoTrans, ... )
*
* See ATL_zrefherk for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
register double t0_i, t0_r;
int i, iail, iaj, iajl, icij, j, jal, jcj, l,
lda2 = ( LDA << 1 ), ldc2 = ( LDC << 1 );
/* ..
* .. Executable Statements ..
*
*/
for( j = 0, iaj = 0, jcj = 0; j < N; j++, iaj += 2, jcj += ldc2 )
{
icij = ( j << 1 ) + jcj;
Mdelscal( BETA, C[icij] ); C[icij+1] = ATL_dZERO;
Mdvscal( ((N-j-1) << 1), BETA, C+icij+2, 1 );
for( l = 0, iajl = iaj, jal = 0; l < K; l++, iajl += lda2, jal += lda2 )
{
Mset( ALPHA * A[iajl], -ALPHA * A[iajl+1], t0_r, t0_i );
iail = ( j << 1 ) + jal; icij = ( j << 1 ) + jcj;
Mset( C[icij] + t0_r * A[iail] - t0_i * A[iail+1],
ATL_dZERO, C[icij], C[icij+1] );
iail += 2; icij += 2;
for( i = j+1; i < N; i++, iail += 2, icij += 2 )
{ Mmla( t0_r, t0_i, A[iail], A[iail+1], C[icij], C[icij+1] ); }
}
}
/*
* End of ATL_zrefherkLN
*/
}
void ATL_drefsyr2kLN
(
const int N,
const int K,
const double ALPHA,
const double * A,
const int LDA,
const double * B,
const int LDB,
const double BETA,
double * C,
const int LDC
)
{
/*
* Purpose
* =======
*
* ATL_drefsyr2kLN( ... )
*
* <=>
*
* ATL_drefsyr2k( AtlasLower, AtlasNoTrans, ... )
*
* See ATL_drefsyr2k for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
register double t0, t1;
int i, iail, iaj, iajl, ibil, ibj, ibjl, icij,
j, jal, jbl, jcj, l;
/* ..
* .. Executable Statements ..
*
*/
for( j = 0, iaj = 0, ibj = 0, jcj = 0;
j < N; j++, iaj += 1, ibj += 1, jcj += LDC )
{
Mdvscal( N-j, BETA, C+j+jcj, 1 );
for( l = 0, iajl = iaj, ibjl = ibj, jal = 0, jbl = 0;
l < K; l++, iajl += LDA, ibjl += LDB, jal += LDA, jbl += LDB )
{
t0 = ALPHA * A[iajl]; t1 = ALPHA * B[ibjl];
for( i = j, iail = j+jal, ibil = j+jbl, icij = j+jcj;
i < N; i++, iail += 1, ibil += 1, icij += 1 )
{ C[icij] += t1 * A[iail] + t0 * B[ibil]; }
}
}
/*
* End of ATL_drefsyr2kLN
*/
}
void ATL_drefsbmvL
(
const int N,
const int K,
const double ALPHA,
const double * A,
const int LDA,
const double * X,
const int INCX,
const double BETA,
double * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* ATL_drefsbmvL( ... )
*
* <=>
*
* ATL_drefsbmv( AtlasLower, ... )
*
* See ATL_drefsbmv for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
register double t0, t1;
int i, i1, iaij, ix, iy, j, jaj, jx, jy, kx = 0,
ky = 0;
/* ..
* .. Executable Statements ..
*
*/
Mdvscal( N, BETA, Y, INCY );
for( j = 0, jaj = 0, jx = kx, jy = ky; j < N;
j++, jaj += LDA, jx += INCX, jy += INCY )
{
t0 = ALPHA * X[jx]; t1 = ATL_dZERO;
i1 = ( N - 1 > j + K ? j + K : N - 1 ); Y[jy] += t0 * A[jaj];
for( i = j+1, iaij = 1+jaj, ix = jx + INCX, iy = jy + INCY;
i <= i1; i++, iaij += 1, ix += INCX, iy += INCY )
{ Y[iy] += A[iaij] * t0; t1 += A[iaij] * X[ix]; }
Y[jy] += ALPHA * t1;
}
/*
* End of ATL_drefsbmvL
*/
}
void ATL_drefspmvU
(
const int N,
const double ALPHA,
const double * A,
const int LDA,
const double * X,
const int INCX,
const double BETA,
double * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* ATL_drefspmvU( ... )
*
* <=>
*
* ATL_drefspmv( AtlasUpper, ... )
*
* See ATL_drefspmv for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
/*
* .. Local Variables ..
*/
register double t0, t1;
int i, iaij, ix, iy, j, jaj, jx, jy, lda = LDA;
/* ..
* .. Executable Statements ..
*
*/
Mdvscal( N, BETA, Y, INCY );
for( j = 0, jaj = 0, jx = 0, jy = 0; j < N; j++, jx += INCX, jy += INCY )
{
t0 = ALPHA * X[jx]; t1 = ATL_dZERO;
for( i = 0, iaij = jaj, ix = 0, iy = 0;
i < j; i++, iaij += 1, ix += INCX, iy += INCY )
{ Y[iy] += t0 * A[iaij]; t1 += A[iaij] * X[ix]; }
Y[jy] += t0 * A[iaij] + ALPHA * t1; jaj += lda; lda += 1;
}
/*
* End of ATL_drefspmvU
*/
}
void ATL_drefgpmvLN
(
const int M,
const int N,
const double ALPHA,
const double * A,
const int LDA,
const double * X,
const int INCX,
const double BETA,
double * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* ATL_drefgpmvLN( ... )
*
* <=>
*
* ATL_drefgpmv( AtlasLower, AtlasNoTrans, ... )
*
* See ATL_drefgpmv for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
register double t0;
int i, iaij, iy, j, jaj, jx, lda = LDA;
/* ..
* .. Executable Statements ..
*
*/
Mdvscal( M, BETA, Y, INCY );
for( j = 0, jaj = 0, jx = 0; j < N; j++, jx += INCX )
{
t0 = ALPHA * X[jx];
for( i = 0, iaij = jaj, iy = 0; i < M; i++, iaij += 1, iy += INCY )
{ Y[iy] += A[iaij] * t0; }
lda -= 1; jaj += lda;
}
/*
* End of ATL_drefgpmvLN
*/
}
void ATL_zrefher2kLN
(
const int N,
const int K,
const double * ALPHA,
const double * A,
const int LDA,
const double * B,
const int LDB,
const double BETA,
double * C,
const int LDC
)
{
/*
* Purpose
* =======
*
* ATL_zrefher2kLN( ... )
*
* <=>
*
* ATL_zrefher2k( AtlasLower, AtlasNoTrans, ... )
*
* See ATL_zrefher2k for details.
*
* ---------------------------------------------------------------------
*/
/*
* .. Local Variables ..
*/
double t0_i, t0_r, t1_i, t1_r;
int i, iail, iaj, iajl, ibil, ibj, ibjl, icij,
j, jal, jbl, jcj, l, lda2 = ( LDA << 1 ),
ldb2 = ( LDB << 1 ), ldc2 = ( LDC << 1 );
/* ..
* .. Executable Statements ..
*
*/
for( j = 0, iaj = 0, ibj = 0, jcj = 0;
j < N; j++, iaj += 2, ibj += 2, jcj += ldc2 )
{
icij = ( j << 1 ) + jcj;
Mdelscal( BETA, C[icij] ); C[icij+1] = ATL_dZERO;
Mdvscal( ((N-j-1) << 1), BETA, C+icij+2, 1 );
for( l = 0, iajl = iaj, ibjl = ibj, jal = 0, jbl = 0;
l < K; l++, iajl += lda2, ibjl += ldb2, jal += lda2, jbl += ldb2 )
{
Mmul( ALPHA[0], ALPHA[1], B[ibjl], -B[ibjl+1], t0_r, t0_i );
Mmul( ALPHA[0], -ALPHA[1], A[iajl], -A[iajl+1], t1_r, t1_i );
iail = ( j << 1 ) + jal; ibil = ( j << 1 ) + jbl,
icij = ( j << 1 ) + jcj;
Mset( C[icij] + A[iail] * t0_r - A[iail+1] * t0_i +
B[ibil] * t1_r - B[ibil+1] * t1_i,
ATL_dZERO, C[icij], C[icij+1] );
iail += 2; ibil += 2; icij += 2;
for( i = j+1; i < N; i++, iail += 2, ibil += 2, icij += 2 )
{
Mmla( A[iail], A[iail+1], t0_r, t0_i, C[icij], C[icij+1] );
Mmla( B[ibil], B[ibil+1], t1_r, t1_i, C[icij], C[icij+1] );
}
}
}
/*
* End of ATL_zrefher2kLN
*/
}
void ATL_drefgemv
(
const enum ATLAS_TRANS TRANS,
const int M,
const int N,
const double ALPHA,
const double * A,
const int LDA,
const double * X,
const int INCX,
const double BETA,
double * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* ATL_drefgemv performs one of the matrix-vector operations
*
* y := alpha * op( A ) * x + beta * y,
*
* where op( X ) is one of
*
* op( X ) = X or op( X ) = X'.
*
* where alpha and beta are scalars, x and y are vectors and op( A ) is
* an m by n matrix.
*
* Arguments
* =========
*
* TRANS (input) const enum ATLAS_TRANS
* On entry, TRANS specifies the operation to be performed as
* follows:
*
* TRANS = AtlasNoTrans y := alpha*A *x + beta*y,
*
* TRANS = AtlasConj y := alpha*A *x + beta*y,
*
* TRANS = AtlasTrans y := alpha*A'*x + beta*y,
*
* TRANS = AtlasConjTrans y := alpha*A'*x + beta*y.
*
* Unchanged on exit.
*
* M (input) const int
* On entry, M specifies the number of rows of the matrix A
* when TRANS = AtlasNoTrans or TRANS = AtlasConj, and the num-
* ber of columns of the matrix A otherwise. M must be at least
* zero. Unchanged on exit.
*
* N (input) const int
* On entry, N specifies the number of columns of the matrix A
* when TRANS = AtlasNoTrans or TRANS = AtlasConj, and the num-
* ber of rows of the matrix A otherwise. N must be at least ze-
* ro. Unchanged on exit.
*
* ALPHA (input) const double
* On entry, ALPHA specifies the scalar alpha. When ALPHA is
* supplied as zero then A and X need not be set on input. Un-
* changed on exit.
*
* A (input) const double *
* On entry, A points to an array of size equal to or greater
* than LDA * ka * sizeof( double ), where ka is n when
* TRANS = AtlasNotrans or TRANS = AtlasConj, and m otherwise.
* Before entry, when TRANS = AtlasNotrans or TRANS = AtlasConj,
* the leading m by n part of the array A must contain the ma-
* trix coefficients, and otherwise the leading n by m part of
* the array A must contain the matrix coefficients. Unchanged
* on exit.
*
* LDA (input) const int
* On entry, LDA specifies the leading dimension of A as decla-
* red in the calling (sub) program. LDA must be at least
* MAX( 1, m ) when TRANS = AtlasNotrans or TRANS = AtlasConj,
* and MAX( 1, n ) otherwise. Unchanged on exit.
*
* X (input) const double *
* On entry, X points to the first entry to be accessed of an
* incremented array of size equal to or greater than
* ( 1 + ( n - 1 ) * abs( INCX ) ) * sizeof( double ),
* that contains the vector x. Unchanged on exit.
*
* INCX (input) const int
* On entry, INCX specifies the increment for the elements of X.
* INCX must not be zero. Unchanged on exit.
*
* BETA (input) const double
* On entry, BETA specifies the scalar beta. When BETA is
* supplied as zero then Y need not be set on input. Unchanged
* on exit.
*
* Y (input/output) double *
* On entry, Y points to the first entry to be accessed of an
* incremented array of size equal to or greater than
* ( 1 + ( m - 1 ) * abs( INCY ) ) * sizeof( double ),
* that contains the vector y. Before entry with BETA non-zero,
* the incremented array Y must contain the vector y. On exit,
* Y is overwritten by the updated vector y.
*
* INCY (input) const int
* On entry, INCY specifies the increment for the elements of Y.
* INCY must not be zero. Unchanged on exit.
*
* ---------------------------------------------------------------------
*/
/* ..
* .. Executable Statements ..
*
*/
if( ( M == 0 ) || ( N == 0 ) ||
( ( ALPHA == ATL_dZERO ) && ( BETA == ATL_dONE ) ) ) return;
if( ALPHA == ATL_dZERO ) { Mdvscal( M, BETA, Y, INCY ); return; }
if( ( TRANS == AtlasNoTrans ) || ( TRANS == AtlasConj ) )
{ ATL_drefgemvN( M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ); }
else
{ ATL_drefgemvT( M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ); }
/*
* End of ATL_drefgemv
*/
}
void ATL_drefsymv
(
const enum ATLAS_UPLO UPLO,
const int N,
const double ALPHA,
const double * A,
const int LDA,
const double * X,
const int INCX,
const double BETA,
double * Y,
const int INCY
)
{
/*
* Purpose
* =======
*
* ATL_drefsymv 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 symmetric matrix.
*
* Arguments
* =========
*
* UPLO (input) const enum ATLAS_UPLO
* On entry, UPLO specifies whether the upper or lower triangu-
* lar part of the array A is to be referenced as follows:
*
* UPLO = AtlasUpper Only the upper triangular part of A
* is to be referenced.
*
* UPLO = AtlasLower Only the lower triangular part of A
* is to be referenced.
*
* Unchanged on exit.
*
* N (input) const int
* On entry, N specifies the order of the matrix A. N must be at
* least zero. Unchanged on exit.
*
* ALPHA (input) const double
* On entry, ALPHA specifies the scalar alpha. When ALPHA is
* supplied as zero then A and X need not be set on input. Un-
* changed on exit.
*
* A (input) const double *
* On entry, A points to an array of size equal to or greater
* than LDA * n * sizeof( double ). Before entry with
* UPLO = AtlasUpper, the leading n by n upper triangular part
* of the array A must contain the upper triangular part of the
* symmetric matrix and the strictly lower triangular part of
* A is not referenced. Before entry with UPLO = AtlasLower, the
* leading n by n lower triangular part of the array A must
* contain the lower triangular part of the symmetric matrix and
* the strictly upper triangular part of A is not referenced.
* Unchanged on exit.
*
* LDA (input) const int
* On entry, LDA specifies the leading dimension of A as decla-
* red in the calling (sub) program. LDA must be at least
* MAX( 1, n ). Unchanged on exit.
*
* X (input) const double *
* On entry, X points to the first entry to be accessed of an
* incremented array of size equal to or greater than
* ( 1 + ( n - 1 ) * abs( INCX ) ) * sizeof( double ),
* that contains the vector x. Unchanged on exit.
*
* INCX (input) const int
* On entry, INCX specifies the increment for the elements of X.
* INCX must not be zero. Unchanged on exit.
*
* BETA (input) const double
* On entry, BETA specifies the scalar beta. When BETA is
* supplied as zero then Y need not be set on input. Unchanged
* on exit.
*
* Y (input/output) double *
* On entry, Y points to the first entry to be accessed of an
* incremented array of size equal to or greater than
* ( 1 + ( n - 1 ) * abs( INCY ) ) * sizeof( double ),
* that contains the vector y. Before entry with BETA non-zero,
* the incremented array Y must contain the vector y. On exit,
* Y is overwritten by the updated vector y.
*
* INCY (input) const int
* On entry, INCY specifies the increment for the elements of Y.
* INCY must not be zero. Unchanged on exit.
*
* ---------------------------------------------------------------------
*/
/* ..
* .. Executable Statements ..
*
*/
if( ( N == 0 ) || ( ( ALPHA == ATL_dZERO ) &&
( BETA == ATL_dONE ) ) ) return;
if( ALPHA == ATL_dZERO ) { Mdvscal( N, BETA, Y, INCY ); return; }
if( UPLO == AtlasUpper )
{
ATL_drefsymvU( N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY );
}
else
{
ATL_drefsymvL( N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY );
}
/*
* End of ATL_drefsymv
*/
}
