1*> \brief \b SQRT02 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 SQRT02( 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 A( LDA, * ), AF( LDA, * ), Q( LDA, * ), 19* $ R( LDA, * ), RESULT( * ), RWORK( * ), TAU( * ), 20* $ WORK( LWORK ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> SQRT02 tests SORGQR, 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, SQRT02 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 REAL array, dimension (LDA,N) 65*> The m-by-n matrix A which was factorized by SQRT01. 66*> \endverbatim 67*> 68*> \param[in] AF 69*> \verbatim 70*> AF is REAL array, dimension (LDA,N) 71*> Details of the QR factorization of A, as returned by SGEQRF. 72*> See SGEQRF for further details. 73*> \endverbatim 74*> 75*> \param[out] Q 76*> \verbatim 77*> Q is REAL array, dimension (LDA,N) 78*> \endverbatim 79*> 80*> \param[out] R 81*> \verbatim 82*> R is REAL 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 REAL 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 REAL 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*> \date November 2011 131* 132*> \ingroup single_lin 133* 134* ===================================================================== 135 SUBROUTINE SQRT02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, 136 $ RWORK, RESULT ) 137* 138* -- LAPACK test routine (version 3.4.0) -- 139* -- LAPACK is a software package provided by Univ. of Tennessee, -- 140* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 141* November 2011 142* 143* .. Scalar Arguments .. 144 INTEGER K, LDA, LWORK, M, N 145* .. 146* .. Array Arguments .. 147 REAL A( LDA, * ), AF( LDA, * ), Q( LDA, * ), 148 $ R( LDA, * ), RESULT( * ), RWORK( * ), TAU( * ), 149 $ WORK( LWORK ) 150* .. 151* 152* ===================================================================== 153* 154* .. Parameters .. 155 REAL ZERO, ONE 156 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 157 REAL ROGUE 158 PARAMETER ( ROGUE = -1.0E+10 ) 159* .. 160* .. Local Scalars .. 161 INTEGER INFO 162 REAL ANORM, EPS, RESID 163* .. 164* .. External Functions .. 165 REAL SLAMCH, SLANGE, SLANSY 166 EXTERNAL SLAMCH, SLANGE, SLANSY 167* .. 168* .. External Subroutines .. 169 EXTERNAL SGEMM, SLACPY, SLASET, SORGQR, SSYRK 170* .. 171* .. Intrinsic Functions .. 172 INTRINSIC MAX, REAL 173* .. 174* .. Scalars in Common .. 175 CHARACTER*32 SRNAMT 176* .. 177* .. Common blocks .. 178 COMMON / SRNAMC / SRNAMT 179* .. 180* .. Executable Statements .. 181* 182 EPS = SLAMCH( 'Epsilon' ) 183* 184* Copy the first k columns of the factorization to the array Q 185* 186 CALL SLASET( 'Full', M, N, ROGUE, ROGUE, Q, LDA ) 187 CALL SLACPY( 'Lower', M-1, K, AF( 2, 1 ), LDA, Q( 2, 1 ), LDA ) 188* 189* Generate the first n columns of the matrix Q 190* 191 SRNAMT = 'SORGQR' 192 CALL SORGQR( M, N, K, Q, LDA, TAU, WORK, LWORK, INFO ) 193* 194* Copy R(1:n,1:k) 195* 196 CALL SLASET( 'Full', N, K, ZERO, ZERO, R, LDA ) 197 CALL SLACPY( 'Upper', N, K, AF, LDA, R, LDA ) 198* 199* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) 200* 201 CALL SGEMM( 'Transpose', 'No transpose', N, K, M, -ONE, Q, LDA, A, 202 $ LDA, ONE, R, LDA ) 203* 204* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . 205* 206 ANORM = SLANGE( '1', M, K, A, LDA, RWORK ) 207 RESID = SLANGE( '1', N, K, R, LDA, RWORK ) 208 IF( ANORM.GT.ZERO ) THEN 209 RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS 210 ELSE 211 RESULT( 1 ) = ZERO 212 END IF 213* 214* Compute I - Q'*Q 215* 216 CALL SLASET( 'Full', N, N, ZERO, ONE, R, LDA ) 217 CALL SSYRK( 'Upper', 'Transpose', N, M, -ONE, Q, LDA, ONE, R, 218 $ LDA ) 219* 220* Compute norm( I - Q'*Q ) / ( M * EPS ) . 221* 222 RESID = SLANSY( '1', 'Upper', N, R, LDA, RWORK ) 223* 224 RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS 225* 226 RETURN 227* 228* End of SQRT02 229* 230 END 231