1
SUBROUTINE STRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
3
* $Id: strmv.f 19695 2010-10-29 16:51:02Z d3y133 $
3
* =========== DOCUMENTATION ===========
5
* Online html documentation available at
6
* http://www.netlib.org/lapack/explore-html/
11
* SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
13
* .. Scalar Arguments ..
15
* CHARACTER DIAG,TRANS,UPLO
17
* .. Array Arguments ..
27
*> STRMV performs one of the matrix-vector operations
29
*> x := A*x, or x := A**T*x,
31
*> where x is an n element vector and A is an n by n unit, or non-unit,
32
*> upper or lower triangular matrix.
40
*> UPLO is CHARACTER*1
41
*> On entry, UPLO specifies whether the matrix is an upper or
42
*> lower triangular matrix as follows:
44
*> UPLO = 'U' or 'u' A is an upper triangular matrix.
46
*> UPLO = 'L' or 'l' A is a lower triangular matrix.
51
*> TRANS is CHARACTER*1
52
*> On entry, TRANS specifies the operation to be performed as
55
*> TRANS = 'N' or 'n' x := A*x.
57
*> TRANS = 'T' or 't' x := A**T*x.
59
*> TRANS = 'C' or 'c' x := A**T*x.
64
*> DIAG is CHARACTER*1
65
*> On entry, DIAG specifies whether or not A is unit
66
*> triangular as follows:
68
*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
70
*> DIAG = 'N' or 'n' A is not assumed to be unit
77
*> On entry, N specifies the order of the matrix A.
78
*> N must be at least zero.
83
*> A is REAL array of DIMENSION ( LDA, n ).
84
*> Before entry with UPLO = 'U' or 'u', the leading n by n
85
*> upper triangular part of the array A must contain the upper
86
*> triangular matrix and the strictly lower triangular part of
87
*> A is not referenced.
88
*> Before entry with UPLO = 'L' or 'l', the leading n by n
89
*> lower triangular part of the array A must contain the lower
90
*> triangular matrix and the strictly upper triangular part of
91
*> A is not referenced.
92
*> Note that when DIAG = 'U' or 'u', the diagonal elements of
93
*> A are not referenced either, but are assumed to be unity.
99
*> On entry, LDA specifies the first dimension of A as declared
100
*> in the calling (sub) program. LDA must be at least
106
*> X is REAL array of dimension at least
107
*> ( 1 + ( n - 1 )*abs( INCX ) ).
108
*> Before entry, the incremented array X must contain the n
109
*> element vector x. On exit, X is overwritten with the
110
*> tranformed vector x.
116
*> On entry, INCX specifies the increment for the elements of
117
*> X. INCX must not be zero.
123
*> \author Univ. of Tennessee
124
*> \author Univ. of California Berkeley
125
*> \author Univ. of Colorado Denver
128
*> \date November 2011
130
*> \ingroup single_blas_level2
132
*> \par Further Details:
133
* =====================
137
*> Level 2 Blas routine.
138
*> The vector and matrix arguments are not referenced when N = 0, or M = 0
140
*> -- Written on 22-October-1986.
141
*> Jack Dongarra, Argonne National Lab.
142
*> Jeremy Du Croz, Nag Central Office.
143
*> Sven Hammarling, Nag Central Office.
144
*> Richard Hanson, Sandia National Labs.
147
* =====================================================================
148
SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
150
* -- Reference BLAS level2 routine (version 3.4.0) --
151
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
152
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
5
155
* .. Scalar Arguments ..
7
CHARACTER*1 DIAG, TRANS, UPLO
157
CHARACTER DIAG,TRANS,UPLO
8
159
* .. Array Arguments ..
9
REAL A( LDA, * ), X( * )
15
* STRMV performs one of the matrix-vector operations
17
* x := A*x, or x := A'*x,
19
* where x is an n element vector and A is an n by n unit, or non-unit,
20
* upper or lower triangular matrix.
26
* On entry, UPLO specifies whether the matrix is an upper or
27
* lower triangular matrix as follows:
29
* UPLO = 'U' or 'u' A is an upper triangular matrix.
31
* UPLO = 'L' or 'l' A is a lower triangular matrix.
35
* TRANS - CHARACTER*1.
36
* On entry, TRANS specifies the operation to be performed as
39
* TRANS = 'N' or 'n' x := A*x.
41
* TRANS = 'T' or 't' x := A'*x.
43
* TRANS = 'C' or 'c' x := A'*x.
48
* On entry, DIAG specifies whether or not A is unit
49
* triangular as follows:
51
* DIAG = 'U' or 'u' A is assumed to be unit triangular.
53
* DIAG = 'N' or 'n' A is not assumed to be unit
59
* On entry, N specifies the order of the matrix A.
60
* N must be at least zero.
63
* A - REAL array of DIMENSION ( LDA, n ).
64
* Before entry with UPLO = 'U' or 'u', the leading n by n
65
* upper triangular part of the array A must contain the upper
66
* triangular matrix and the strictly lower triangular part of
67
* A is not referenced.
68
* Before entry with UPLO = 'L' or 'l', the leading n by n
69
* lower triangular part of the array A must contain the lower
70
* triangular matrix and the strictly upper triangular part of
71
* A is not referenced.
72
* Note that when DIAG = 'U' or 'u', the diagonal elements of
73
* A are not referenced either, but are assumed to be unity.
77
* On entry, LDA specifies the first dimension of A as declared
78
* in the calling (sub) program. LDA must be at least
82
* X - REAL array of dimension at least
83
* ( 1 + ( n - 1 )*abs( INCX ) ).
84
* Before entry, the incremented array X must contain the n
85
* element vector x. On exit, X is overwritten with the
86
* tranformed vector x.
89
* On entry, INCX specifies the increment for the elements of
90
* X. INCX must not be zero.
94
* Level 2 Blas routine.
96
* -- Written on 22-October-1986.
97
* Jack Dongarra, Argonne National Lab.
98
* Jeremy Du Croz, Nag Central Office.
99
* Sven Hammarling, Nag Central Office.
100
* Richard Hanson, Sandia National Labs.
163
* =====================================================================
103
165
* .. Parameters ..
105
PARAMETER ( ZERO = 0.0E+0 )
167
PARAMETER (ZERO=0.0E+0)
106
169
* .. Local Scalars ..
108
INTEGER I, INFO, IX, J, JX, KX
171
INTEGER I,INFO,IX,J,JX,KX
110
174
* .. External Functions ..
113
178
* .. External Subroutines ..
115
181
* .. Intrinsic Functions ..
118
* .. Executable Statements ..
120
185
* Test the input parameters.
123
IF ( .NOT.LSAME( UPLO , 'U' ).AND.
124
$ .NOT.LSAME( UPLO , 'L' ) )THEN
126
ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
127
$ .NOT.LSAME( TRANS, 'T' ).AND.
128
$ .NOT.LSAME( TRANS, 'C' ) )THEN
130
ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
131
$ .NOT.LSAME( DIAG , 'N' ) )THEN
133
ELSE IF( N.LT.0 )THEN
135
ELSE IF( LDA.LT.MAX( 1, N ) )THEN
137
ELSE IF( INCX.EQ.0 )THEN
188
IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
190
ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
191
+ .NOT.LSAME(TRANS,'C')) THEN
193
ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
195
ELSE IF (N.LT.0) THEN
197
ELSE IF (LDA.LT.MAX(1,N)) THEN
199
ELSE IF (INCX.EQ.0) THEN
141
CALL XERBLA( 'STRMV ', INFO )
203
CALL XERBLA('STRMV ',INFO)
145
207
* Quick return if possible.
150
NOUNIT = LSAME( DIAG, 'N' )
211
NOUNIT = LSAME(DIAG,'N')
152
213
* Set up the start point in X if the increment is not unity. This
153
214
* will be ( N - 1 )*INCX too small for descending loops.
156
KX = 1 - ( N - 1 )*INCX
157
ELSE IF( INCX.NE.1 )THEN
218
ELSE IF (INCX.NE.1) THEN
161
222
* Start the operations. In this version the elements of A are
162
223
* accessed sequentially with one pass through A.
164
IF( LSAME( TRANS, 'N' ) )THEN
225
IF (LSAME(TRANS,'N')) THEN
168
IF( LSAME( UPLO, 'U' ) )THEN
171
IF( X( J ).NE.ZERO )THEN
174
X( I ) = X( I ) + TEMP*A( I, J )
177
$ X( J ) = X( J )*A( J, J )
183
IF( X( JX ).NE.ZERO )THEN
187
X( IX ) = X( IX ) + TEMP*A( I, J )
191
$ X( JX ) = X( JX )*A( J, J )
199
IF( X( J ).NE.ZERO )THEN
201
DO 50, I = N, J + 1, -1
202
X( I ) = X( I ) + TEMP*A( I, J )
205
$ X( J ) = X( J )*A( J, J )
209
KX = KX + ( N - 1 )*INCX
212
IF( X( JX ).NE.ZERO )THEN
215
DO 70, I = N, J + 1, -1
216
X( IX ) = X( IX ) + TEMP*A( I, J )
220
$ X( JX ) = X( JX )*A( J, J )
229
IF (LSAME(UPLO,'U')) THEN
232
IF (X(J).NE.ZERO) THEN
235
X(I) = X(I) + TEMP*A(I,J)
237
IF (NOUNIT) X(J) = X(J)*A(J,J)
243
IF (X(JX).NE.ZERO) THEN
247
X(IX) = X(IX) + TEMP*A(I,J)
250
IF (NOUNIT) X(JX) = X(JX)*A(J,J)
258
IF (X(J).NE.ZERO) THEN
261
X(I) = X(I) + TEMP*A(I,J)
263
IF (NOUNIT) X(J) = X(J)*A(J,J)
270
IF (X(JX).NE.ZERO) THEN
274
X(IX) = X(IX) + TEMP*A(I,J)
277
IF (NOUNIT) X(JX) = X(JX)*A(J,J)
230
IF( LSAME( UPLO, 'U' ) )THEN
235
$ TEMP = TEMP*A( J, J )
236
DO 90, I = J - 1, 1, -1
237
TEMP = TEMP + A( I, J )*X( I )
242
JX = KX + ( N - 1 )*INCX
247
$ TEMP = TEMP*A( J, J )
248
DO 110, I = J - 1, 1, -1
250
TEMP = TEMP + A( I, J )*X( IX )
261
$ TEMP = TEMP*A( J, J )
263
TEMP = TEMP + A( I, J )*X( I )
273
$ TEMP = TEMP*A( J, J )
276
TEMP = TEMP + A( I, J )*X( IX )
287
IF (LSAME(UPLO,'U')) THEN
291
IF (NOUNIT) TEMP = TEMP*A(J,J)
293
TEMP = TEMP + A(I,J)*X(I)
302
IF (NOUNIT) TEMP = TEMP*A(J,J)
303
DO 110 I = J - 1,1,-1
305
TEMP = TEMP + A(I,J)*X(IX)
315
IF (NOUNIT) TEMP = TEMP*A(J,J)
317
TEMP = TEMP + A(I,J)*X(I)
326
IF (NOUNIT) TEMP = TEMP*A(J,J)
329
TEMP = TEMP + A(I,J)*X(IX)