3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE ZQLT03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
14 * .. Scalar Arguments ..
15 * INTEGER K, LDA, LWORK, M, N
17 * .. Array Arguments ..
18 * DOUBLE PRECISION RESULT( * ), RWORK( * )
19 * COMPLEX*16 AF( LDA, * ), C( LDA, * ), CC( LDA, * ),
20 * $ Q( LDA, * ), TAU( * ), WORK( LWORK )
29 *> ZQLT03 tests ZUNMQL, which computes Q*C, Q'*C, C*Q or C*Q'.
31 *> ZQLT03 compares the results of a call to ZUNMQL with the results of
32 *> forming Q explicitly by a call to ZUNGQL and then performing matrix
33 *> multiplication by a call to ZGEMM.
42 *> The order of the orthogonal matrix Q. M >= 0.
48 *> The number of rows or columns of the matrix C; C is m-by-n if
49 *> Q is applied from the left, or n-by-m if Q is applied from
56 *> The number of elementary reflectors whose product defines the
57 *> orthogonal matrix Q. M >= K >= 0.
62 *> AF is COMPLEX*16 array, dimension (LDA,N)
63 *> Details of the QL factorization of an m-by-n matrix, as
64 *> returned by ZGEQLF. See CGEQLF for further details.
69 *> C is COMPLEX*16 array, dimension (LDA,N)
74 *> CC is COMPLEX*16 array, dimension (LDA,N)
79 *> Q is COMPLEX*16 array, dimension (LDA,M)
85 *> The leading dimension of the arrays AF, C, CC, and Q.
90 *> TAU is COMPLEX*16 array, dimension (min(M,N))
91 *> The scalar factors of the elementary reflectors corresponding
92 *> to the QL factorization in AF.
97 *> WORK is COMPLEX*16 array, dimension (LWORK)
103 *> The length of WORK. LWORK must be at least M, and should be
104 *> M*NB, where NB is the blocksize for this environment.
109 *> RWORK is DOUBLE PRECISION array, dimension (M)
112 *> \param[out] RESULT
114 *> RESULT is DOUBLE PRECISION array, dimension (4)
115 *> The test ratios compare two techniques for multiplying a
116 *> random matrix C by an m-by-m orthogonal matrix Q.
117 *> RESULT(1) = norm( Q*C - Q*C ) / ( M * norm(C) * EPS )
118 *> RESULT(2) = norm( C*Q - C*Q ) / ( M * norm(C) * EPS )
119 *> RESULT(3) = norm( Q'*C - Q'*C )/ ( M * norm(C) * EPS )
120 *> RESULT(4) = norm( C*Q' - C*Q' )/ ( M * norm(C) * EPS )
126 *> \author Univ. of Tennessee
127 *> \author Univ. of California Berkeley
128 *> \author Univ. of Colorado Denver
131 *> \date November 2011
133 *> \ingroup complex16_lin
135 * =====================================================================
136 SUBROUTINE ZQLT03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
139 * -- LAPACK test routine (version 3.4.0) --
140 * -- LAPACK is a software package provided by Univ. of Tennessee, --
141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
144 * .. Scalar Arguments ..
145 INTEGER K, LDA, LWORK, M, N
147 * .. Array Arguments ..
148 DOUBLE PRECISION RESULT( * ), RWORK( * )
149 COMPLEX*16 AF( LDA, * ), C( LDA, * ), CC( LDA, * ),
150 $ Q( LDA, * ), TAU( * ), WORK( LWORK )
153 * =====================================================================
156 DOUBLE PRECISION ZERO, ONE
157 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
159 PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) )
161 * .. Local Scalars ..
162 CHARACTER SIDE, TRANS
163 INTEGER INFO, ISIDE, ITRANS, J, MC, MINMN, NC
164 DOUBLE PRECISION CNORM, EPS, RESID
166 * .. External Functions ..
168 DOUBLE PRECISION DLAMCH, ZLANGE
169 EXTERNAL LSAME, DLAMCH, ZLANGE
171 * .. External Subroutines ..
172 EXTERNAL ZGEMM, ZLACPY, ZLARNV, ZLASET, ZUNGQL, ZUNMQL
177 * .. Intrinsic Functions ..
178 INTRINSIC DBLE, DCMPLX, MAX, MIN
180 * .. Scalars in Common ..
183 * .. Common blocks ..
184 COMMON / SRNAMC / SRNAMT
186 * .. Data statements ..
187 DATA ISEED / 1988, 1989, 1990, 1991 /
189 * .. Executable Statements ..
191 EPS = DLAMCH( 'Epsilon' )
194 * Quick return if possible
196 IF( MINMN.EQ.0 ) THEN
204 * Copy the last k columns of the factorization to the array Q
206 CALL ZLASET( 'Full', M, M, ROGUE, ROGUE, Q, LDA )
207 IF( K.GT.0 .AND. M.GT.K )
208 $ CALL ZLACPY( 'Full', M-K, K, AF( 1, N-K+1 ), LDA,
209 $ Q( 1, M-K+1 ), LDA )
211 $ CALL ZLACPY( 'Upper', K-1, K-1, AF( M-K+1, N-K+2 ), LDA,
212 $ Q( M-K+1, M-K+2 ), LDA )
214 * Generate the m-by-m matrix Q
217 CALL ZUNGQL( M, M, K, Q, LDA, TAU( MINMN-K+1 ), WORK, LWORK,
221 IF( ISIDE.EQ.1 ) THEN
231 * Generate MC by NC matrix C
234 CALL ZLARNV( 2, ISEED, MC, C( 1, J ) )
236 CNORM = ZLANGE( '1', MC, NC, C, LDA, RWORK )
241 IF( ITRANS.EQ.1 ) THEN
249 CALL ZLACPY( 'Full', MC, NC, C, LDA, CC, LDA )
255 $ CALL ZUNMQL( SIDE, TRANS, MC, NC, K, AF( 1, N-K+1 ), LDA,
256 $ TAU( MINMN-K+1 ), CC, LDA, WORK, LWORK,
259 * Form explicit product and subtract
261 IF( LSAME( SIDE, 'L' ) ) THEN
262 CALL ZGEMM( TRANS, 'No transpose', MC, NC, MC,
263 $ DCMPLX( -ONE ), Q, LDA, C, LDA,
264 $ DCMPLX( ONE ), CC, LDA )
266 CALL ZGEMM( 'No transpose', TRANS, MC, NC, NC,
267 $ DCMPLX( -ONE ), C, LDA, Q, LDA,
268 $ DCMPLX( ONE ), CC, LDA )
271 * Compute error in the difference
273 RESID = ZLANGE( '1', MC, NC, CC, LDA, RWORK )
274 RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID /
275 $ ( DBLE( MAX( 1, M ) )*CNORM*EPS )