void ATL_zrefgemmNN
(
const int M,
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
)
{
/*
* .. Local Variables ..
*/
register double t0_i, t0_r;
int i, iail, iblj, icij, j, jal, jbj, jcj, l,
lda2 = ( LDA << 1 ), ldb2 = ( LDB << 1 ),
ldc2 = ( LDC << 1 );
/* ..
* .. Executable Statements ..
*
*/
for( j = 0, jbj = 0, jcj = 0; j < N; j++, jbj += ldb2, jcj += ldc2 )
{
Mzgescal( M, 1, BETA, C+jcj, LDC );
for( l = 0, jal = 0, iblj = jbj; l < K; l++, jal += lda2, iblj += 2 )
{
Mmul( ALPHA[0], ALPHA[1], B[iblj], B[iblj+1], t0_r, t0_i );
for( i = 0, iail = jal, icij = jcj; i < M; i++, iail += 2, icij += 2 )
{
Mmla( A[iail], A[iail+1], t0_r, t0_i, C[icij], C[icij+1] );
}
}
}
/*
* End of ATL_zrefgemmNN
*/
}
void ATL_zrefsymm
(
const enum ATLAS_SIDE SIDE,
const enum ATLAS_UPLO UPLO,
const int M,
const int N,
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_zrefsymm performs one of the matrix-matrix operations
*
* C := alpha * A * B + beta * C,
*
* or
*
* C := alpha * B * A + beta * C,
*
* where alpha and beta are scalars, A is a symmetric matrix and B and
* C are m by n matrices.
*
* Arguments
* =========
*
* SIDE (input) const enum ATLAS_SIDE
* On entry, SIDE specifies whether the symmetric matrix A
* appears on the left or right in the operation as follows:
*
* SIDE = AtlasLeft C := alpha * A * B + beta * C,
*
* SIDE = AtlasRight C := alpha * B * A + beta * C.
*
* Unchanged on exit.
*
* 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.
*
* M (input) const int
* On entry, M specifies the number of rows of the matrix C.
* M must be at least zero. Unchanged on exit.
*
* N (input) const int
* On entry, N specifies the number of columns of the matrix C.
* 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 the elements of the matrices A and B
* need not be set on input.
*
* A (input) const double *
* On entry, A points to an array of size equal to or greater
* than LDA * ka * sizeof( double[2] ), where ka is m when
* SIDE = AtlasLeft and is n otherwise. Before entry with
* SIDE = AtlasLeft, the m by m part of the array A must con-
* tain the symmetric matrix, such that when UPLO = AtlasUpper,
* the leading m by m 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,
* and when UPLO = AtlasLower, the leading m by m lower trian-
* gular part of the array A must contain the lower triangular
* part of the symmetric matrix and the strictly upper triangu-
* lar part of A is not referenced.
* Before entry with SIDE = AtlasRight, the n by n part of
* the array A must contain the symmetric matrix, such that
* when 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, and when 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, m ) when SIDE = AtlasLeft, and MAX( 1, n ) otherwise.
* Unchanged on exit.
*
* B (input) const double *
* On entry, B points to an array of size equal to or greater
* than LDB * n * sizeof( double[2] ). Before entry, the lea-
* ding m by n part of the array B must contain the matrix B.
* Unchanged on exit.
*
* LDB (input) const int
* On entry, LDB specifies the leading dimension of B as decla-
* red in the calling (sub) program. LDB must be at least
* MAX( 1, m ). wise. Unchanged on exit.
*
* BETA (input) const double *
* On entry, BETA specifies the scalar beta. When BETA is
* supplied as zero then the elements of the matrix C need
* not be set on input. Unchanged on exit.
*
* C (input/output) double *
* On entry, C points to an array of size equal to or greater
* than LDC * n * sizeof( double[2] ). Before entry, the lea-
* ding m by n part of the array C must contain the matrix C,
* except when beta is zero, in which case C need not be set on
* entry. On exit, the array C is overwritten by the m by n up-
* dated matrix.
*
* LDC (input) const int
* On entry, LDC specifies the leading dimension of A as decla-
* red in the calling (sub) program. LDC must be at least
* MAX( 1, m ). Unchanged on exit.
*
* ---------------------------------------------------------------------
*/
/* ..
* .. Executable Statements ..
*
*/
if( ( M == 0 ) || ( N == 0 ) || ( Mdzero( ALPHA[0], ALPHA[1] ) &&
Mdone ( BETA [0], BETA [1] ) ) ) return;
if( Mdzero( ALPHA[0], ALPHA[1] ) )
{
Mzgescal( M, N, BETA, C, LDC );
return;
}
if( SIDE == AtlasLeft )
{
if( UPLO == AtlasUpper )
{
ATL_zrefsymmLU( M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC );
}
else
{
ATL_zrefsymmLL( M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC );
}
}
else
{
if( UPLO == AtlasUpper )
{
ATL_zrefsymmRU( M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC );
}
else
{
ATL_zrefsymmRL( M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC );
}
}
/*
* End of ATL_zrefsymm
*/
}
void ATL_zreftrmm
(
const enum ATLAS_SIDE SIDE,
const enum ATLAS_UPLO UPLO,
const enum ATLAS_TRANS TRANS,
const enum ATLAS_DIAG DIAG,
const int M,
const int N,
const double * ALPHA,
const double * A,
const int LDA,
double * B,
const int LDB
)
{
/*
* Purpose
* =======
*
* ATL_zreftrmm performs one of the matrix-matrix operations
*
* B := alpha * op( A ) * B, or B := alpha * B * op( A ),
*
* where alpha is a scalar, B is an m by n matrix, A is a unit, or non-
* unit, upper or lower triangular matrix and op( X ) is one of
*
* op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ).
*
* Arguments
* =========
*
* SIDE (input) const enum ATLAS_SIDE
* On entry, SIDE specifies whether op( A ) multiplies B from
* the left or right as follows:
*
* SIDE = AtlasLeft B := alpha * op( A )* B,
*
* SIDE = AtlasRight B := alpha * B * op( A ).
*
* Unchanged on exit.
*
* UPLO (input) const enum ATLAS_UPLO
* On entry, UPLO specifies whether the matrix is an upper or
* lower triangular matrix as follows:
*
* UPLO = AtlasUpper A is an upper triangular matrix.
*
* UPLO = AtlasLower A is a lower triangular matrix.
*
* Unchanged on exit.
*
* TRANSA (input) const enum ATLAS_TRANS
* On entry, TRANSA specifies the form of op( A ) to be used in
* the matrix multiplication as follows:
*
* TRANSA = AtlasNoTrans op( A ) = A,
*
* TRANSA = AtlasTrans op( A ) = A',
*
* TRANSA = AtlasConjTrans op( A ) = conjg( A' ).
*
* Unchanged on exit.
*
* DIAG (input) const enum ATLAS_DIAG
* On entry, DIAG specifies whether or not A is unit triangu-
* lar as follows:
*
* DIAG = AtlasUnit A is assumed to be unit triangular,
*
* DIAG = AtlasNonUnit A is not assumed to be unit trian-
* gular.
*
* Unchanged on exit.
*
* M (input) const int
* On entry, M specifies the number of rows of the matrix B.
* M must be at least zero. Unchanged on exit.
*
* N (input) const int
* On entry, N specifies the number of columns of the matrix B.
* 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 the elements of the matrix B need not
* be set on input. Unchanged on exit.
*
* A (input) const double *
* On entry, A points to an array of size equal to or greater
* than LDA * k * sizeof( double[2] ), where k is m when
* SIDE = AtlasLeft and is n otherwise. Before entry with
* UPLO = AtlasUpper, the leading k by k upper triangular part
* of the array A must contain the upper triangular matrix and
* the strictly lower triangular part of A is not referenced.
* Before entry with UPLO = AtlasLower, the leading k by k lower
* triangular part of the array A must contain the lower trian-
* gular matrix and the strictly upper triangular part of A is
* not referenced.
* Note that when DIAG = AtlasUnit, the diagonal elements of
* A are not referenced either, but are assumed to be unity.
* 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 SIDE = AtlasLeft, and MAX( 1, n ) otherwise.
* Unchanged on exit.
*
* B (input/output) double *
* On entry, B points to an array of size equal to or greater
* than LDB * n * sizeof( double[2] ). Before entry, the lea-
* ding m by n part of the array B must contain the matrix B,
* except when beta is zero, in which case B need not be set on
* entry. On exit, the array B is overwritten by the m by n up-
* dated matrix.
*
* LDB (input) const int
* On entry, LDB specifies the leading dimension of B as decla-
* red in the calling (sub) program. LDB must be at least
* MAX( 1, m ). Unchanged on exit.
*
* ---------------------------------------------------------------------
*/
/* ..
* .. Executable Statements ..
*
*/
if( ( M == 0 ) || ( N == 0 ) ) return;
if( Mdzero( ALPHA[0], ALPHA[1] ) )
{ Mzgescal( M, N, ALPHA, B, LDB ); return; }
if( SIDE == AtlasLeft )
{
if( UPLO == AtlasUpper )
{
if( TRANS == AtlasNoTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLUNN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLUNU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else if( TRANS == AtlasTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLUTN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLUTU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLUCN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLUCU( M, N, ALPHA, A, LDA, B, LDB ); }
}
}
else
{
if( TRANS == AtlasNoTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLLNN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLLNU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else if( TRANS == AtlasTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLLTN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLLTU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmLLCN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmLLCU( M, N, ALPHA, A, LDA, B, LDB ); }
}
}
}
else
{
if( UPLO == AtlasUpper )
{
if( TRANS == AtlasNoTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRUNN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRUNU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else if( TRANS == AtlasTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRUTN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRUTU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRUCN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRUCU( M, N, ALPHA, A, LDA, B, LDB ); }
}
}
else
{
if( TRANS == AtlasNoTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRLNN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRLNU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else if( TRANS == AtlasTrans )
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRLTN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRLTU( M, N, ALPHA, A, LDA, B, LDB ); }
}
else
{
if( DIAG == AtlasNonUnit )
{ ATL_zreftrmmRLCN( M, N, ALPHA, A, LDA, B, LDB ); }
else { ATL_zreftrmmRLCU( M, N, ALPHA, A, LDA, B, LDB ); }
}
}
}
/*
* End of ATL_zreftrmm
*/
}
