/* ////////////////////////////////////////////////////////////////////////////
-- Auxiliary function: 'a' is pointer to the current panel holding the
Householder vectors for the QR factorization of the panel. This routine
puts ones on the diagonal and zeros in the upper triangular part of 'a'.
The upper triangular values are stored in work. Than the inverse is
calculated in place in work, so as final result work holds the inverse
of the upper triangular diagonal block.
*/
void dsplit_diag_block(int ib, double *a, int lda, double *work){
int i, j, info;
double *cola, *colw;
double c_zero = MAGMA_D_ZERO;
double c_one = MAGMA_D_ONE;
for(i=0; i<ib; i++){
cola = a + i*lda;
colw = work + i*ib;
for(j=0; j<i; j++){
colw[j] = cola[j];
cola[j] = c_zero;
}
colw[i] = cola[i];
cola[i] = c_one;
}
lapackf77_dtrtri( MagmaUpperStr, MagmaNonUnitStr, &ib, work, &ib, &info);
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing dtrtri
*/
int main( int argc, char** argv )
{
TESTING_INIT();
real_Double_t gflops, magma_perf, magma_time=0; //, cpu_perf=0, cpu_time=0;
double magma_error, norm_invA, work[1];
magma_int_t N, lda, ldda, info;
magma_int_t jb, nb, nblock, sizeA, size_inv;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
magma_int_t *ipiv;
double *h_A, *h_dinvA;
double *d_A, *d_dinvA;
double c_neg_one = MAGMA_D_NEG_ONE;
magma_int_t status = 0;
magma_opts opts;
parse_opts( argc, argv, &opts );
opts.lapack |= opts.check; // check (-c) implies lapack (-l)
double tol = opts.tolerance * lapackf77_dlamch("E");
const char *uplo_ = lapack_uplo_const(opts.uplo);
// this is the NB hard coded into dtrtri_diag.
nb = 128;
printf("uplo = %s, diag = %s\n",
lapack_uplo_const(opts.uplo), lapack_diag_const(opts.diag) );
printf(" N MAGMA Gflop/s (ms) MAGMA error\n");
printf("=======================================\n");
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
lda = N;
ldda = ((lda+31)/32)*32;
nblock = (N+nb-1)/nb;
gflops = nblock * FLOPS_DTRTRI( nb ) / 1e9;
TESTING_MALLOC_CPU( h_A, double, lda*N );
TESTING_MALLOC_CPU( ipiv, magma_int_t, N );
size_inv = nblock*nb*nb;
TESTING_MALLOC_DEV( d_A, double, ldda*N );
TESTING_MALLOC_DEV( d_dinvA, double, size_inv );
TESTING_MALLOC_CPU( h_dinvA, double, size_inv );
/* Initialize the matrices */
/* Factor A into LU to get well-conditioned triangular matrix.
* Copy L to U, since L seems okay when used with non-unit diagonal
* (i.e., from U), while U fails when used with unit diagonal. */
sizeA = lda*N;
lapackf77_dlarnv( &ione, ISEED, &sizeA, h_A );
lapackf77_dgetrf( &N, &N, h_A, &lda, ipiv, &info );
for( int j = 0; j < N; ++j ) {
for( int i = 0; i < j; ++i ) {
*h_A(i,j) = *h_A(j,i);
}
}
/* =====================================================================
Performs operation using MAGMABLAS
=================================================================== */
magma_dsetmatrix( N, N, h_A, lda, d_A, ldda );
magma_time = magma_sync_wtime( NULL );
magmablas_dtrtri_diag( opts.uplo, opts.diag, N, d_A, ldda, d_dinvA );
magma_time = magma_sync_wtime( NULL ) - magma_time;
magma_perf = gflops / magma_time;
magma_dgetvector( size_inv, d_dinvA, 1, h_dinvA, 1 );
if ( opts.verbose ) {
printf( "A%d=", (int) N );
magma_dprint( N, N, h_A, lda );
printf( "d_dinvA%d=", (int) N );
magma_dprint( min(N+4, nb), min(N+4, nblock*nb), h_dinvA, nb );
}
/* =====================================================================
Performs operation using LAPACK
=================================================================== */
if ( opts.lapack ) {
//cpu_time = magma_wtime();
lapackf77_dtrtri(
lapack_uplo_const(opts.uplo), lapack_diag_const(opts.diag),
&N, h_A, &lda, &info );
//cpu_time = magma_wtime() - cpu_time;
//cpu_perf = gflops / cpu_time;
}
/* =====================================================================
Check the result
=================================================================== */
if ( opts.check ) {
// |invA - invA_magma| / |invA|, accumulated over all diagonal blocks
magma_error = 0;
norm_invA = 0;
for( int i=0; i < N; i += nb ) {
jb = min( nb, N-i );
dgeadd( jb, jb, c_neg_one, h_A(i, i), lda, h_dinvA(0, i), nb );
magma_error = max( magma_error, lapackf77_dlantr( "M", uplo_, MagmaNonUnitStr, &jb, &jb, h_dinvA(0, i), &nb, work ));
norm_invA = max( norm_invA, lapackf77_dlantr( "M", uplo_, MagmaNonUnitStr, &jb, &jb, h_A(i, i), &lda, work ));
}
magma_error /= norm_invA;
// CPU is doing N-by-N inverse, while GPU is doing (N/NB) NB-by-NB inverses.
// So don't compare performance.
printf("%5d %7.2f (%7.2f) %8.2e %s\n",
(int) N,
magma_perf, 1000.*magma_time,
//cpu_perf, 1000.*cpu_time,
magma_error,
(magma_error < tol ? "ok" : "failed"));
status += ! (magma_error < tol);
}
else {
printf("%5d %7.2f (%7.2f) ---\n",
(int) N,
magma_perf, 1000.*magma_time );
}
TESTING_FREE_CPU( h_A );
TESTING_FREE_CPU( ipiv );
TESTING_FREE_DEV( d_A );
TESTING_FREE_DEV( d_dinvA );
TESTING_FREE_CPU( h_dinvA );
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
TESTING_FINALIZE();
return status;
}
/**
Purpose
-------
DTRTRI computes the inverse of a real upper or lower triangular
matrix dA.
This is the Level 3 BLAS version of the algorithm.
Arguments
---------
@param[in]
uplo magma_uplo_t
- = MagmaUpper: A is upper triangular;
- = MagmaLower: A is lower triangular.
@param[in]
diag magma_diag_t
- = MagmaNonUnit: A is non-unit triangular;
- = MagmaUnit: A is unit triangular.
@param[in]
n INTEGER
The order of the matrix A. N >= 0.
@param[in,out]
dA DOUBLE_PRECISION array ON THE GPU, dimension (LDDA,N)
On entry, the triangular matrix A. If UPLO = MagmaUpper, the
leading N-by-N upper triangular part of the array dA contains
the upper triangular matrix, and the strictly lower
triangular part of A is not referenced. If UPLO = MagmaLower, the
leading N-by-N lower triangular part of the array dA contains
the lower triangular matrix, and the strictly upper
triangular part of A is not referenced. If DIAG = MagmaUnit, the
diagonal elements of A are also not referenced and are
assumed to be 1.
On exit, the (triangular) inverse of the original matrix, in
the same storage format.
@param[in]
ldda INTEGER
The leading dimension of the array dA. LDDA >= max(1,N).
@param[out]
info INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
- > 0: if INFO = i, dA(i,i) is exactly zero. The triangular
matrix is singular and its inverse cannot be computed.
(Singularity check is currently disabled.)
@ingroup magma_dgesv_aux
********************************************************************/
extern "C" magma_int_t
magma_dtrtri_gpu(
magma_uplo_t uplo, magma_diag_t diag, magma_int_t n,
magmaDouble_ptr dA, magma_int_t ldda,
magma_int_t *info)
{
#define dA(i, j) (dA+(j)*ldda + (i))
/* Local variables */
const char* uplo_ = lapack_uplo_const( uplo );
const char* diag_ = lapack_diag_const( diag );
magma_int_t nb, nn, j, jb;
//double c_zero = MAGMA_D_ZERO;
double c_one = MAGMA_D_ONE;
double c_neg_one = MAGMA_D_NEG_ONE;
double *work;
int upper = (uplo == MagmaUpper);
int nounit = (diag == MagmaNonUnit);
*info = 0;
if (! upper && uplo != MagmaLower)
*info = -1;
else if (! nounit && diag != MagmaUnit)
*info = -2;
else if (n < 0)
*info = -3;
else if (ldda < max(1,n))
*info = -5;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
/* Check for singularity if non-unit */
/* cannot do here with matrix dA on GPU -- need kernel */
/*
if (nounit) {
for (j=0; j < n; ++j) {
if ( MAGMA_D_EQUAL( *dA(j,j), c_zero )) {
*info = j+1; // Fortran index
return *info;
}
}
}
*/
/* Determine the block size for this environment */
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_dtrtri( uplo_, diag_, &n, work, &n, info );
magma_dsetmatrix( n, n, work, n, dA, ldda );
}
else {
if (upper) {
/* Compute inverse of upper triangular matrix */
for (j=0; j < n; j += nb) {
jb = min(nb, (n-j));
/* Compute rows 1:j-1 of current block column */
magma_dtrmm( MagmaLeft, MagmaUpper,
MagmaNoTrans, MagmaNonUnit, j, jb,
c_one, dA(0,0), ldda, dA(0, j), ldda );
magma_dtrsm( MagmaRight, MagmaUpper,
MagmaNoTrans, MagmaNonUnit, j, jb,
c_neg_one, dA(j,j), ldda, dA(0, j), ldda );
magma_dgetmatrix_async( jb, jb,
dA(j, j), ldda,
work, jb, stream[1] );
magma_queue_sync( stream[1] );
/* Compute inverse of current diagonal block */
lapackf77_dtrtri( MagmaUpperStr, diag_, &jb, work, &jb, info );
magma_dsetmatrix_async( jb, jb,
work, jb,
dA(j, j), ldda, stream[0] );
}
}
else {
/* Compute inverse of lower triangular matrix */
nn = ((n-1)/nb)*nb+1;
for (j=nn-1; j >= 0; j -= nb) {
jb = min(nb,(n-j));
if ((j+jb) < n) {
/* Compute rows j+jb:n of current block column */
magma_dtrmm( MagmaLeft, MagmaLower,
MagmaNoTrans, MagmaNonUnit, (n-j-jb), jb,
c_one, dA(j+jb,j+jb), ldda, dA(j+jb, j), ldda );
magma_dtrsm( MagmaRight, MagmaLower,
MagmaNoTrans, MagmaNonUnit, (n-j-jb), jb,
c_neg_one, dA(j,j), ldda, dA(j+jb, j), ldda );
}
magma_dgetmatrix_async( jb, jb,
dA(j, j), ldda,
work, jb, stream[1] );
magma_queue_sync( stream[1] );
/* Compute inverse of current diagonal block */
lapackf77_dtrtri( MagmaLowerStr, diag_, &jb, work, &jb, info );
magma_dsetmatrix_async( jb, jb,
work, jb,
dA(j, j), ldda, stream[0] );
}
}
}
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free_pinned( work );
return *info;
}