LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ strmv()

subroutine strmv ( character  uplo,
character  trans,
character  diag,
integer  n,
real, dimension(lda,*)  a,
integer  lda,
real, dimension(*)  x,
integer  incx 
)

STRMV

Purpose:
 STRMV  performs one of the matrix-vector operations

    x := A*x,   or   x := A**T*x,

 where x is an n element vector and  A is an n by n unit, or non-unit,
 upper or lower triangular matrix.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the matrix is an upper or
           lower triangular matrix as follows:

              UPLO = 'U' or 'u'   A is an upper triangular matrix.

              UPLO = 'L' or 'l'   A is a lower triangular matrix.
[in]TRANS
          TRANS is CHARACTER*1
           On entry, TRANS specifies the operation to be performed as
           follows:

              TRANS = 'N' or 'n'   x := A*x.

              TRANS = 'T' or 't'   x := A**T*x.

              TRANS = 'C' or 'c'   x := A**T*x.
[in]DIAG
          DIAG is CHARACTER*1
           On entry, DIAG specifies whether or not A is unit
           triangular as follows:

              DIAG = 'U' or 'u'   A is assumed to be unit triangular.

              DIAG = 'N' or 'n'   A is not assumed to be unit
                                  triangular.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
[in]A
          A is REAL array, dimension ( LDA, N )
           Before entry with  UPLO = 'U' or 'u', the leading n by n
           upper triangular part of the array A must contain the upper
           triangular matrix and the strictly lower triangular part of
           A is not referenced.
           Before entry with UPLO = 'L' or 'l', the leading n by n
           lower triangular part of the array A must contain the lower
           triangular matrix and the strictly upper triangular part of
           A is not referenced.
           Note that when  DIAG = 'U' or 'u', the diagonal elements of
           A are not referenced either, but are assumed to be unity.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program. LDA must be at least
           max( 1, n ).
