/***************************************************************************//**
Purpose
-------
DLAUUM computes the product U * U^H or L^H * L, where the triangular
factor U or L is stored in the upper or lower triangular part of
the array A.
If UPLO = MagmaUpper then the upper triangle of the result is stored,
overwriting the factor U in A.
If UPLO = MagmaLower then the lower triangle of the result is stored,
overwriting the factor L in A.
This is the blocked form of the algorithm, calling Level 3 BLAS.
Arguments
---------
@param[in]
uplo magma_uplo_t
Specifies whether the triangular factor stored in the array A
is upper or lower triangular:
- = MagmaUpper: Upper triangular
- = MagmaLower: Lower triangular
@param[in]
n INTEGER
The order of the triangular factor U or L. N >= 0.
@param[in,out]
A DOUBLE PRECISION array, dimension (LDA,N)
On entry, the triangular factor U or L.
On exit, if UPLO = MagmaUpper, the upper triangle of A is
overwritten with the upper triangle of the product U * U^H;
if UPLO = MagmaLower, the lower triangle of A is overwritten with
the lower triangle of the product L^H * L.
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= max(1,N).
@param[out]
info INTEGER
- = 0: successful exit
- < 0: if INFO = -k, the k-th argument had an illegal value
@ingroup magma_lauum
*******************************************************************************/
extern "C" magma_int_t
magma_dlauum(
magma_uplo_t uplo, magma_int_t n,
double *A, magma_int_t lda,
magma_int_t *info)
{
#define A(i_, j_) ( A + (i_) + (j_)*lda )
#ifdef HAVE_clBLAS
#define dA(i_, j_) dA, ((i_) + (j_)*ldda)
#else
#define dA(i_, j_) (dA + (i_) + (j_)*ldda)
#endif
/* Constants */
const double c_one = MAGMA_D_ONE;
const double d_one = MAGMA_D_ONE;
const char* uplo_ = lapack_uplo_const( uplo );
/* Local variables */
magma_int_t i, ib, ldda, nb;
magmaDouble_ptr dA;
bool upper = (uplo == MagmaUpper);
*info = 0;
if (! upper && uplo != MagmaLower)
*info = -1;
else if (n < 0)
*info = -2;
else if (lda < max(1,n))
*info = -4;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
/* Quick return */
if (n == 0)
return *info;
nb = magma_get_dpotrf_nb( n );
ldda = magma_roundup( n, 32 );
if (MAGMA_SUCCESS != magma_dmalloc( &dA, n*ldda )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_queue_t queues[2];
magma_device_t cdev;
magma_getdevice( &cdev );
magma_queue_create( cdev, &queues[0] );
magma_queue_create( cdev, &queues[1] );
if (nb <= 1 || nb >= n) {
lapackf77_dlauum( uplo_, &n, A, &lda, info );
}
else if (upper) {
/* Compute the product U * U^H. */
// Computing 2nd block column (diagonal & above):
// [ u11 u12 u13 ] [ u11^H ] [ ... u12*u22^H + u13*u23^H ... ]
// [ u22 u23 ] * [ u12^H u22^H ] = [ ... u22*u22^H + u23*u23^H ... ]
// [ u33 ] [ u13^H u23^H u33^H ] [ ... ... ... ]
for (i=0; i < n; i += nb) {
ib = min( nb, n-i );
// Send diagonl block, u22
// This must finish before lauum below
magma_dsetmatrix( ib, ib,
A(i,i), lda,
dA(i,i), ldda, queues[0] );
// Send right of diagonl block, u23
magma_dsetmatrix_async( ib, n-i-ib,
A(i,i+ib), lda,
dA(i,i+ib), ldda, queues[1] );
// u12 = u12 * u22^H
magma_dtrmm( MagmaRight, MagmaUpper,
MagmaConjTrans, MagmaNonUnit, i, ib, c_one,
dA(i,i), ldda,
dA(0,i), ldda, queues[0] );
// u22 = u22 * u22^H
lapackf77_dlauum( MagmaUpperStr, &ib, A(i,i), &lda, info );
magma_dsetmatrix_async( ib, ib,
A(i,i), lda,
dA(i,i), ldda, queues[0] );
if (i+ib < n) {
// wait for u23
magma_queue_sync( queues[1] );
// u12 += u13 * u23^H
magma_dgemm( MagmaNoTrans, MagmaConjTrans,
i, ib, n-i-ib,
c_one, dA(0,i+ib), ldda,
dA(i,i+ib), ldda,
c_one, dA(0,i), ldda, queues[0] );
// u22 += u23 * u23^H
magma_dsyrk( MagmaUpper, MagmaNoTrans, ib, n-i-ib,
d_one, dA(i,i+ib), ldda,
d_one, dA(i,i), ldda, queues[0] );
}
// Get diagonal block & above of current column from device
// This could be on a different queue -- not needed until return
magma_dgetmatrix_async( i+ib, ib,
dA(0,i), ldda,
A(0,i), lda, queues[0] );
}
}
else {
/* Compute the product L^H * L. */
for (i=0; i < n; i += nb) {
ib = min( nb, n-i );
magma_dsetmatrix( ib, ib,
A(i,i), lda,
dA(i,i), ldda, queues[0] );
magma_dsetmatrix_async( n-i-ib, ib,
A(i+ib,i), lda,
dA(i+ib,i), ldda, queues[1] );
magma_dtrmm( MagmaLeft, MagmaLower,
MagmaConjTrans, MagmaNonUnit, ib, i, c_one,
dA(i,i), ldda,
dA(i,0), ldda, queues[0] );
lapackf77_dlauum( MagmaLowerStr, &ib, A(i,i), &lda, info );
magma_dsetmatrix_async( ib, ib,
A(i,i), lda,
dA(i,i), ldda, queues[0] );
if (i+ib < n) {
magma_queue_sync( queues[1] );
magma_dgemm( MagmaConjTrans, MagmaNoTrans,
ib, i, n-i-ib,
c_one, dA(i+ib,i), ldda,
dA(i+ib,0), ldda,
c_one, dA(i,0), ldda, queues[0] );
magma_dsyrk( MagmaLower, MagmaConjTrans, ib, n-i-ib,
d_one, dA(i+ib,i), ldda,
d_one, dA(i,i), ldda, queues[0] );
}
magma_dgetmatrix_async( ib, i+ib,
dA(i,0), ldda,
A(i,0), lda, queues[0] );
}
}
magma_queue_destroy( queues[0] );
magma_queue_destroy( queues[1] );
magma_free( dA );
return *info;
}
extern "C" magma_int_t
magma_dlauum_gpu(char uplo, magma_int_t n,
double *dA, magma_int_t ldda, magma_int_t *info)
{
/* -- MAGMA (version 1.4.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
August 2013
Purpose
=======
DLAUUM computes the product U * U' or L' * L, where the triangular
factor U or L is stored in the upper or lower triangular part of
the array dA.
If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
overwriting the factor U in dA.
If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
overwriting the factor L in dA.
This is the blocked form of the algorithm, calling Level 3 BLAS.
Arguments
=========
UPLO (input) CHARACTER*1
Specifies whether the triangular factor stored in the array dA
is upper or lower triangular:
= 'U': Upper triangular
= 'L': Lower triangular
N (input) INTEGER
The order of the triangular factor U or L. N >= 0.
dA (input/output) DOUBLE PRECISION array on the GPU, dimension (LDDA,N)
On entry, the triangular factor U or L.
On exit, if UPLO = 'U', the upper triangle of dA is
overwritten with the upper triangle of the product U * U';
if UPLO = 'L', the lower triangle of dA is overwritten with
the lower triangle of the product L' * L.
LDDA (input) INTEGER
The leading dimension of the array A. LDDA >= max(1,N).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -k, the k-th argument had an illegal value
===================================================================== */
/* Local variables */
char uplo_[2] = {uplo, 0};
magma_int_t nb, i, ib;
double d_one = MAGMA_D_ONE;
double c_one = MAGMA_D_ONE;
double *work;
int upper = lapackf77_lsame(uplo_, "U");
*info = 0;
if ((! upper) && (! lapackf77_lsame(uplo_, "L")))
*info = -1;
else if (n < 0)
*info = -2;
else if (ldda < max(1,n))
*info = -4;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
nb = magma_get_dpotrf_nb(n);
if (MAGMA_SUCCESS != magma_dmalloc_pinned( &work, nb*nb )) {
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
magma_queue_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
if (nb <= 1 || nb >= n)
{
magma_dgetmatrix( n, n, dA, ldda, work, n );
lapackf77_dlauum(uplo_, &n, work, &n, info);
magma_dsetmatrix( n, n, work, n, dA, ldda );
}
else
{
if (upper)
{
/* Compute inverse of upper triangular matrix */
for (i=0; i < n; i += nb)
{
ib = min(nb, (n-i));
/* Compute the product U * U'. */
magma_dtrmm( MagmaRight, MagmaUpper,
MagmaTrans, MagmaNonUnit, i, ib,
c_one, dA(i,i), ldda, dA(0, i),ldda);
magma_dgetmatrix( ib, ib,
dA(i, i), ldda,
work, ib );
lapackf77_dlauum(MagmaUpperStr, &ib, work, &ib, info);
magma_dsetmatrix( ib, ib,
work, ib,
dA(i, i), ldda );
if(i+ib < n)
{
magma_dgemm( MagmaNoTrans, MagmaTrans,
i, ib, (n-i-ib), c_one, dA(0,i+ib),
ldda, dA(i, i+ib), ldda, c_one,
dA(0,i), ldda);
magma_dsyrk( MagmaUpper, MagmaNoTrans, ib,(n-i-ib),
d_one, dA(i, i+ib), ldda,
d_one, dA(i, i), ldda);
}
}
}
else
{
/* Compute the product L' * L. */
for(i=0; i<n; i=i+nb)
{
ib=min(nb,(n-i));
magma_dtrmm( MagmaLeft, MagmaLower,
MagmaTrans, MagmaNonUnit, ib,
i, c_one, dA(i,i), ldda,
dA(i, 0),ldda);
magma_dgetmatrix( ib, ib,
dA(i, i), ldda,
work, ib );
lapackf77_dlauum(MagmaLowerStr, &ib, work, &ib, info);
magma_dsetmatrix( ib, ib,
work, ib,
dA(i, i), ldda );
if((i+ib) < n)
{
magma_dgemm( MagmaTrans, MagmaNoTrans,
ib, i, (n-i-ib), c_one, dA( i+ib,i),
ldda, dA(i+ib, 0),ldda, c_one,
dA(i,0), ldda);
magma_dsyrk( MagmaLower, MagmaTrans, ib, (n-i-ib),
d_one, dA(i+ib, i), ldda,
d_one, dA(i, i), ldda);
}
}
}
}
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free_pinned( work );
return *info;
}
