void MAGMAF_ZUNGQR_GPU( magma_int_t *m, magma_int_t *n, magma_int_t *k,
devptr_t *da, magma_int_t *ldda,
cuDoubleComplex *tau, devptr_t *dwork,
magma_int_t *nb, magma_int_t *info )
{
magma_zungqr_gpu( *m, *n, *k,
DEVPTR(da), *ldda, tau,
DEVPTR(dwork), *nb, info );
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing zungqr_gpu
*/
int main( int argc, char** argv)
{
TESTING_INIT();
real_Double_t gflops, gpu_perf, gpu_time, cpu_perf, cpu_time;
double Anorm, error, work[1];
magmaDoubleComplex c_neg_one = MAGMA_Z_NEG_ONE;
magmaDoubleComplex *hA, *hR, *tau, *h_work;
magmaDoubleComplex_ptr dA, dT;
magma_int_t m, n, k;
magma_int_t n2, lda, ldda, lwork, min_mn, nb, info;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
magma_int_t status = 0;
magma_opts opts;
parse_opts( argc, argv, &opts );
double tol = opts.tolerance * lapackf77_dlamch("E");
opts.lapack |= opts.check; // check (-c) implies lapack (-l)
printf(" m n k CPU GFlop/s (sec) GPU GFlop/s (sec) ||R|| / ||A||\n");
printf("=========================================================================\n");
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
m = opts.msize[itest];
n = opts.nsize[itest];
k = opts.ksize[itest];
if ( m < n || n < k ) {
printf( "%5d %5d %5d skipping because m < n or n < k\n", (int) m, (int) n, (int) k );
continue;
}
lda = m;
ldda = ((m + 31)/32)*32;
n2 = lda*n;
min_mn = min(m, n);
nb = magma_get_zgeqrf_nb( m );
lwork = (m + 2*n+nb)*nb;
gflops = FLOPS_ZUNGQR( m, n, k ) / 1e9;
TESTING_MALLOC_PIN( hA, magmaDoubleComplex, lda*n );
TESTING_MALLOC_PIN( h_work, magmaDoubleComplex, lwork );
TESTING_MALLOC_CPU( hR, magmaDoubleComplex, lda*n );
TESTING_MALLOC_CPU( tau, magmaDoubleComplex, min_mn );
TESTING_MALLOC_DEV( dA, magmaDoubleComplex, ldda*n );
TESTING_MALLOC_DEV( dT, magmaDoubleComplex, ( 2*min_mn + ((n + 31)/32)*32 )*nb );
lapackf77_zlarnv( &ione, ISEED, &n2, hA );
lapackf77_zlacpy( MagmaFullStr, &m, &n, hA, &lda, hR, &lda );
Anorm = lapackf77_zlange("f", &m, &n, hA, &lda, work );
/* ====================================================================
Performs operation using MAGMA
=================================================================== */
// first, get QR factors in both hA and dA
// okay that magma_zgeqrf_gpu has special structure for R; R isn't used here.
magma_zsetmatrix( m, n, hA, lda, dA, ldda );
magma_zgeqrf_gpu( m, n, dA, ldda, tau, dT, &info );
if (info != 0)
printf("magma_zgeqrf_gpu returned error %d: %s.\n",
(int) info, magma_strerror( info ));
magma_zgetmatrix( m, n, dA, ldda, hA, lda );
gpu_time = magma_wtime();
magma_zungqr_gpu( m, n, k, dA, ldda, tau, dT, nb, &info );
gpu_time = magma_wtime() - gpu_time;
gpu_perf = gflops / gpu_time;
if (info != 0)
printf("magma_zungqr_gpu returned error %d: %s.\n",
(int) info, magma_strerror( info ));
// Get dA back to the CPU to compare with the CPU result.
magma_zgetmatrix( m, n, dA, ldda, hR, lda );
/* =====================================================================
Performs operation using LAPACK
=================================================================== */
if ( opts.lapack ) {
cpu_time = magma_wtime();
lapackf77_zungqr( &m, &n, &k, hA, &lda, tau, h_work, &lwork, &info );
cpu_time = magma_wtime() - cpu_time;
cpu_perf = gflops / cpu_time;
if (info != 0)
printf("lapackf77_zungqr returned error %d: %s.\n",
(int) info, magma_strerror( info ));
// compute relative error |R|/|A| := |Q_magma - Q_lapack|/|A|
blasf77_zaxpy( &n2, &c_neg_one, hA, &ione, hR, &ione );
error = lapackf77_zlange("f", &m, &n, hR, &lda, work) / Anorm;
bool okay = (error < tol);
status += ! okay;
printf("%5d %5d %5d %7.1f (%7.2f) %7.1f (%7.2f) %8.2e %s\n",
(int) m, (int) n, (int) k,
cpu_perf, cpu_time, gpu_perf, gpu_time,
error, (okay ? "ok" : "failed"));
}
else {
printf("%5d %5d %5d --- ( --- ) %7.1f (%7.2f) --- \n",
(int) m, (int) n, (int) k,
gpu_perf, gpu_time );
}
TESTING_FREE_PIN( hA );
TESTING_FREE_PIN( h_work );
TESTING_FREE_CPU( hR );
TESTING_FREE_CPU( tau );
TESTING_FREE_DEV( dA );
TESTING_FREE_DEV( dT );
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
TESTING_FINALIZE();
return status;
}
extern "C" magma_int_t
magma_zqr(
magma_int_t m, magma_int_t n,
magma_z_matrix A,
magma_int_t lda,
magma_z_matrix *Q,
magma_z_matrix *R,
magma_queue_t queue )
{
magma_int_t info = 0;
// local constants
const magmaDoubleComplex c_zero = MAGMA_Z_ZERO;
// local variables
magma_int_t inc = 1;
magma_int_t k = min(m,n);
magma_int_t ldt;
magma_int_t nb;
magmaDoubleComplex *tau = NULL;
magmaDoubleComplex *dT = NULL;
magmaDoubleComplex *dA = NULL;
magma_z_matrix dR1 = {Magma_CSR};
// allocate CPU resources
CHECK( magma_zmalloc_pinned( &tau, k ) );
// query number of blocks required for QR factorization
nb = magma_get_zgeqrf_nb( m, n );
ldt = (2 * k + magma_roundup(n, 32)) * nb;
CHECK( magma_zmalloc( &dT, ldt ) );
// get copy of matrix array
if ( A.memory_location == Magma_DEV ) {
dA = A.dval;
} else {
CHECK( magma_zmalloc( &dA, lda * n ) );
magma_zsetvector( lda * n, A.val, inc, dA, inc, queue );
}
// QR factorization
magma_zgeqrf_gpu( m, n, dA, lda, tau, dT, &info );
// construct R matrix
if ( R != NULL ) {
if ( A.memory_location == Magma_DEV ) {
CHECK( magma_zvinit( R, Magma_DEV, lda, n, c_zero, queue ) );
magmablas_zlacpy( MagmaUpper, k, n, dA, lda, R->dval, lda, queue );
} else {
CHECK( magma_zvinit( &dR1, Magma_DEV, lda, n, c_zero, queue ) );
magmablas_zlacpy( MagmaUpper, k, n, dA, lda, dR1.dval, lda, queue );
CHECK( magma_zvinit( R, Magma_CPU, lda, n, c_zero, queue ) );
magma_zgetvector( lda * n, dR1.dval, inc, R->val, inc, queue );
}
}
// construct Q matrix
if ( Q != NULL ) {
magma_zungqr_gpu( m, n, k, dA, lda, tau, dT, nb, &info );
if ( A.memory_location == Magma_DEV ) {
CHECK( magma_zvinit( Q, Magma_DEV, lda, n, c_zero, queue ) );
magma_zcopyvector( lda * n, dA, inc, Q->dval, inc, queue );
} else {
CHECK( magma_zvinit( Q, Magma_CPU, lda, n, c_zero, queue ) );
magma_zgetvector( lda * n, dA, inc, Q->val, inc, queue );
}
}
cleanup:
if( info != 0 ){
magma_zmfree( Q, queue );
magma_zmfree( R, queue );
magma_zmfree( &dR1, queue );
}
// free resources
magma_free_pinned( tau );
magma_free( dT );
if ( A.memory_location == Magma_CPU ) {
magma_free( dA );
}
return info;
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing zungqr_gpu
*/
int main( int argc, char** argv)
{
TESTING_INIT();
real_Double_t gflops, gpu_perf, gpu_time, cpu_perf, cpu_time;
double error, work[1];
magmaDoubleComplex c_neg_one = MAGMA_Z_NEG_ONE;
magmaDoubleComplex *hA, *hR, *tau, *h_work;
magmaDoubleComplex *dA, *dT;
magma_int_t m, n, k;
magma_int_t n2, lda, ldda, lwork, min_mn, nb, info;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
magma_opts opts;
parse_opts( argc, argv, &opts );
opts.lapack |= opts.check; // check (-c) implies lapack (-l)
printf(" m n k CPU GFlop/s (sec) GPU GFlop/s (sec) ||R|| / ||A||\n");
printf("=========================================================================\n");
for( int i = 0; i < opts.ntest; ++i ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
m = opts.msize[i];
n = opts.nsize[i];
k = opts.ksize[i];
if ( m < n || n < k ) {
printf( "skipping m %d, n %d, k %d because m < n or n < k\n", (int) m, (int) n, (int) k );
continue;
}
lda = m;
ldda = ((m + 31)/32)*32;
n2 = lda*n;
min_mn = min(m, n);
nb = magma_get_zgeqrf_nb( m );
lwork = (m + 2*n+nb)*nb;
gflops = FLOPS_ZUNGQR( m, n, k ) / 1e9;
TESTING_MALLOC_PIN( hA, magmaDoubleComplex, lda*n );
TESTING_MALLOC_PIN( h_work, magmaDoubleComplex, lwork );
TESTING_MALLOC_CPU( hR, magmaDoubleComplex, lda*n );
TESTING_MALLOC_CPU( tau, magmaDoubleComplex, min_mn );
TESTING_MALLOC_DEV( dA, magmaDoubleComplex, ldda*n );
TESTING_MALLOC_DEV( dT, magmaDoubleComplex, ( 2*min_mn + ((n + 31)/32)*32 )*nb );
lapackf77_zlarnv( &ione, ISEED, &n2, hA );
lapackf77_zlacpy( MagmaUpperLowerStr, &m, &n, hA, &lda, hR, &lda );
/* ====================================================================
Performs operation using MAGMA
=================================================================== */
magma_zsetmatrix( m, n, hA, lda, dA, ldda );
magma_zgeqrf_gpu( m, n, dA, ldda, tau, dT, &info );
if (info != 0)
printf("magma_zgeqrf_gpu returned error %d: %s.\n",
(int) info, magma_strerror( info ));
gpu_time = magma_wtime();
magma_zungqr_gpu( m, n, k, dA, ldda, tau, dT, nb, &info );
gpu_time = magma_wtime() - gpu_time;
gpu_perf = gflops / gpu_time;
if (info != 0)
printf("magma_zungqr_gpu returned error %d: %s.\n",
(int) info, magma_strerror( info ));
// Get dA back to the CPU to compare with the CPU result.
magma_zgetmatrix( m, n, dA, ldda, hR, lda );
/* =====================================================================
Performs operation using LAPACK
=================================================================== */
if ( opts.lapack ) {
error = lapackf77_zlange("f", &m, &n, hA, &lda, work );
lapackf77_zgeqrf( &m, &n, hA, &lda, tau, h_work, &lwork, &info );
if (info != 0)
printf("lapackf77_zgeqrf returned error %d: %s.\n",
(int) info, magma_strerror( info ));
cpu_time = magma_wtime();
lapackf77_zungqr( &m, &n, &k, hA, &lda, tau, h_work, &lwork, &info );
cpu_time = magma_wtime() - cpu_time;
cpu_perf = gflops / cpu_time;
if (info != 0)
printf("lapackf77_zungqr returned error %d: %s.\n",
(int) info, magma_strerror( info ));
// compute relative error |R|/|A| := |Q_magma - Q_lapack|/|A|
blasf77_zaxpy( &n2, &c_neg_one, hA, &ione, hR, &ione );
error = lapackf77_zlange("f", &m, &n, hR, &lda, work) / error;
printf("%5d %5d %5d %7.1f (%7.2f) %7.1f (%7.2f) %8.2e\n",
(int) m, (int) n, (int) k,
cpu_perf, cpu_time, gpu_perf, gpu_time, error );
}
else {
printf("%5d %5d %5d --- ( --- ) %7.1f (%7.2f) --- \n",
(int) m, (int) n, (int) k,
gpu_perf, gpu_time );
}
TESTING_FREE_PIN( hA );
TESTING_FREE_PIN( h_work );
TESTING_FREE_CPU( hR );
TESTING_FREE_CPU( tau );
TESTING_FREE_DEV( dA );
TESTING_FREE_DEV( dT );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
TESTING_FINALIZE();
return 0;
}
/**
Purpose
-------
ZGEGQR orthogonalizes the N vectors given by a complex M-by-N matrix A:
A = Q * R.
On exit, if successful, the orthogonal vectors Q overwrite A
and R is given in work (on the CPU memory).
The routine is designed for tall-and-skinny matrices: M >> N, N <= 128.
This version uses normal equations and SVD in an iterative process that
makes the computation numerically accurate.
Arguments
---------
@param[in]
ikind INTEGER
Several versions are implemented indiceted by the ikind value:
1: This version uses normal equations and SVD in an iterative process
that makes the computation numerically accurate.
2: This version uses a standard LAPACK-based orthogonalization through
MAGMA's QR panel factorization (magma_zgeqr2x3_gpu) and magma_zungqr
3: Modified Gram-Schmidt (MGS)
4. Cholesky QR [ Note: this method uses the normal equations which
squares the condition number of A, therefore
||I - Q'Q|| < O(eps cond(A)^2) ]
@param[in]
m INTEGER
The number of rows of the matrix A. m >= n >= 0.
@param[in]
n INTEGER
The number of columns of the matrix A. 128 >= n >= 0.
@param[in,out]
dA COMPLEX_16 array on the GPU, dimension (ldda,n)
On entry, the m-by-n matrix A.
On exit, the m-by-n matrix Q with orthogonal columns.
@param[in]
ldda INTEGER
The leading dimension of the array dA. LDDA >= max(1,m).
To benefit from coalescent memory accesses LDDA must be
divisible by 16.
@param
dwork (GPU workspace) COMPLEX_16 array, dimension:
n^2 for ikind = 1
3 n^2 + min(m, n) + 2 for ikind = 2
0 (not used) for ikind = 3
n^2 for ikind = 4
@param[out]
work (CPU workspace) COMPLEX_16 array, dimension 3 n^2.
On exit, work(1:n^2) holds the rectangular matrix R.
Preferably, for higher performance, work should be in pinned memory.
@param[out]
info INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
- > 0: for ikind = 4, the normal equations were not
positive definite, so the factorization could not be
completed, and the solution has not been computed.
@ingroup magma_zgeqrf_comp
********************************************************************/
extern "C" magma_int_t
magma_zgegqr_gpu(
magma_int_t ikind, magma_int_t m, magma_int_t n,
magmaDoubleComplex_ptr dA, magma_int_t ldda,
magmaDoubleComplex_ptr dwork, magmaDoubleComplex *work,
magma_int_t *info )
{
#define work(i_,j_) (work + (i_) + (j_)*n)
#define dA(i_,j_) (dA + (i_) + (j_)*ldda)
magma_int_t i = 0, j, k, n2 = n*n;
magma_int_t ione = 1;
magmaDoubleComplex c_zero = MAGMA_Z_ZERO;
magmaDoubleComplex c_one = MAGMA_Z_ONE;
double cn = 200., mins, maxs;
/* check arguments */
*info = 0;
if (ikind < 1 || ikind > 4) {
*info = -1;
} else if (m < 0 || m < n) {
*info = -2;
} else if (n < 0 || n > 128) {
*info = -3;
} else if (ldda < max(1,m)) {
*info = -5;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
magma_queue_t queue;
magma_device_t cdev;
magma_getdevice( &cdev );
magma_queue_create( cdev, &queue );
if (ikind == 1) {
// === Iterative, based on SVD ============================================================
magmaDoubleComplex *U, *VT, *vt, *R, *G, *hwork, *tau;
double *S;
R = work; // Size n * n
G = R + n*n; // Size n * n
VT = G + n*n; // Size n * n
magma_zmalloc_cpu( &hwork, 32 + 2*n*n + 2*n );
if ( hwork == NULL ) {
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
magma_int_t lwork=n*n+32; // First part f hwork; used as workspace in svd
U = hwork + n*n + 32; // Size n*n
S = (double*)(U + n*n); // Size n
tau = U + n*n + n; // Size n
#ifdef COMPLEX
double *rwork;
magma_dmalloc_cpu( &rwork, 5*n );
if ( rwork == NULL ) {
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
#endif
do {
i++;
magma_zgemm( MagmaConjTrans, MagmaNoTrans, n, n, m, c_one,
dA, ldda, dA, ldda, c_zero, dwork, n, queue );
magma_zgetmatrix( n, n, dwork, n, G, n, queue );
lapackf77_zgesvd( "n", "a", &n, &n, G, &n, S, U, &n, VT, &n,
hwork, &lwork,
#ifdef COMPLEX
rwork,
#endif
info );
mins = 100.f, maxs = 0.f;
for (k=0; k < n; k++) {
S[k] = magma_dsqrt( S[k] );
if (S[k] < mins) mins = S[k];
if (S[k] > maxs) maxs = S[k];
}
for (k=0; k < n; k++) {
vt = VT + k*n;
for (j=0; j < n; j++)
vt[j] *= S[j];
}
lapackf77_zgeqrf( &n, &n, VT, &n, tau, hwork, &lwork, info );
if (i == 1)
blasf77_zcopy( &n2, VT, &ione, R, &ione );
else
blasf77_ztrmm( "l", "u", "n", "n", &n, &n, &c_one, VT, &n, R, &n );
magma_zsetmatrix( n, n, VT, n, dwork, n, queue );
magma_ztrsm( MagmaRight, MagmaUpper, MagmaNoTrans, MagmaNonUnit,
m, n, c_one, dwork, n, dA, ldda, queue );
if (mins > 0.00001f)
cn = maxs/mins;
//fprintf( stderr, "Iteration %d, cond num = %f \n", i, cn );
} while (cn > 10.f);
magma_free_cpu( hwork );
#ifdef COMPLEX
magma_free_cpu( rwork );
#endif
// ================== end of ikind == 1 ===================================================
}
else if (ikind == 2) {
// ================== LAPACK based ===================================================
magma_int_t min_mn = min(m, n);
magma_int_t nb = n;
magmaDoubleComplex_ptr dtau = dwork + 2*n*n;
magmaDoubleComplex_ptr d_T = dwork;
magmaDoubleComplex_ptr ddA = dwork + n*n;
magmaDoubleComplex *tau = work+n*n;
magmablas_zlaset( MagmaFull, n, n, c_zero, c_zero, d_T, n, queue );
magma_zgeqr2x3_gpu( m, n, dA, ldda, dtau, d_T, ddA,
(double*)(dwork+min_mn+2*n*n), info );
magma_zgetmatrix( min_mn, 1, dtau, min_mn, tau, min_mn, queue );
magma_zgetmatrix( n, n, ddA, n, work, n, queue );
magma_zungqr_gpu( m, n, n, dA, ldda, tau, d_T, nb, info );
// ================== end of ikind == 2 ===================================================
}
else if (ikind == 3) {
// ================== MGS ===================================================
for (j = 0; j < n; j++) {
for (i = 0; i < j; i++) {
*work(i, j) = magma_zdotc( m, dA(0,i), 1, dA(0,j), 1, queue );
magma_zaxpy( m, -(*work(i,j)), dA(0,i), 1, dA(0,j), 1, queue );
}
for (i = j; i < n; i++) {
*work(i, j) = MAGMA_Z_ZERO;
}
//*work(j,j) = MAGMA_Z_MAKE( magma_dznrm2( m, dA(0,j), 1), 0., queue );
*work(j,j) = magma_zdotc( m, dA(0,j), 1, dA(0,j), 1, queue );
*work(j,j) = MAGMA_Z_MAKE( sqrt(MAGMA_Z_REAL( *work(j,j) )), 0. );
magma_zscal( m, 1./ *work(j,j), dA(0,j), 1, queue );
}
// ================== end of ikind == 3 ===================================================
}
else if (ikind == 4) {
// ================== Cholesky QR ===================================================
magma_zgemm( MagmaConjTrans, MagmaNoTrans, n, n, m, c_one,
dA, ldda, dA, ldda, c_zero, dwork, n, queue );
magma_zgetmatrix( n, n, dwork, n, work, n, queue );
lapackf77_zpotrf( "u", &n, work, &n, info );
magma_zsetmatrix( n, n, work, n, dwork, n, queue );
magma_ztrsm( MagmaRight, MagmaUpper, MagmaNoTrans, MagmaNonUnit,
m, n, c_one, dwork, n, dA, ldda, queue );
// ================== end of ikind == 4 ===================================================
}
magma_queue_destroy( queue );
return *info;
} /* magma_zgegqr_gpu */
