![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STRMV 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 STRMV(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 * REAL A(LDA,*),X(*) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> STRMV performs one of the matrix-vector operations 00028 *> 00029 *> x := A*x, or x := A**T*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**T*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 REAL 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,out] X 00105 *> \verbatim 00106 *> X is REAL 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 single_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 STRMV(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 REAL A(LDA,*),X(*) 00161 * .. 00162 * 00163 * ===================================================================== 00164 * 00165 * .. Parameters .. 00166 REAL ZERO 00167 PARAMETER (ZERO=0.0E+0) 00168 * .. 00169 * .. Local Scalars .. 00170 REAL TEMP 00171 INTEGER I,INFO,IX,J,JX,KX 00172 LOGICAL NOUNIT 00173 * .. 00174 * .. External Functions .. 00175 LOGICAL LSAME 00176 EXTERNAL LSAME 00177 * .. 00178 * .. External Subroutines .. 00179 EXTERNAL XERBLA 00180 * .. 00181 * .. Intrinsic Functions .. 00182 INTRINSIC 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('STRMV ',INFO) 00204 RETURN 00205 END IF 00206 * 00207 * Quick return if possible. 00208 * 00209 IF (N.EQ.0) RETURN 00210 * 00211 NOUNIT = LSAME(DIAG,'N') 00212 * 00213 * Set up the start point in X if the increment is not unity. This 00214 * will be ( N - 1 )*INCX too small for descending loops. 00215 * 00216 IF (INCX.LE.0) THEN 00217 KX = 1 - (N-1)*INCX 00218 ELSE IF (INCX.NE.1) THEN 00219 KX = 1 00220 END IF 00221 * 00222 * Start the operations. In this version the elements of A are 00223 * accessed sequentially with one pass through A. 00224 * 00225 IF (LSAME(TRANS,'N')) THEN 00226 * 00227 * Form x := A*x. 00228 * 00229 IF (LSAME(UPLO,'U')) THEN 00230 IF (INCX.EQ.1) THEN 00231 DO 20 J = 1,N 00232 IF (X(J).NE.ZERO) THEN 00233 TEMP = X(J) 00234 DO 10 I = 1,J - 1 00235 X(I) = X(I) + TEMP*A(I,J) 00236 10 CONTINUE 00237 IF (NOUNIT) X(J) = X(J)*A(J,J) 00238 END IF 00239 20 CONTINUE 00240 ELSE 00241 JX = KX 00242 DO 40 J = 1,N 00243 IF (X(JX).NE.ZERO) THEN 00244 TEMP = X(JX) 00245 IX = KX 00246 DO 30 I = 1,J - 1 00247 X(IX) = X(IX) + TEMP*A(I,J) 00248 IX = IX + INCX 00249 30 CONTINUE 00250 IF (NOUNIT) X(JX) = X(JX)*A(J,J) 00251 END IF 00252 JX = JX + INCX 00253 40 CONTINUE 00254 END IF 00255 ELSE 00256 IF (INCX.EQ.1) THEN 00257 DO 60 J = N,1,-1 00258 IF (X(J).NE.ZERO) THEN 00259 TEMP = X(J) 00260 DO 50 I = N,J + 1,-1 00261 X(I) = X(I) + TEMP*A(I,J) 00262 50 CONTINUE 00263 IF (NOUNIT) X(J) = X(J)*A(J,J) 00264 END IF 00265 60 CONTINUE 00266 ELSE 00267 KX = KX + (N-1)*INCX 00268 JX = KX 00269 DO 80 J = N,1,-1 00270 IF (X(JX).NE.ZERO) THEN 00271 TEMP = X(JX) 00272 IX = KX 00273 DO 70 I = N,J + 1,-1 00274 X(IX) = X(IX) + TEMP*A(I,J) 00275 IX = IX - INCX 00276 70 CONTINUE 00277 IF (NOUNIT) X(JX) = X(JX)*A(J,J) 00278 END IF 00279 JX = JX - INCX 00280 80 CONTINUE 00281 END IF 00282 END IF 00283 ELSE 00284 * 00285 * Form x := A**T*x. 00286 * 00287 IF (LSAME(UPLO,'U')) THEN 00288 IF (INCX.EQ.1) THEN 00289 DO 100 J = N,1,-1 00290 TEMP = X(J) 00291 IF (NOUNIT) TEMP = TEMP*A(J,J) 00292 DO 90 I = J - 1,1,-1 00293 TEMP = TEMP + A(I,J)*X(I) 00294 90 CONTINUE 00295 X(J) = TEMP 00296 100 CONTINUE 00297 ELSE 00298 JX = KX + (N-1)*INCX 00299 DO 120 J = N,1,-1 00300 TEMP = X(JX) 00301 IX = JX 00302 IF (NOUNIT) TEMP = TEMP*A(J,J) 00303 DO 110 I = J - 1,1,-1 00304 IX = IX - INCX 00305 TEMP = TEMP + A(I,J)*X(IX) 00306 110 CONTINUE 00307 X(JX) = TEMP 00308 JX = JX - INCX 00309 120 CONTINUE 00310 END IF 00311 ELSE 00312 IF (INCX.EQ.1) THEN 00313 DO 140 J = 1,N 00314 TEMP = X(J) 00315 IF (NOUNIT) TEMP = TEMP*A(J,J) 00316 DO 130 I = J + 1,N 00317 TEMP = TEMP + A(I,J)*X(I) 00318 130 CONTINUE 00319 X(J) = TEMP 00320 140 CONTINUE 00321 ELSE 00322 JX = KX 00323 DO 160 J = 1,N 00324 TEMP = X(JX) 00325 IX = JX 00326 IF (NOUNIT) TEMP = TEMP*A(J,J) 00327 DO 150 I = J + 1,N 00328 IX = IX + INCX 00329 TEMP = TEMP + A(I,J)*X(IX) 00330 150 CONTINUE 00331 X(JX) = TEMP 00332 JX = JX + INCX 00333 160 CONTINUE 00334 END IF 00335 END IF 00336 END IF 00337 * 00338 RETURN 00339 * 00340 * End of STRMV . 00341 * 00342 END