![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZTRMV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER INCX,LDA,N 00015 * CHARACTER DIAG,TRANS,UPLO 00016 * .. 00017 * .. Array Arguments .. 00018 * COMPLEX*16 A(LDA,*),X(*) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> ZTRMV performs one of the matrix-vector operations 00028 *> 00029 *> x := A*x, or x := A**T*x, or x := A**H*x, 00030 *> 00031 *> where x is an n element vector and A is an n by n unit, or non-unit, 00032 *> upper or lower triangular matrix. 00033 *> \endverbatim 00034 * 00035 * Arguments: 00036 * ========== 00037 * 00038 *> \param[in] UPLO 00039 *> \verbatim 00040 *> UPLO is CHARACTER*1 00041 *> On entry, UPLO specifies whether the matrix is an upper or 00042 *> lower triangular matrix as follows: 00043 *> 00044 *> UPLO = 'U' or 'u' A is an upper triangular matrix. 00045 *> 00046 *> UPLO = 'L' or 'l' A is a lower triangular matrix. 00047 *> \endverbatim 00048 *> 00049 *> \param[in] TRANS 00050 *> \verbatim 00051 *> TRANS is CHARACTER*1 00052 *> On entry, TRANS specifies the operation to be performed as 00053 *> follows: 00054 *> 00055 *> TRANS = 'N' or 'n' x := A*x. 00056 *> 00057 *> TRANS = 'T' or 't' x := A**T*x. 00058 *> 00059 *> TRANS = 'C' or 'c' x := A**H*x. 00060 *> \endverbatim 00061 *> 00062 *> \param[in] DIAG 00063 *> \verbatim 00064 *> DIAG is CHARACTER*1 00065 *> On entry, DIAG specifies whether or not A is unit 00066 *> triangular as follows: 00067 *> 00068 *> DIAG = 'U' or 'u' A is assumed to be unit triangular. 00069 *> 00070 *> DIAG = 'N' or 'n' A is not assumed to be unit 00071 *> triangular. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] N 00075 *> \verbatim 00076 *> N is INTEGER 00077 *> On entry, N specifies the order of the matrix A. 00078 *> N must be at least zero. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] A 00082 *> \verbatim 00083 *> A is COMPLEX*16 array of DIMENSION ( LDA, n ). 00084 *> Before entry with UPLO = 'U' or 'u', the leading n by n 00085 *> upper triangular part of the array A must contain the upper 00086 *> triangular matrix and the strictly lower triangular part of 00087 *> A is not referenced. 00088 *> Before entry with UPLO = 'L' or 'l', the leading n by n 00089 *> lower triangular part of the array A must contain the lower 00090 *> triangular matrix and the strictly upper triangular part of 00091 *> A is not referenced. 00092 *> Note that when DIAG = 'U' or 'u', the diagonal elements of 00093 *> A are not referenced either, but are assumed to be unity. 00094 *> \endverbatim 00095 *> 00096 *> \param[in] LDA 00097 *> \verbatim 00098 *> LDA is INTEGER 00099 *> On entry, LDA specifies the first dimension of A as declared 00100 *> in the calling (sub) program. LDA must be at least 00101 *> max( 1, n ). 00102 *> \endverbatim 00103 *> 00104 *> \param[in] X 00105 *> \verbatim 00106 *> X is (input/output) COMPLEX*16 array of dimension at least 00107 *> ( 1 + ( n - 1 )*abs( INCX ) ). 00108 *> Before entry, the incremented array X must contain the n 00109 *> element vector x. On exit, X is overwritten with the 00110 *> tranformed vector x. 00111 *> \endverbatim 00112 *> 00113 *> \param[in] INCX 00114 *> \verbatim 00115 *> INCX is INTEGER 00116 *> On entry, INCX specifies the increment for the elements of 00117 *> X. INCX must not be zero. 00118 *> \endverbatim 00119 * 00120 * Authors: 00121 * ======== 00122 * 00123 *> \author Univ. of Tennessee 00124 *> \author Univ. of California Berkeley 00125 *> \author Univ. of Colorado Denver 00126 *> \author NAG Ltd. 00127 * 00128 *> \date November 2011 00129 * 00130 *> \ingroup complex16_blas_level2 00131 * 00132 *> \par Further Details: 00133 * ===================== 00134 *> 00135 *> \verbatim 00136 *> 00137 *> Level 2 Blas routine. 00138 *> The vector and matrix arguments are not referenced when N = 0, or M = 0 00139 *> 00140 *> -- Written on 22-October-1986. 00141 *> Jack Dongarra, Argonne National Lab. 00142 *> Jeremy Du Croz, Nag Central Office. 00143 *> Sven Hammarling, Nag Central Office. 00144 *> Richard Hanson, Sandia National Labs. 00145 *> \endverbatim 00146 *> 00147 * ===================================================================== 00148 SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) 00149 * 00150 * -- Reference BLAS level2 routine (version 3.4.0) -- 00151 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00153 * November 2011 00154 * 00155 * .. Scalar Arguments .. 00156 INTEGER INCX,LDA,N 00157 CHARACTER DIAG,TRANS,UPLO 00158 * .. 00159 * .. Array Arguments .. 00160 COMPLEX*16 A(LDA,*),X(*) 00161 * .. 00162 * 00163 * ===================================================================== 00164 * 00165 * .. Parameters .. 00166 COMPLEX*16 ZERO 00167 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00168 * .. 00169 * .. Local Scalars .. 00170 COMPLEX*16 TEMP 00171 INTEGER I,INFO,IX,J,JX,KX 00172 LOGICAL NOCONJ,NOUNIT 00173 * .. 00174 * .. External Functions .. 00175 LOGICAL LSAME 00176 EXTERNAL LSAME 00177 * .. 00178 * .. External Subroutines .. 00179 EXTERNAL XERBLA 00180 * .. 00181 * .. Intrinsic Functions .. 00182 INTRINSIC DCONJG,MAX 00183 * .. 00184 * 00185 * Test the input parameters. 00186 * 00187 INFO = 0 00188 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 00189 INFO = 1 00190 ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00191 + .NOT.LSAME(TRANS,'C')) THEN 00192 INFO = 2 00193 ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN 00194 INFO = 3 00195 ELSE IF (N.LT.0) THEN 00196 INFO = 4 00197 ELSE IF (LDA.LT.MAX(1,N)) THEN 00198 INFO = 6 00199 ELSE IF (INCX.EQ.0) THEN 00200 INFO = 8 00201 END IF 00202 IF (INFO.NE.0) THEN 00203 CALL XERBLA('ZTRMV ',INFO) 00204 RETURN 00205 END IF 00206 * 00207 * Quick return if possible. 00208 * 00209 IF (N.EQ.0) RETURN 00210 * 00211 NOCONJ = LSAME(TRANS,'T') 00212 NOUNIT = LSAME(DIAG,'N') 00213 * 00214 * Set up the start point in X if the increment is not unity. This 00215 * will be ( N - 1 )*INCX too small for descending loops. 00216 * 00217 IF (INCX.LE.0) THEN 00218 KX = 1 - (N-1)*INCX 00219 ELSE IF (INCX.NE.1) THEN 00220 KX = 1 00221 END IF 00222 * 00223 * Start the operations. In this version the elements of A are 00224 * accessed sequentially with one pass through A. 00225 * 00226 IF (LSAME(TRANS,'N')) THEN 00227 * 00228 * Form x := A*x. 00229 * 00230 IF (LSAME(UPLO,'U')) THEN 00231 IF (INCX.EQ.1) THEN 00232 DO 20 J = 1,N 00233 IF (X(J).NE.ZERO) THEN 00234 TEMP = X(J) 00235 DO 10 I = 1,J - 1 00236 X(I) = X(I) + TEMP*A(I,J) 00237 10 CONTINUE 00238 IF (NOUNIT) X(J) = X(J)*A(J,J) 00239 END IF 00240 20 CONTINUE 00241 ELSE 00242 JX = KX 00243 DO 40 J = 1,N 00244 IF (X(JX).NE.ZERO) THEN 00245 TEMP = X(JX) 00246 IX = KX 00247 DO 30 I = 1,J - 1 00248 X(IX) = X(IX) + TEMP*A(I,J) 00249 IX = IX + INCX 00250 30 CONTINUE 00251 IF (NOUNIT) X(JX) = X(JX)*A(J,J) 00252 END IF 00253 JX = JX + INCX 00254 40 CONTINUE 00255 END IF 00256 ELSE 00257 IF (INCX.EQ.1) THEN 00258 DO 60 J = N,1,-1 00259 IF (X(J).NE.ZERO) THEN 00260 TEMP = X(J) 00261 DO 50 I = N,J + 1,-1 00262 X(I) = X(I) + TEMP*A(I,J) 00263 50 CONTINUE 00264 IF (NOUNIT) X(J) = X(J)*A(J,J) 00265 END IF 00266 60 CONTINUE 00267 ELSE 00268 KX = KX + (N-1)*INCX 00269 JX = KX 00270 DO 80 J = N,1,-1 00271 IF (X(JX).NE.ZERO) THEN 00272 TEMP = X(JX) 00273 IX = KX 00274 DO 70 I = N,J + 1,-1 00275 X(IX) = X(IX) + TEMP*A(I,J) 00276 IX = IX - INCX 00277 70 CONTINUE 00278 IF (NOUNIT) X(JX) = X(JX)*A(J,J) 00279 END IF 00280 JX = JX - INCX 00281 80 CONTINUE 00282 END IF 00283 END IF 00284 ELSE 00285 * 00286 * Form x := A**T*x or x := A**H*x. 00287 * 00288 IF (LSAME(UPLO,'U')) THEN 00289 IF (INCX.EQ.1) THEN 00290 DO 110 J = N,1,-1 00291 TEMP = X(J) 00292 IF (NOCONJ) THEN 00293 IF (NOUNIT) TEMP = TEMP*A(J,J) 00294 DO 90 I = J - 1,1,-1 00295 TEMP = TEMP + A(I,J)*X(I) 00296 90 CONTINUE 00297 ELSE 00298 IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J)) 00299 DO 100 I = J - 1,1,-1 00300 TEMP = TEMP + DCONJG(A(I,J))*X(I) 00301 100 CONTINUE 00302 END IF 00303 X(J) = TEMP 00304 110 CONTINUE 00305 ELSE 00306 JX = KX + (N-1)*INCX 00307 DO 140 J = N,1,-1 00308 TEMP = X(JX) 00309 IX = JX 00310 IF (NOCONJ) THEN 00311 IF (NOUNIT) TEMP = TEMP*A(J,J) 00312 DO 120 I = J - 1,1,-1 00313 IX = IX - INCX 00314 TEMP = TEMP + A(I,J)*X(IX) 00315 120 CONTINUE 00316 ELSE 00317 IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J)) 00318 DO 130 I = J - 1,1,-1 00319 IX = IX - INCX 00320 TEMP = TEMP + DCONJG(A(I,J))*X(IX) 00321 130 CONTINUE 00322 END IF 00323 X(JX) = TEMP 00324 JX = JX - INCX 00325 140 CONTINUE 00326 END IF 00327 ELSE 00328 IF (INCX.EQ.1) THEN 00329 DO 170 J = 1,N 00330 TEMP = X(J) 00331 IF (NOCONJ) THEN 00332 IF (NOUNIT) TEMP = TEMP*A(J,J) 00333 DO 150 I = J + 1,N 00334 TEMP = TEMP + A(I,J)*X(I) 00335 150 CONTINUE 00336 ELSE 00337 IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J)) 00338 DO 160 I = J + 1,N 00339 TEMP = TEMP + DCONJG(A(I,J))*X(I) 00340 160 CONTINUE 00341 END IF 00342 X(J) = TEMP 00343 170 CONTINUE 00344 ELSE 00345 JX = KX 00346 DO 200 J = 1,N 00347 TEMP = X(JX) 00348 IX = JX 00349 IF (NOCONJ) THEN 00350 IF (NOUNIT) TEMP = TEMP*A(J,J) 00351 DO 180 I = J + 1,N 00352 IX = IX + INCX 00353 TEMP = TEMP + A(I,J)*X(IX) 00354 180 CONTINUE 00355 ELSE 00356 IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J)) 00357 DO 190 I = J + 1,N 00358 IX = IX + INCX 00359 TEMP = TEMP + DCONJG(A(I,J))*X(IX) 00360 190 CONTINUE 00361 END IF 00362 X(JX) = TEMP 00363 JX = JX + INCX 00364 200 CONTINUE 00365 END IF 00366 END IF 00367 END IF 00368 * 00369 RETURN 00370 * 00371 * End of ZTRMV . 00372 * 00373 END