1
SUBROUTINE ZTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
3
* $Id: ztrmv.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 ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
13
* .. Scalar Arguments ..
15
* CHARACTER DIAG,TRANS,UPLO
17
* .. Array Arguments ..
18
* COMPLEX*16 A(LDA,*),X(*)
27
*> ZTRMV performs one of the matrix-vector operations
29
*> x := A*x, or x := A**T*x, or x := A**H*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**H*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 COMPLEX*16 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 (input/output) COMPLEX*16 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 complex16_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 ZTRMV(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
COMPLEX*16 A( LDA, * ), X( * )
160
COMPLEX*16 A(LDA,*),X(*)
15
* ZTRMV performs one of the matrix-vector operations
17
* x := A*x, or x := A'*x, or x := conjg( 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 := conjg( 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 - COMPLEX*16 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 - COMPLEX*16 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.0D+0, 0.0D+0 ) )
167
PARAMETER (ZERO= (0.0D+0,0.0D+0))
106
169
* .. Local Scalars ..
108
INTEGER I, INFO, IX, J, JX, KX
109
LOGICAL NOCONJ, NOUNIT
171
INTEGER I,INFO,IX,J,JX,KX
172
LOGICAL NOCONJ,NOUNIT
110
174
* .. External Functions ..
113
178
* .. External Subroutines ..
115
181
* .. Intrinsic Functions ..
116
INTRINSIC DCONJG, MAX
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( 'ZTRMV ', INFO )
203
CALL XERBLA('ZTRMV ',INFO)
145
207
* Quick return if possible.
150
NOCONJ = LSAME( TRANS, 'T' )
151
NOUNIT = LSAME( DIAG , 'N' )
211
NOCONJ = LSAME(TRANS,'T')
212
NOUNIT = LSAME(DIAG,'N')
153
214
* Set up the start point in X if the increment is not unity. This
154
215
* will be ( N - 1 )*INCX too small for descending loops.
155
* The next line is to satisfy compiler warnings.
159
KX = 1 - ( N - 1 )*INCX
160
ELSE IF( INCX.NE.1 )THEN
219
ELSE IF (INCX.NE.1) THEN
164
223
* Start the operations. In this version the elements of A are
165
224
* accessed sequentially with one pass through A.
167
IF( LSAME( TRANS, 'N' ) )THEN
226
IF (LSAME(TRANS,'N')) THEN
171
IF( LSAME( UPLO, 'U' ) )THEN
174
IF( X( J ).NE.ZERO )THEN
177
X( I ) = X( I ) + TEMP*A( I, J )
180
$ X( J ) = X( J )*A( J, J )
186
IF( X( JX ).NE.ZERO )THEN
190
X( IX ) = X( IX ) + TEMP*A( I, J )
194
$ X( JX ) = X( JX )*A( J, J )
202
IF( X( J ).NE.ZERO )THEN
204
DO 50, I = N, J + 1, -1
205
X( I ) = X( I ) + TEMP*A( I, J )
208
$ X( J ) = X( J )*A( J, J )
212
KX = KX + ( N - 1 )*INCX
215
IF( X( JX ).NE.ZERO )THEN
218
DO 70, I = N, J + 1, -1
219
X( IX ) = X( IX ) + TEMP*A( I, J )
223
$ X( JX ) = X( JX )*A( J, J )
230
IF (LSAME(UPLO,'U')) THEN
233
IF (X(J).NE.ZERO) THEN
236
X(I) = X(I) + TEMP*A(I,J)
238
IF (NOUNIT) X(J) = X(J)*A(J,J)
244
IF (X(JX).NE.ZERO) THEN
248
X(IX) = X(IX) + TEMP*A(I,J)
251
IF (NOUNIT) X(JX) = X(JX)*A(J,J)
259
IF (X(J).NE.ZERO) THEN
262
X(I) = X(I) + TEMP*A(I,J)
264
IF (NOUNIT) X(J) = X(J)*A(J,J)
271
IF (X(JX).NE.ZERO) THEN
275
X(IX) = X(IX) + TEMP*A(I,J)
278
IF (NOUNIT) X(JX) = X(JX)*A(J,J)
231
* Form x := A'*x or x := conjg( A' )*x.
286
* Form x := A**T*x or x := A**H*x.
233
IF( LSAME( UPLO, 'U' ) )THEN
239
$ TEMP = TEMP*A( J, J )
240
DO 90, I = J - 1, 1, -1
241
TEMP = TEMP + A( I, J )*X( I )
245
$ TEMP = TEMP*DCONJG( A( J, J ) )
246
DO 100, I = J - 1, 1, -1
247
TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
253
JX = KX + ( N - 1 )*INCX
259
$ TEMP = TEMP*A( J, J )
260
DO 120, I = J - 1, 1, -1
262
TEMP = TEMP + A( I, J )*X( IX )
266
$ TEMP = TEMP*DCONJG( A( J, J ) )
267
DO 130, I = J - 1, 1, -1
269
TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
282
$ TEMP = TEMP*A( J, J )
284
TEMP = TEMP + A( I, J )*X( I )
288
$ TEMP = TEMP*DCONJG( A( J, J ) )
290
TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
302
$ TEMP = TEMP*A( J, J )
305
TEMP = TEMP + A( I, J )*X( IX )
309
$ TEMP = TEMP*DCONJG( A( J, J ) )
312
TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
288
IF (LSAME(UPLO,'U')) THEN
293
IF (NOUNIT) TEMP = TEMP*A(J,J)
295
TEMP = TEMP + A(I,J)*X(I)
298
IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
299
DO 100 I = J - 1,1,-1
300
TEMP = TEMP + DCONJG(A(I,J))*X(I)
311
IF (NOUNIT) TEMP = TEMP*A(J,J)
312
DO 120 I = J - 1,1,-1
314
TEMP = TEMP + A(I,J)*X(IX)
317
IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
318
DO 130 I = J - 1,1,-1
320
TEMP = TEMP + DCONJG(A(I,J))*X(IX)
332
IF (NOUNIT) TEMP = TEMP*A(J,J)
334
TEMP = TEMP + A(I,J)*X(I)
337
IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
339
TEMP = TEMP + DCONJG(A(I,J))*X(I)
350
IF (NOUNIT) TEMP = TEMP*A(J,J)
353
TEMP = TEMP + A(I,J)*X(IX)
356
IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
359
TEMP = TEMP + DCONJG(A(I,J))*X(IX)