1*> \brief \b CQRT02 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CQRT02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, 12* RWORK, RESULT ) 13* 14* .. Scalar Arguments .. 15* INTEGER K, LDA, LWORK, M, N 16* .. 17* .. Array Arguments .. 18* REAL RESULT( * ), RWORK( * ) 19* COMPLEX A( LDA, * ), AF( LDA, * ), Q( LDA, * ), 20* $ R( LDA, * ), TAU( * ), WORK( LWORK ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> CQRT02 tests CUNGQR, which generates an m-by-n matrix Q with 30*> orthonornmal columns that is defined as the product of k elementary 31*> reflectors. 32*> 33*> Given the QR factorization of an m-by-n matrix A, CQRT02 generates 34*> the orthogonal matrix Q defined by the factorization of the first k 35*> columns of A; it compares R(1:n,1:k) with Q(1:m,1:n)'*A(1:m,1:k), 36*> and checks that the columns of Q are orthonormal. 37*> \endverbatim 38* 39* Arguments: 40* ========== 41* 42*> \param[in] M 43*> \verbatim 44*> M is INTEGER 45*> The number of rows of the matrix Q to be generated. M >= 0. 46*> \endverbatim 47*> 48*> \param[in] N 49*> \verbatim 50*> N is INTEGER 51*> The number of columns of the matrix Q to be generated. 52*> M >= N >= 0. 53*> \endverbatim 54*> 55*> \param[in] K 56*> \verbatim 57*> K is INTEGER 58*> The number of elementary reflectors whose product defines the 59*> matrix Q. N >= K >= 0. 60*> \endverbatim 61*> 62*> \param[in] A 63*> \verbatim 64*> A is COMPLEX array, dimension (LDA,N) 65*> The m-by-n matrix A which was factorized by CQRT01. 66*> \endverbatim 67*> 68*> \param[in] AF 69*> \verbatim 70*> AF is COMPLEX array, dimension (LDA,N) 71*> Details of the QR factorization of A, as returned by CGEQRF. 72*> See CGEQRF for further details. 73*> \endverbatim 74*> 75*> \param[out] Q 76*> \verbatim 77*> Q is COMPLEX array, dimension (LDA,N) 78*> \endverbatim 79*> 80*> \param[out] R 81*> \verbatim 82*> R is COMPLEX array, dimension (LDA,N) 83*> \endverbatim 84*> 85*> \param[in] LDA 86*> \verbatim 87*> LDA is INTEGER 88*> The leading dimension of the arrays A, AF, Q and R. LDA >= M. 89*> \endverbatim 90*> 91*> \param[in] TAU 92*> \verbatim 93*> TAU is COMPLEX array, dimension (N) 94*> The scalar factors of the elementary reflectors corresponding 95*> to the QR factorization in AF. 96*> \endverbatim 97*> 98*> \param[out] WORK 99*> \verbatim 100*> WORK is COMPLEX array, dimension (LWORK) 101*> \endverbatim 102*> 103*> \param[in] LWORK 104*> \verbatim 105*> LWORK is INTEGER 106*> The dimension of the array WORK. 107*> \endverbatim 108*> 109*> \param[out] RWORK 110*> \verbatim 111*> RWORK is REAL array, dimension (M) 112*> \endverbatim 113*> 114*> \param[out] RESULT 115*> \verbatim 116*> RESULT is REAL array, dimension (2) 117*> The test ratios: 118*> RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) 119*> RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) 120*> \endverbatim 121* 122* Authors: 123* ======== 124* 125*> \author Univ. of Tennessee 126*> \author Univ. of California Berkeley 127*> \author Univ. of Colorado Denver 128*> \author NAG Ltd. 129* 130*> \ingroup complex_lin 131* 132* ===================================================================== 133 SUBROUTINE CQRT02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, 134 $ RWORK, RESULT ) 135* 136* -- LAPACK test routine -- 137* -- LAPACK is a software package provided by Univ. of Tennessee, -- 138* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 139* 140* .. Scalar Arguments .. 141 INTEGER K, LDA, LWORK, M, N 142* .. 143* .. Array Arguments .. 144 REAL RESULT( * ), RWORK( * ) 145 COMPLEX A( LDA, * ), AF( LDA, * ), Q( LDA, * ), 146 $ R( LDA, * ), TAU( * ), WORK( LWORK ) 147* .. 148* 149* ===================================================================== 150* 151* .. Parameters .. 152 REAL ZERO, ONE 153 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 154 COMPLEX ROGUE 155 PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) 156* .. 157* .. Local Scalars .. 158 INTEGER INFO 159 REAL ANORM, EPS, RESID 160* .. 161* .. External Functions .. 162 REAL CLANGE, CLANSY, SLAMCH 163 EXTERNAL CLANGE, CLANSY, SLAMCH 164* .. 165* .. External Subroutines .. 166 EXTERNAL CGEMM, CHERK, CLACPY, CLASET, CUNGQR 167* .. 168* .. Intrinsic Functions .. 169 INTRINSIC CMPLX, MAX, REAL 170* .. 171* .. Scalars in Common .. 172 CHARACTER*32 SRNAMT 173* .. 174* .. Common blocks .. 175 COMMON / SRNAMC / SRNAMT 176* .. 177* .. Executable Statements .. 178* 179 EPS = SLAMCH( 'Epsilon' ) 180* 181* Copy the first k columns of the factorization to the array Q 182* 183 CALL CLASET( 'Full', M, N, ROGUE, ROGUE, Q, LDA ) 184 CALL CLACPY( 'Lower', M-1, K, AF( 2, 1 ), LDA, Q( 2, 1 ), LDA ) 185* 186* Generate the first n columns of the matrix Q 187* 188 SRNAMT = 'CUNGQR' 189 CALL CUNGQR( M, N, K, Q, LDA, TAU, WORK, LWORK, INFO ) 190* 191* Copy R(1:n,1:k) 192* 193 CALL CLASET( 'Full', N, K, CMPLX( ZERO ), CMPLX( ZERO ), R, LDA ) 194 CALL CLACPY( 'Upper', N, K, AF, LDA, R, LDA ) 195* 196* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) 197* 198 CALL CGEMM( 'Conjugate transpose', 'No transpose', N, K, M, 199 $ CMPLX( -ONE ), Q, LDA, A, LDA, CMPLX( ONE ), R, LDA ) 200* 201* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . 202* 203 ANORM = CLANGE( '1', M, K, A, LDA, RWORK ) 204 RESID = CLANGE( '1', N, K, R, LDA, RWORK ) 205 IF( ANORM.GT.ZERO ) THEN 206 RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS 207 ELSE 208 RESULT( 1 ) = ZERO 209 END IF 210* 211* Compute I - Q'*Q 212* 213 CALL CLASET( 'Full', N, N, CMPLX( ZERO ), CMPLX( ONE ), R, LDA ) 214 CALL CHERK( 'Upper', 'Conjugate transpose', N, M, -ONE, Q, LDA, 215 $ ONE, R, LDA ) 216* 217* Compute norm( I - Q'*Q ) / ( M * EPS ) . 218* 219 RESID = CLANSY( '1', 'Upper', N, R, LDA, RWORK ) 220* 221 RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS 222* 223 RETURN 224* 225* End of CQRT02 226* 227 END 228