![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZUPMTR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZUPMTR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zupmtr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zupmtr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zupmtr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, 00022 * INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER SIDE, TRANS, UPLO 00026 * INTEGER INFO, LDC, M, N 00027 * .. 00028 * .. Array Arguments .. 00029 * COMPLEX*16 AP( * ), C( LDC, * ), TAU( * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> ZUPMTR 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 unitary matrix of order nq, with nq = m if 00045 *> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of 00046 *> nq-1 elementary reflectors, as returned by ZHPTRD using packed 00047 *> storage: 00048 *> 00049 *> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); 00050 *> 00051 *> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). 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] UPLO 00065 *> \verbatim 00066 *> UPLO is CHARACTER*1 00067 *> = 'U': Upper triangular packed storage used in previous 00068 *> call to ZHPTRD; 00069 *> = 'L': Lower triangular packed storage used in previous 00070 *> call to ZHPTRD. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] TRANS 00074 *> \verbatim 00075 *> TRANS is CHARACTER*1 00076 *> = 'N': No transpose, apply Q; 00077 *> = 'C': Conjugate transpose, apply Q**H. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] M 00081 *> \verbatim 00082 *> M is INTEGER 00083 *> The number of rows of the matrix C. M >= 0. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] N 00087 *> \verbatim 00088 *> N is INTEGER 00089 *> The number of columns of the matrix C. N >= 0. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] AP 00093 *> \verbatim 00094 *> AP is COMPLEX*16 array, dimension 00095 *> (M*(M+1)/2) if SIDE = 'L' 00096 *> (N*(N+1)/2) if SIDE = 'R' 00097 *> The vectors which define the elementary reflectors, as 00098 *> returned by ZHPTRD. AP is modified by the routine but 00099 *> restored on exit. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] TAU 00103 *> \verbatim 00104 *> TAU is COMPLEX*16 array, dimension (M-1) if SIDE = 'L' 00105 *> or (N-1) if SIDE = 'R' 00106 *> TAU(i) must contain the scalar factor of the elementary 00107 *> reflector H(i), as returned by ZHPTRD. 00108 *> \endverbatim 00109 *> 00110 *> \param[in,out] C 00111 *> \verbatim 00112 *> C is COMPLEX*16 array, dimension (LDC,N) 00113 *> On entry, the M-by-N matrix C. 00114 *> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. 00115 *> \endverbatim 00116 *> 00117 *> \param[in] LDC 00118 *> \verbatim 00119 *> LDC is INTEGER 00120 *> The leading dimension of the array C. LDC >= max(1,M). 00121 *> \endverbatim 00122 *> 00123 *> \param[out] WORK 00124 *> \verbatim 00125 *> WORK is COMPLEX*16 array, dimension 00126 *> (N) if SIDE = 'L' 00127 *> (M) if SIDE = 'R' 00128 *> \endverbatim 00129 *> 00130 *> \param[out] INFO 00131 *> \verbatim 00132 *> INFO is INTEGER 00133 *> = 0: successful exit 00134 *> < 0: if INFO = -i, the i-th argument had an illegal value 00135 *> \endverbatim 00136 * 00137 * Authors: 00138 * ======== 00139 * 00140 *> \author Univ. of Tennessee 00141 *> \author Univ. of California Berkeley 00142 *> \author Univ. of Colorado Denver 00143 *> \author NAG Ltd. 00144 * 00145 *> \date November 2011 00146 * 00147 *> \ingroup complex16OTHERcomputational 00148 * 00149 * ===================================================================== 00150 SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, 00151 $ INFO ) 00152 * 00153 * -- LAPACK computational routine (version 3.4.0) -- 00154 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00156 * November 2011 00157 * 00158 * .. Scalar Arguments .. 00159 CHARACTER SIDE, TRANS, UPLO 00160 INTEGER INFO, LDC, M, N 00161 * .. 00162 * .. Array Arguments .. 00163 COMPLEX*16 AP( * ), C( LDC, * ), TAU( * ), WORK( * ) 00164 * .. 00165 * 00166 * ===================================================================== 00167 * 00168 * .. Parameters .. 00169 COMPLEX*16 ONE 00170 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) 00171 * .. 00172 * .. Local Scalars .. 00173 LOGICAL FORWRD, LEFT, NOTRAN, UPPER 00174 INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ 00175 COMPLEX*16 AII, TAUI 00176 * .. 00177 * .. External Functions .. 00178 LOGICAL LSAME 00179 EXTERNAL LSAME 00180 * .. 00181 * .. External Subroutines .. 00182 EXTERNAL XERBLA, ZLARF 00183 * .. 00184 * .. Intrinsic Functions .. 00185 INTRINSIC DCONJG, MAX 00186 * .. 00187 * .. Executable Statements .. 00188 * 00189 * Test the input arguments 00190 * 00191 INFO = 0 00192 LEFT = LSAME( SIDE, 'L' ) 00193 NOTRAN = LSAME( TRANS, 'N' ) 00194 UPPER = LSAME( UPLO, 'U' ) 00195 * 00196 * NQ is the order of Q 00197 * 00198 IF( LEFT ) THEN 00199 NQ = M 00200 ELSE 00201 NQ = N 00202 END IF 00203 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 00204 INFO = -1 00205 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00206 INFO = -2 00207 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00208 INFO = -3 00209 ELSE IF( M.LT.0 ) THEN 00210 INFO = -4 00211 ELSE IF( N.LT.0 ) THEN 00212 INFO = -5 00213 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 00214 INFO = -9 00215 END IF 00216 IF( INFO.NE.0 ) THEN 00217 CALL XERBLA( 'ZUPMTR', -INFO ) 00218 RETURN 00219 END IF 00220 * 00221 * Quick return if possible 00222 * 00223 IF( M.EQ.0 .OR. N.EQ.0 ) 00224 $ RETURN 00225 * 00226 IF( UPPER ) THEN 00227 * 00228 * Q was determined by a call to ZHPTRD with UPLO = 'U' 00229 * 00230 FORWRD = ( LEFT .AND. NOTRAN ) .OR. 00231 $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) 00232 * 00233 IF( FORWRD ) THEN 00234 I1 = 1 00235 I2 = NQ - 1 00236 I3 = 1 00237 II = 2 00238 ELSE 00239 I1 = NQ - 1 00240 I2 = 1 00241 I3 = -1 00242 II = NQ*( NQ+1 ) / 2 - 1 00243 END IF 00244 * 00245 IF( LEFT ) THEN 00246 NI = N 00247 ELSE 00248 MI = M 00249 END IF 00250 * 00251 DO 10 I = I1, I2, I3 00252 IF( LEFT ) THEN 00253 * 00254 * H(i) or H(i)**H is applied to C(1:i,1:n) 00255 * 00256 MI = I 00257 ELSE 00258 * 00259 * H(i) or H(i)**H is applied to C(1:m,1:i) 00260 * 00261 NI = I 00262 END IF 00263 * 00264 * Apply H(i) or H(i)**H 00265 * 00266 IF( NOTRAN ) THEN 00267 TAUI = TAU( I ) 00268 ELSE 00269 TAUI = DCONJG( TAU( I ) ) 00270 END IF 00271 AII = AP( II ) 00272 AP( II ) = ONE 00273 CALL ZLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, LDC, 00274 $ WORK ) 00275 AP( II ) = AII 00276 * 00277 IF( FORWRD ) THEN 00278 II = II + I + 2 00279 ELSE 00280 II = II - I - 1 00281 END IF 00282 10 CONTINUE 00283 ELSE 00284 * 00285 * Q was determined by a call to ZHPTRD with UPLO = 'L'. 00286 * 00287 FORWRD = ( LEFT .AND. .NOT.NOTRAN ) .OR. 00288 $ ( .NOT.LEFT .AND. NOTRAN ) 00289 * 00290 IF( FORWRD ) THEN 00291 I1 = 1 00292 I2 = NQ - 1 00293 I3 = 1 00294 II = 2 00295 ELSE 00296 I1 = NQ - 1 00297 I2 = 1 00298 I3 = -1 00299 II = NQ*( NQ+1 ) / 2 - 1 00300 END IF 00301 * 00302 IF( LEFT ) THEN 00303 NI = N 00304 JC = 1 00305 ELSE 00306 MI = M 00307 IC = 1 00308 END IF 00309 * 00310 DO 20 I = I1, I2, I3 00311 AII = AP( II ) 00312 AP( II ) = ONE 00313 IF( LEFT ) THEN 00314 * 00315 * H(i) or H(i)**H is applied to C(i+1:m,1:n) 00316 * 00317 MI = M - I 00318 IC = I + 1 00319 ELSE 00320 * 00321 * H(i) or H(i)**H is applied to C(1:m,i+1:n) 00322 * 00323 NI = N - I 00324 JC = I + 1 00325 END IF 00326 * 00327 * Apply H(i) or H(i)**H 00328 * 00329 IF( NOTRAN ) THEN 00330 TAUI = TAU( I ) 00331 ELSE 00332 TAUI = DCONJG( TAU( I ) ) 00333 END IF 00334 CALL ZLARF( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, JC ), 00335 $ LDC, WORK ) 00336 AP( II ) = AII 00337 * 00338 IF( FORWRD ) THEN 00339 II = II + NQ - I + 1 00340 ELSE 00341 II = II - NQ + I - 2 00342 END IF 00343 20 CONTINUE 00344 END IF 00345 RETURN 00346 * 00347 * End of ZUPMTR 00348 * 00349 END