1*> \brief \b DLQT02 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 DLQT02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, 12* RWORK, RESULT ) 13* 14* .. Scalar Arguments .. 15* INTEGER K, LDA, LWORK, M, N 16* .. 17* .. Array Arguments .. 18* DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), L( LDA, * ), 19* $ Q( LDA, * ), RESULT( * ), RWORK( * ), TAU( * ), 20* $ WORK( LWORK ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> DLQT02 tests DORGLQ, which generates an m-by-n matrix Q with 30*> orthonornmal rows that is defined as the product of k elementary 31*> reflectors. 32*> 33*> Given the LQ factorization of an m-by-n matrix A, DLQT02 generates 34*> the orthogonal matrix Q defined by the factorization of the first k 35*> rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and 36*> checks that the rows 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*> N >= M >= 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. M >= K >= 0. 60*> \endverbatim 61*> 62*> \param[in] A 63*> \verbatim 64*> A is DOUBLE PRECISION array, dimension (LDA,N) 65*> The m-by-n matrix A which was factorized by DLQT01. 66*> \endverbatim 67*> 68*> \param[in] AF 69*> \verbatim 70*> AF is DOUBLE PRECISION array, dimension (LDA,N) 71*> Details of the LQ factorization of A, as returned by DGELQF. 72*> See DGELQF for further details. 73*> \endverbatim 74*> 75*> \param[out] Q 76*> \verbatim 77*> Q is DOUBLE PRECISION array, dimension (LDA,N) 78*> \endverbatim 79*> 80*> \param[out] L 81*> \verbatim 82*> L is DOUBLE PRECISION array, dimension (LDA,M) 83*> \endverbatim 84*> 85*> \param[in] LDA 86*> \verbatim 87*> LDA is INTEGER 88*> The leading dimension of the arrays A, AF, Q and L. LDA >= N. 89*> \endverbatim 90*> 91*> \param[in] TAU 92*> \verbatim 93*> TAU is DOUBLE PRECISION array, dimension (M) 94*> The scalar factors of the elementary reflectors corresponding 95*> to the LQ factorization in AF. 96*> \endverbatim 97*> 98*> \param[out] WORK 99*> \verbatim 100*> WORK is DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (M) 112*> \endverbatim 113*> 114*> \param[out] RESULT 115*> \verbatim 116*> RESULT is DOUBLE PRECISION array, dimension (2) 117*> The test ratios: 118*> RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) 119*> RESULT(2) = norm( I - Q*Q' ) / ( N * 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 double_lin 133* 134* ===================================================================== 135 SUBROUTINE DLQT02( M, N, K, A, AF, Q, L, 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 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), L( LDA, * ), 148 $ Q( LDA, * ), RESULT( * ), RWORK( * ), TAU( * ), 149 $ WORK( LWORK ) 150* .. 151* 152* ===================================================================== 153* 154* .. Parameters .. 155 DOUBLE PRECISION ZERO, ONE 156 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 157 DOUBLE PRECISION ROGUE 158 PARAMETER ( ROGUE = -1.0D+10 ) 159* .. 160* .. Local Scalars .. 161 INTEGER INFO 162 DOUBLE PRECISION ANORM, EPS, RESID 163* .. 164* .. External Functions .. 165 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY 166 EXTERNAL DLAMCH, DLANGE, DLANSY 167* .. 168* .. External Subroutines .. 169 EXTERNAL DGEMM, DLACPY, DLASET, DORGLQ, DSYRK 170* .. 171* .. Intrinsic Functions .. 172 INTRINSIC DBLE, MAX 173* .. 174* .. Scalars in Common .. 175 CHARACTER*32 SRNAMT 176* .. 177* .. Common blocks .. 178 COMMON / SRNAMC / SRNAMT 179* .. 180* .. Executable Statements .. 181* 182 EPS = DLAMCH( 'Epsilon' ) 183* 184* Copy the first k rows of the factorization to the array Q 185* 186 CALL DLASET( 'Full', M, N, ROGUE, ROGUE, Q, LDA ) 187 CALL DLACPY( 'Upper', K, N-1, AF( 1, 2 ), LDA, Q( 1, 2 ), LDA ) 188* 189* Generate the first n columns of the matrix Q 190* 191 SRNAMT = 'DORGLQ' 192 CALL DORGLQ( M, N, K, Q, LDA, TAU, WORK, LWORK, INFO ) 193* 194* Copy L(1:k,1:m) 195* 196 CALL DLASET( 'Full', K, M, ZERO, ZERO, L, LDA ) 197 CALL DLACPY( 'Lower', K, M, AF, LDA, L, LDA ) 198* 199* Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' 200* 201 CALL DGEMM( 'No transpose', 'Transpose', K, M, N, -ONE, A, LDA, Q, 202 $ LDA, ONE, L, LDA ) 203* 204* Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . 205* 206 ANORM = DLANGE( '1', K, N, A, LDA, RWORK ) 207 RESID = DLANGE( '1', K, M, L, LDA, RWORK ) 208 IF( ANORM.GT.ZERO ) THEN 209 RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, N ) ) ) / ANORM ) / EPS 210 ELSE 211 RESULT( 1 ) = ZERO 212 END IF 213* 214* Compute I - Q*Q' 215* 216 CALL DLASET( 'Full', M, M, ZERO, ONE, L, LDA ) 217 CALL DSYRK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, 218 $ LDA ) 219* 220* Compute norm( I - Q*Q' ) / ( N * EPS ) . 221* 222 RESID = DLANSY( '1', 'Upper', M, L, LDA, RWORK ) 223* 224 RESULT( 2 ) = ( RESID / DBLE( MAX( 1, N ) ) ) / EPS 225* 226 RETURN 227* 228* End of DLQT02 229* 230 END 231