00001 SUBROUTINE CLQT02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, 00002 $ RWORK, RESULT ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER K, LDA, LWORK, M, N 00010 * .. 00011 * .. Array Arguments .. 00012 REAL RESULT( * ), RWORK( * ) 00013 COMPLEX A( LDA, * ), AF( LDA, * ), L( LDA, * ), 00014 $ Q( LDA, * ), TAU( * ), WORK( LWORK ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CLQT02 tests CUNGLQ, which generates an m-by-n matrix Q with 00021 * orthonornmal rows that is defined as the product of k elementary 00022 * reflectors. 00023 * 00024 * Given the LQ factorization of an m-by-n matrix A, CLQT02 generates 00025 * the orthogonal matrix Q defined by the factorization of the first k 00026 * rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and 00027 * checks that the rows of Q are orthonormal. 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * M (input) INTEGER 00033 * The number of rows of the matrix Q to be generated. M >= 0. 00034 * 00035 * N (input) INTEGER 00036 * The number of columns of the matrix Q to be generated. 00037 * N >= M >= 0. 00038 * 00039 * K (input) INTEGER 00040 * The number of elementary reflectors whose product defines the 00041 * matrix Q. M >= K >= 0. 00042 * 00043 * A (input) COMPLEX array, dimension (LDA,N) 00044 * The m-by-n matrix A which was factorized by CLQT01. 00045 * 00046 * AF (input) COMPLEX array, dimension (LDA,N) 00047 * Details of the LQ factorization of A, as returned by CGELQF. 00048 * See CGELQF for further details. 00049 * 00050 * Q (workspace) COMPLEX array, dimension (LDA,N) 00051 * 00052 * L (workspace) COMPLEX array, dimension (LDA,M) 00053 * 00054 * LDA (input) INTEGER 00055 * The leading dimension of the arrays A, AF, Q and L. LDA >= N. 00056 * 00057 * TAU (input) COMPLEX array, dimension (M) 00058 * The scalar factors of the elementary reflectors corresponding 00059 * to the LQ factorization in AF. 00060 * 00061 * WORK (workspace) COMPLEX array, dimension (LWORK) 00062 * 00063 * LWORK (input) INTEGER 00064 * The dimension of the array WORK. 00065 * 00066 * RWORK (workspace) REAL array, dimension (M) 00067 * 00068 * RESULT (output) REAL array, dimension (2) 00069 * The test ratios: 00070 * RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) 00071 * RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) 00072 * 00073 * ===================================================================== 00074 * 00075 * .. Parameters .. 00076 REAL ZERO, ONE 00077 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00078 COMPLEX ROGUE 00079 PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) 00080 * .. 00081 * .. Local Scalars .. 00082 INTEGER INFO 00083 REAL ANORM, EPS, RESID 00084 * .. 00085 * .. External Functions .. 00086 REAL CLANGE, CLANSY, SLAMCH 00087 EXTERNAL CLANGE, CLANSY, SLAMCH 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL CGEMM, CHERK, CLACPY, CLASET, CUNGLQ 00091 * .. 00092 * .. Intrinsic Functions .. 00093 INTRINSIC CMPLX, MAX, REAL 00094 * .. 00095 * .. Scalars in Common .. 00096 CHARACTER*32 SRNAMT 00097 * .. 00098 * .. Common blocks .. 00099 COMMON / SRNAMC / SRNAMT 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 EPS = SLAMCH( 'Epsilon' ) 00104 * 00105 * Copy the first k rows of the factorization to the array Q 00106 * 00107 CALL CLASET( 'Full', M, N, ROGUE, ROGUE, Q, LDA ) 00108 CALL CLACPY( 'Upper', K, N-1, AF( 1, 2 ), LDA, Q( 1, 2 ), LDA ) 00109 * 00110 * Generate the first n columns of the matrix Q 00111 * 00112 SRNAMT = 'CUNGLQ' 00113 CALL CUNGLQ( M, N, K, Q, LDA, TAU, WORK, LWORK, INFO ) 00114 * 00115 * Copy L(1:k,1:m) 00116 * 00117 CALL CLASET( 'Full', K, M, CMPLX( ZERO ), CMPLX( ZERO ), L, LDA ) 00118 CALL CLACPY( 'Lower', K, M, AF, LDA, L, LDA ) 00119 * 00120 * Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' 00121 * 00122 CALL CGEMM( 'No transpose', 'Conjugate transpose', K, M, N, 00123 $ CMPLX( -ONE ), A, LDA, Q, LDA, CMPLX( ONE ), L, LDA ) 00124 * 00125 * Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . 00126 * 00127 ANORM = CLANGE( '1', K, N, A, LDA, RWORK ) 00128 RESID = CLANGE( '1', K, M, L, LDA, RWORK ) 00129 IF( ANORM.GT.ZERO ) THEN 00130 RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, N ) ) ) / ANORM ) / EPS 00131 ELSE 00132 RESULT( 1 ) = ZERO 00133 END IF 00134 * 00135 * Compute I - Q*Q' 00136 * 00137 CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), L, LDA ) 00138 CALL CHERK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, 00139 $ LDA ) 00140 * 00141 * Compute norm( I - Q*Q' ) / ( N * EPS ) . 00142 * 00143 RESID = CLANSY( '1', 'Upper', M, L, LDA, RWORK ) 00144 * 00145 RESULT( 2 ) = ( RESID / REAL( MAX( 1, N ) ) ) / EPS 00146 * 00147 RETURN 00148 * 00149 * End of CLQT02 00150 * 00151 END
1.7.2