1 SUBROUTINE CTBMV
(UPLO
,TRANS
,DIAG
,N
,K
,A
,LDA
,X
,INCX
)
2 * .. Scalar Arguments
..
4 CHARACTER DIAG
,TRANS
,UPLO
6 * .. Array Arguments
..
13 * CTBMV performs one of the matrix
-vector operations
15 * x
:= A*x
, or x
:= A
'*x, or x := conjg( A' )*x
,
17 * where x is an n element vector and A is an n by n unit
, or non
-unit
,
18 * upper or lower triangular band matrix
, with
( k
+ 1 ) diagonals
.
24 * On entry
, UPLO specifies whether the matrix is an upper or
25 * lower triangular matrix as follows
:
27 * UPLO
= 'U' or
'u' A is an upper triangular matrix
.
29 * UPLO
= 'L' or
'l' A is a lower triangular matrix
.
33 * TRANS
- CHARACTER*1
.
34 * On entry
, TRANS specifies the operation
to be performed as
37 * TRANS
= 'N' or
'n' x
:= A*x
.
39 * TRANS
= 'T' or
't' x
:= A
'*x.
41 * TRANS = 'C
' or 'c
' x := conjg( A' )*x
.
46 * On entry
, DIAG specifies whether or not A is unit
47 * triangular as follows
:
49 * DIAG
= 'U' or
'u' A is assumed
to be unit triangular
.
51 * DIAG
= 'N' or
'n' A is not assumed
to be unit
57 * On entry
, N specifies the order of the matrix A
.
58 * N must be at least zero
.
62 * On entry with UPLO
= 'U' or
'u', K specifies the number of
63 * super
-diagonals of the matrix A
.
64 * On entry with UPLO
= 'L' or
'l', K specifies the number of
65 * sub
-diagonals of the matrix A
.
66 * K must satisfy
0 .le
. K
.
69 * A
- COMPLEX array of
DIMENSION ( LDA
, n
).
70 * Before entry with UPLO
= 'U' or
'u', the leading
( k
+ 1 )
71 * by n part of the array A must contain the upper triangular
72 * band part of the matrix of coefficients
, supplied column by
73 * column
, with the leading diagonal of the matrix in row
74 * ( k
+ 1 ) of the array
, the first super
-diagonal starting at
75 * position
2 in row k
, and so on
. The top left k by k triangle
76 * of the array A is not referenced
.
77 * The following
program segment will transfer an upper
78 * triangular band matrix from conventional full matrix storage
83 * DO 10, I
= MAX
( 1, J
- K
), J
84 * A
( M
+ I
, J
) = matrix
( I
, J
)
88 * Before entry with UPLO
= 'L' or
'l', the leading
( k
+ 1 )
89 * by n part of the array A must contain the lower triangular
90 * band part of the matrix of coefficients
, supplied column by
91 * column
, with the leading diagonal of the matrix in row
1 of
92 * the array
, the first sub
-diagonal starting at position
1 in
93 * row
2, and so on
. The bottom right k by k triangle of the
94 * array A is not referenced
.
95 * The following
program segment will transfer a lower
96 * triangular band matrix from conventional full matrix storage
101 * DO 10, I
= J
, MIN
( N
, J
+ K
)
102 * A
( M
+ I
, J
) = matrix
( I
, J
)
106 * Note that when DIAG
= 'U' or
'u' the elements of the array A
107 * corresponding
to the diagonal elements of the matrix are not
108 * referenced
, but are assumed
to be unity
.
112 * On entry
, LDA specifies the first
dimension of A as declared
113 * in the calling
(sub
) program. LDA must be at least
117 * X
- COMPLEX array of
dimension at least
118 * ( 1 + ( n
- 1 )*abs
( INCX
) ).
119 * Before entry
, the incremented array X must contain the n
120 * element vector x
. On exit
, X is overwritten with the
121 * tranformed vector x
.
124 * On entry
, INCX specifies the increment
for the elements of
125 * X
. INCX must not be zero
.
131 * Level
2 Blas routine
.
133 * -- Written on
22-October
-1986.
134 * Jack Dongarra
, Argonne National Lab
.
135 * Jeremy Du Croz
, Nag Central Office
.
136 * Sven Hammarling
, Nag Central Office
.
137 * Richard Hanson
, Sandia National Labs
.
139 * =====================================================================
143 PARAMETER (ZERO
= (0.0E+0,0.0E+0))
145 * .. Local Scalars
..
147 INTEGER I
,INFO
,IX
,J
,JX
,KPLUS1
,KX
,L
148 LOGICAL NOCONJ
,NOUNIT
150 * .. External Functions
..
154 * .. External Subroutines
..
157 * .. Intrinsic Functions
..
158 INTRINSIC CONJG
,MAX
,MIN
161 * Test the input parameters
.
164 IF (.NOT
.LSAME
(UPLO
,'U') .AND
. .NOT
.LSAME
(UPLO
,'L')) THEN
166 ELSE IF (.NOT
.LSAME
(TRANS
,'N') .AND
. .NOT
.LSAME
(TRANS
,'T') .AND
.
167 + .NOT
.LSAME
(TRANS
,'C')) THEN
169 ELSE IF (.NOT
.LSAME
(DIAG
,'U') .AND
. .NOT
.LSAME
(DIAG
,'N')) THEN
171 ELSE IF (N
.LT
.0) THEN
173 ELSE IF (K
.LT
.0) THEN
175 ELSE IF (LDA
.LT
. (K
+1)) THEN
177 ELSE IF (INCX
.EQ
.0) THEN
181 CALL XERBLA
('CTBMV ',INFO
)
185 * Quick
return if possible
.
189 NOCONJ
= LSAME
(TRANS
,'T')
190 NOUNIT
= LSAME
(DIAG
,'N')
192 * Set up the start point in X
if the increment is not unity
. This
193 * will be
( N
- 1 )*INCX too small
for descending loops
.
197 ELSE IF (INCX
.NE
.1) THEN
201 * Start the operations
. In this version the elements of A are
202 * accessed sequentially with one pass through A
.
204 IF (LSAME
(TRANS
,'N')) THEN
208 IF (LSAME
(UPLO
,'U')) THEN
212 IF (X
(J
).NE
.ZERO
) THEN
215 DO 10 I
= MAX
(1,J
-K
),J
- 1
216 X
(I
) = X
(I
) + TEMP*A
(L
+I
,J
)
218 IF (NOUNIT
) X
(J
) = X
(J
)*A
(KPLUS1
,J
)
224 IF (X
(JX
).NE
.ZERO
) THEN
228 DO 30 I
= MAX
(1,J
-K
),J
- 1
229 X
(IX
) = X
(IX
) + TEMP*A
(L
+I
,J
)
232 IF (NOUNIT
) X
(JX
) = X
(JX
)*A
(KPLUS1
,J
)
235 IF (J
.GT
.K
) KX
= KX
+ INCX
241 IF (X
(J
).NE
.ZERO
) THEN
244 DO 50 I
= MIN
(N
,J
+K
),J
+ 1,-1
245 X
(I
) = X
(I
) + TEMP*A
(L
+I
,J
)
247 IF (NOUNIT
) X
(J
) = X
(J
)*A
(1,J
)
254 IF (X
(JX
).NE
.ZERO
) THEN
258 DO 70 I
= MIN
(N
,J
+K
),J
+ 1,-1
259 X
(IX
) = X
(IX
) + TEMP*A
(L
+I
,J
)
262 IF (NOUNIT
) X
(JX
) = X
(JX
)*A
(1,J
)
265 IF ((N
-J
).GE
.K
) KX
= KX
- INCX
271 * Form x
:= A
'*x or x := conjg( A' )*x
.
273 IF (LSAME
(UPLO
,'U')) THEN
280 IF (NOUNIT
) TEMP
= TEMP*A
(KPLUS1
,J
)
281 DO 90 I
= J
- 1,MAX
(1,J
-K
),-1
282 TEMP
= TEMP
+ A
(L
+I
,J
)*X
(I
)
285 IF (NOUNIT
) TEMP
= TEMP*CONJG
(A
(KPLUS1
,J
))
286 DO 100 I
= J
- 1,MAX
(1,J
-K
),-1
287 TEMP
= TEMP
+ CONJG
(A
(L
+I
,J
))*X
(I
)
301 IF (NOUNIT
) TEMP
= TEMP*A
(KPLUS1
,J
)
302 DO 120 I
= J
- 1,MAX
(1,J
-K
),-1
303 TEMP
= TEMP
+ A
(L
+I
,J
)*X
(IX
)
307 IF (NOUNIT
) TEMP
= TEMP*CONJG
(A
(KPLUS1
,J
))
308 DO 130 I
= J
- 1,MAX
(1,J
-K
),-1
309 TEMP
= TEMP
+ CONJG
(A
(L
+I
,J
))*X
(IX
)
323 IF (NOUNIT
) TEMP
= TEMP*A
(1,J
)
324 DO 150 I
= J
+ 1,MIN
(N
,J
+K
)
325 TEMP
= TEMP
+ A
(L
+I
,J
)*X
(I
)
328 IF (NOUNIT
) TEMP
= TEMP*CONJG
(A
(1,J
))
329 DO 160 I
= J
+ 1,MIN
(N
,J
+K
)
330 TEMP
= TEMP
+ CONJG
(A
(L
+I
,J
))*X
(I
)
343 IF (NOUNIT
) TEMP
= TEMP*A
(1,J
)
344 DO 180 I
= J
+ 1,MIN
(N
,J
+K
)
345 TEMP
= TEMP
+ A
(L
+I
,J
)*X
(IX
)
349 IF (NOUNIT
) TEMP
= TEMP*CONJG
(A
(1,J
))
350 DO 190 I
= J
+ 1,MIN
(N
,J
+K
)
351 TEMP
= TEMP
+ CONJG
(A
(L
+I
,J
))*X
(IX
)