[in,out]X
          X is REAL array, dimension at least
           ( 1 + ( n - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the n
           element vector x. On exit, X is overwritten with the
           transformed vector x.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 2 Blas routine.
  The vector and matrix arguments are not referenced when N = 0, or M = 0

  -- Written on 22-October-1986.
     Jack Dongarra, Argonne National Lab.
     Jeremy Du Croz, Nag Central Office.
     Sven Hammarling, Nag Central Office.
     Richard Hanson, Sandia National Labs.

Definition at line 146 of file strmv.f.

147*
148* -- Reference BLAS level2 routine --
149* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151*
152* .. Scalar Arguments ..
153 INTEGER INCX,LDA,N
154 CHARACTER DIAG,TRANS,UPLO
155* ..
156* .. Array Arguments ..
157 REAL A(LDA,*),X(*)
158* ..
159*
160* =====================================================================
161*
162* .. Parameters ..
163 REAL ZERO
164 parameter(zero=0.0e+0)
165* ..
166* .. Local Scalars ..
167 REAL TEMP
168 INTEGER I,INFO,IX,J,JX,KX
169 LOGICAL NOUNIT
170* ..
171* .. External Functions ..
172 LOGICAL LSAME
173 EXTERNAL lsame
174* ..
175* .. External Subroutines ..
176 EXTERNAL xerbla
177* ..
178* .. Intrinsic Functions ..
179 INTRINSIC max
180* ..
181*
182* Test the input parameters.
183*
184 info = 0
185 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
186 info = 1
187 ELSE IF (.NOT.lsame(trans,'N') .AND.
188 + .NOT.lsame(trans,'T') .AND.
189 + .NOT.lsame(trans,'C')) THEN
190 info = 2
191 ELSE IF (.NOT.lsame(diag,'U') .AND.
192 + .NOT.lsame(diag,'N')) THEN
193 info = 3
194 ELSE IF (n.LT.0) THEN
195 info = 4
196 ELSE IF (lda.LT.max(1,n)) THEN
197 info = 6
198 ELSE IF (incx.EQ.0) THEN
199 info = 8
200 END IF
201 IF (info.NE.0) THEN
202 CALL xerbla('STRMV ',info)
203 RETURN
204 END IF
205*
206* Quick return if possible.
207*
208 IF (n.EQ.0) RETURN
209*
210 nounit = lsame(diag,'N')
211*
212* Set up the start point in X if the increment is not unity. This
213* will be ( N - 1 )*INCX too small for descending loops.
214*
215 IF (incx.LE.0) THEN
216 kx = 1 - (n-1)*incx
217 ELSE IF (incx.NE.1) THEN
218 kx = 1
219 END IF
220*
221* Start the operations. In this version the elements of A are
222* accessed sequentially with one pass through A.
223*
224 IF (lsame(trans,'N')) THEN
225*
226* Form x := A*x.
227*
228 IF (lsame(uplo,'U')) THEN
229 IF (incx.EQ.1) THEN
230 DO 20 j = 1,n
231 IF (x(j).NE.zero) THEN
232 temp = x(j)
233 DO 10 i = 1,j - 1
234 x(i) = x(i) + temp*a(i,j)
235 10 CONTINUE
236 IF (nounit) x(j) = x(j)*a(j,j)
237 END IF
238 20 CONTINUE
239 ELSE
240 jx = kx
241 DO 40 j = 1,n
242 IF (x(jx).NE.zero) THEN
243 temp = x(jx)
244 ix = kx
245 DO 30 i = 1,j - 1
246 x(ix) = x(ix) + temp*a(i,j)
247 ix = ix + incx
248 30 CONTINUE
249 IF (nounit) x(jx) = x(jx)*a(j,j)
250 END IF
251 jx = jx + incx
252 40 CONTINUE
253 END IF
254 ELSE
255 IF (incx.EQ.1) THEN
256 DO 60 j = n,1,-1
257 IF (x(j).NE.zero) THEN
258 temp = x(j)
259 DO 50 i = n,j + 1,-1
260 x(i) = x(i) + temp*a(i,j)
261 50 CONTINUE
262 IF (nounit) x(j) = x(j)*a(j,j)
263 END IF
264 60 CONTINUE
265 ELSE
266 kx = kx + (n-1)*incx
267 jx = kx
268 DO 80 j = n,1,-1
269 IF (x(jx).NE.zero) THEN
270 temp = x(jx)
271 ix = kx
272 DO 70 i = n,j + 1,-1
273 x(ix) = x(ix) + temp*a(i,j)
274 ix = ix - incx
275 70 CONTINUE
276 IF (nounit) x(jx) = x(jx)*a(j,j)
277 END IF
278 jx = jx - incx
279 80 CONTINUE
280 END IF
281 END IF
282 ELSE
283*
284* Form x := A**T*x.
285*
286 IF (lsame(uplo,'U')) THEN
287 IF (incx.EQ.1) THEN
288 DO 100 j = n,1,-1
289 temp = x(j)
290 IF (nounit) temp = temp*a(j,j)
291 DO 90 i = j - 1,1,-1
292 temp = temp + a(i,j)*x(i)
293 90 CONTINUE
294 x(j) = temp
295 100 CONTINUE
296 ELSE
297 jx = kx + (n-1)*incx
298 DO 120 j = n,1,-1
299 temp = x(jx)
300 ix = jx
301 IF (nounit) temp = temp*a(j,j)
302 DO 110 i = j - 1,1,-1
303 ix = ix - incx
304 temp = temp + a(i,j)*x(ix)
305 110 CONTINUE
306 x(jx) = temp
307 jx = jx - incx
308 120 CONTINUE
309 END IF
310 ELSE
311 IF (incx.EQ.1) THEN
312 DO 140 j = 1,n
313 temp = x(j)
314 IF (nounit) temp = temp*a(j,j)
315 DO 130 i = j + 1,n
316 temp = temp + a(i,j)*x(i)
317 130 CONTINUE
318 x(j) = temp
319 140 CONTINUE
320 ELSE
321 jx = kx
322 DO 160 j = 1,n
323 temp = x(jx)
324 ix = jx
325 IF (nounit) temp = temp*a(j,j)
326 DO 150 i = j + 1,n
327 ix = ix + incx
328 temp = temp + a(i,j)*x(ix)
329 150 CONTINUE
330 x(jx) = temp
331 jx = jx + incx
332 160 CONTINUE
333 END IF
334 END IF
335 END IF
336*
337 RETURN
338*
339* End of STRMV
340*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: