1*> \brief \b CQRT11 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* REAL FUNCTION CQRT11( M, K, A, LDA, TAU, WORK, LWORK ) 12* 13* .. Scalar Arguments .. 14* INTEGER K, LDA, LWORK, M 15* .. 16* .. Array Arguments .. 17* COMPLEX A( LDA, * ), TAU( * ), WORK( LWORK ) 18* .. 19* 20* 21*> \par Purpose: 22* ============= 23*> 24*> \verbatim 25*> 26*> CQRT11 computes the test ratio 27*> 28*> || Q'*Q - I || / (eps * m) 29*> 30*> where the orthogonal matrix Q is represented as a product of 31*> elementary transformations. Each transformation has the form 32*> 33*> H(k) = I - tau(k) v(k) v(k)' 34*> 35*> where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form 36*> [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored 37*> in A(k+1:m,k). 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] M 44*> \verbatim 45*> M is INTEGER 46*> The number of rows of the matrix A. 47*> \endverbatim 48*> 49*> \param[in] K 50*> \verbatim 51*> K is INTEGER 52*> The number of columns of A whose subdiagonal entries 53*> contain information about orthogonal transformations. 54*> \endverbatim 55*> 56*> \param[in] A 57*> \verbatim 58*> A is COMPLEX array, dimension (LDA,K) 59*> The (possibly partial) output of a QR reduction routine. 60*> \endverbatim 61*> 62*> \param[in] LDA 63*> \verbatim 64*> LDA is INTEGER 65*> The leading dimension of the array A. 66*> \endverbatim 67*> 68*> \param[in] TAU 69*> \verbatim 70*> TAU is COMPLEX array, dimension (K) 71*> The scaling factors tau for the elementary transformations as 72*> computed by the QR factorization routine. 73*> \endverbatim 74*> 75*> \param[out] WORK 76*> \verbatim 77*> WORK is COMPLEX array, dimension (LWORK) 78*> \endverbatim 79*> 80*> \param[in] LWORK 81*> \verbatim 82*> LWORK is INTEGER 83*> The length of the array WORK. LWORK >= M*M + M. 84*> \endverbatim 85* 86* Authors: 87* ======== 88* 89*> \author Univ. of Tennessee 90*> \author Univ. of California Berkeley 91*> \author Univ. of Colorado Denver 92*> \author NAG Ltd. 93* 94*> \ingroup complex_lin 95* 96* ===================================================================== 97 REAL FUNCTION CQRT11( M, K, A, LDA, TAU, WORK, LWORK ) 98* 99* -- LAPACK test routine -- 100* -- LAPACK is a software package provided by Univ. of Tennessee, -- 101* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 102* 103* .. Scalar Arguments .. 104 INTEGER K, LDA, LWORK, M 105* .. 106* .. Array Arguments .. 107 COMPLEX A( LDA, * ), TAU( * ), WORK( LWORK ) 108* .. 109* 110* ===================================================================== 111* 112* .. Parameters .. 113 REAL ZERO, ONE 114 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 115* .. 116* .. Local Scalars .. 117 INTEGER INFO, J 118* .. 119* .. External Functions .. 120 REAL CLANGE, SLAMCH 121 EXTERNAL CLANGE, SLAMCH 122* .. 123* .. External Subroutines .. 124 EXTERNAL CLASET, CUNM2R, XERBLA 125* .. 126* .. Intrinsic Functions .. 127 INTRINSIC CMPLX, REAL 128* .. 129* .. Local Arrays .. 130 REAL RDUMMY( 1 ) 131* .. 132* .. Executable Statements .. 133* 134 CQRT11 = ZERO 135* 136* Test for sufficient workspace 137* 138 IF( LWORK.LT.M*M+M ) THEN 139 CALL XERBLA( 'CQRT11', 7 ) 140 RETURN 141 END IF 142* 143* Quick return if possible 144* 145 IF( M.LE.0 ) 146 $ RETURN 147* 148 CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), WORK, M ) 149* 150* Form Q 151* 152 CALL CUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK, 153 $ M, WORK( M*M+1 ), INFO ) 154* 155* Form Q'*Q 156* 157 CALL CUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU, 158 $ WORK, M, WORK( M*M+1 ), INFO ) 159* 160 DO 10 J = 1, M 161 WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE 162 10 CONTINUE 163* 164 CQRT11 = CLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) / 165 $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) 166* 167 RETURN 168* 169* End of CQRT11 170* 171 END 172