![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGEMQRT 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGEMQRT + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemqrt.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemqrt.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemqrt.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 00022 * C, LDC, WORK, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER SIDE, TRANS 00026 * INTEGER INFO, K, LDV, LDC, M, N, NB, LDT 00027 * .. 00028 * .. Array Arguments .. 00029 * COMPLEX*16 V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> ZGEMQRT overwrites the general complex M-by-N matrix C with 00039 *> 00040 *> SIDE = 'L' SIDE = 'R' 00041 *> TRANS = 'N': Q C C Q 00042 *> TRANS = 'C': Q**H C C Q**H 00043 *> 00044 *> where Q is a complex orthogonal matrix defined as the product of K 00045 *> elementary reflectors: 00046 *> 00047 *> Q = H(1) H(2) . . . H(K) = I - V T V**H 00048 *> 00049 *> generated using the compact WY representation as returned by ZGEQRT. 00050 *> 00051 *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. 00052 *> \endverbatim 00053 * 00054 * Arguments: 00055 * ========== 00056 * 00057 *> \param[in] SIDE 00058 *> \verbatim 00059 *> SIDE is CHARACTER*1 00060 *> = 'L': apply Q or Q**H from the Left; 00061 *> = 'R': apply Q or Q**H from the Right. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] TRANS 00065 *> \verbatim 00066 *> TRANS is CHARACTER*1 00067 *> = 'N': No transpose, apply Q; 00068 *> = 'C': Transpose, apply Q**H. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] M 00072 *> \verbatim 00073 *> M is INTEGER 00074 *> The number of rows of the matrix C. M >= 0. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] N 00078 *> \verbatim 00079 *> N is INTEGER 00080 *> The number of columns of the matrix C. N >= 0. 00081 *> \endverbatim 00082 *> 00083 *> \param[in] K 00084 *> \verbatim 00085 *> K is INTEGER 00086 *> The number of elementary reflectors whose product defines 00087 *> the matrix Q. 00088 *> If SIDE = 'L', M >= K >= 0; 00089 *> if SIDE = 'R', N >= K >= 0. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] NB 00093 *> \verbatim 00094 *> NB is INTEGER 00095 *> The block size used for the storage of T. K >= NB >= 1. 00096 *> This must be the same value of NB used to generate T 00097 *> in CGEQRT. 00098 *> \endverbatim 00099 *> 00100 *> \param[in] V 00101 *> \verbatim 00102 *> V is COMPLEX*16 array, dimension (LDV,K) 00103 *> The i-th column must contain the vector which defines the 00104 *> elementary reflector H(i), for i = 1,2,...,k, as returned by 00105 *> CGEQRT in the first K columns of its array argument A. 00106 *> \endverbatim 00107 *> 00108 *> \param[in] LDV 00109 *> \verbatim 00110 *> LDV is INTEGER 00111 *> The leading dimension of the array V. 00112 *> If SIDE = 'L', LDA >= max(1,M); 00113 *> if SIDE = 'R', LDA >= max(1,N). 00114 *> \endverbatim 00115 *> 00116 *> \param[in] T 00117 *> \verbatim 00118 *> T is COMPLEX*16 array, dimension (LDT,K) 00119 *> The upper triangular factors of the block reflectors 00120 *> as returned by CGEQRT, stored as a NB-by-N matrix. 00121 *> \endverbatim 00122 *> 00123 *> \param[in] LDT 00124 *> \verbatim 00125 *> LDT is INTEGER 00126 *> The leading dimension of the array T. LDT >= NB. 00127 *> \endverbatim 00128 *> 00129 *> \param[in,out] C 00130 *> \verbatim 00131 *> C is COMPLEX*16 array, dimension (LDC,N) 00132 *> On entry, the M-by-N matrix C. 00133 *> On exit, C is overwritten by Q C, Q**H C, C Q**H or C Q. 00134 *> \endverbatim 00135 *> 00136 *> \param[in] LDC 00137 *> \verbatim 00138 *> LDC is INTEGER 00139 *> The leading dimension of the array C. LDC >= max(1,M). 00140 *> \endverbatim 00141 *> 00142 *> \param[out] WORK 00143 *> \verbatim 00144 *> WORK is COMPLEX*16 array. The dimension of WORK is 00145 *> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'. 00146 *> \endverbatim 00147 *> 00148 *> \param[out] INFO 00149 *> \verbatim 00150 *> INFO is INTEGER 00151 *> = 0: successful exit 00152 *> < 0: if INFO = -i, the i-th argument had an illegal value 00153 *> \endverbatim 00154 * 00155 * Authors: 00156 * ======== 00157 * 00158 *> \author Univ. of Tennessee 00159 *> \author Univ. of California Berkeley 00160 *> \author Univ. of Colorado Denver 00161 *> \author NAG Ltd. 00162 * 00163 *> \date November 2011 00164 * 00165 *> \ingroup complex16GEcomputational 00166 * 00167 * ===================================================================== 00168 SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 00169 $ C, LDC, WORK, INFO ) 00170 * 00171 * -- LAPACK computational routine (version 3.4.0) -- 00172 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00174 * November 2011 00175 * 00176 * .. Scalar Arguments .. 00177 CHARACTER SIDE, TRANS 00178 INTEGER INFO, K, LDV, LDC, M, N, NB, LDT 00179 * .. 00180 * .. Array Arguments .. 00181 COMPLEX*16 V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) 00182 * .. 00183 * 00184 * ===================================================================== 00185 * 00186 * .. 00187 * .. Local Scalars .. 00188 LOGICAL LEFT, RIGHT, TRAN, NOTRAN 00189 INTEGER I, IB, LDWORK, KF, Q 00190 * .. 00191 * .. External Functions .. 00192 LOGICAL LSAME 00193 EXTERNAL LSAME 00194 * .. 00195 * .. External Subroutines .. 00196 EXTERNAL XERBLA, ZLARFB 00197 * .. 00198 * .. Intrinsic Functions .. 00199 INTRINSIC MAX, MIN 00200 * .. 00201 * .. Executable Statements .. 00202 * 00203 * .. Test the input arguments .. 00204 * 00205 INFO = 0 00206 LEFT = LSAME( SIDE, 'L' ) 00207 RIGHT = LSAME( SIDE, 'R' ) 00208 TRAN = LSAME( TRANS, 'C' ) 00209 NOTRAN = LSAME( TRANS, 'N' ) 00210 * 00211 IF( LEFT ) THEN 00212 LDWORK = MAX( 1, N ) 00213 Q = M 00214 ELSE IF ( RIGHT ) THEN 00215 LDWORK = MAX( 1, M ) 00216 Q = N 00217 END IF 00218 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN 00219 INFO = -1 00220 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN 00221 INFO = -2 00222 ELSE IF( M.LT.0 ) THEN 00223 INFO = -3 00224 ELSE IF( N.LT.0 ) THEN 00225 INFO = -4 00226 ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN 00227 INFO = -5 00228 ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN 00229 INFO = -6 00230 ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN 00231 INFO = -8 00232 ELSE IF( LDT.LT.NB ) THEN 00233 INFO = -10 00234 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 00235 INFO = -12 00236 END IF 00237 * 00238 IF( INFO.NE.0 ) THEN 00239 CALL XERBLA( 'ZGEMQRT', -INFO ) 00240 RETURN 00241 END IF 00242 * 00243 * .. Quick return if possible .. 00244 * 00245 IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN 00246 * 00247 IF( LEFT .AND. TRAN ) THEN 00248 * 00249 DO I = 1, K, NB 00250 IB = MIN( NB, K-I+1 ) 00251 CALL ZLARFB( 'L', 'C', 'F', 'C', M-I+1, N, IB, 00252 $ V( I, I ), LDV, T( 1, I ), LDT, 00253 $ C( I, 1 ), LDC, WORK, LDWORK ) 00254 END DO 00255 * 00256 ELSE IF( RIGHT .AND. NOTRAN ) THEN 00257 * 00258 DO I = 1, K, NB 00259 IB = MIN( NB, K-I+1 ) 00260 CALL ZLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB, 00261 $ V( I, I ), LDV, T( 1, I ), LDT, 00262 $ C( 1, I ), LDC, WORK, LDWORK ) 00263 END DO 00264 * 00265 ELSE IF( LEFT .AND. NOTRAN ) THEN 00266 * 00267 KF = ((K-1)/NB)*NB+1 00268 DO I = KF, 1, -NB 00269 IB = MIN( NB, K-I+1 ) 00270 CALL ZLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB, 00271 $ V( I, I ), LDV, T( 1, I ), LDT, 00272 $ C( I, 1 ), LDC, WORK, LDWORK ) 00273 END DO 00274 * 00275 ELSE IF( RIGHT .AND. TRAN ) THEN 00276 * 00277 KF = ((K-1)/NB)*NB+1 00278 DO I = KF, 1, -NB 00279 IB = MIN( NB, K-I+1 ) 00280 CALL ZLARFB( 'R', 'C', 'F', 'C', M, N-I+1, IB, 00281 $ V( I, I ), LDV, T( 1, I ), LDT, 00282 $ C( 1, I ), LDC, WORK, LDWORK ) 00283 END DO 00284 * 00285 END IF 00286 * 00287 RETURN 00288 * 00289 * End of ZGEMQRT 00290 * 00291 END