1
SUBROUTINE CTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
2
* .. Scalar Arguments ..
3
INTEGER INCX, K, LDA, N
4
CHARACTER*1 DIAG, TRANS, UPLO
5
* .. Array Arguments ..
6
COMPLEX A( LDA, * ), X( * )
12
* CTBSV solves one of the systems of equations
14
* A*x = b, or A'*x = b, or conjg( A' )*x = b,
16
* where b and x are n element vectors and A is an n by n unit, or
17
* non-unit, upper or lower triangular band matrix, with ( k + 1 )
20
* No test for singularity or near-singularity is included in this
21
* routine. Such tests must be performed before calling this routine.
27
* On entry, UPLO specifies whether the matrix is an upper or
28
* lower triangular matrix as follows:
30
* UPLO = 'U' or 'u' A is an upper triangular matrix.
32
* UPLO = 'L' or 'l' A is a lower triangular matrix.
36
* TRANS - CHARACTER*1.
37
* On entry, TRANS specifies the equations to be solved as
40
* TRANS = 'N' or 'n' A*x = b.
42
* TRANS = 'T' or 't' A'*x = b.
44
* TRANS = 'C' or 'c' conjg( A' )*x = b.
49
* On entry, DIAG specifies whether or not A is unit
50
* triangular as follows:
52
* DIAG = 'U' or 'u' A is assumed to be unit triangular.
54
* DIAG = 'N' or 'n' A is not assumed to be unit
60
* On entry, N specifies the order of the matrix A.
61
* N must be at least zero.
65
* On entry with UPLO = 'U' or 'u', K specifies the number of
66
* super-diagonals of the matrix A.
67
* On entry with UPLO = 'L' or 'l', K specifies the number of
68
* sub-diagonals of the matrix A.
69
* K must satisfy 0 .le. K.
72
* A - COMPLEX array of DIMENSION ( LDA, n ).
73
* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
74
* by n part of the array A must contain the upper triangular
75
* band part of the matrix of coefficients, supplied column by
76
* column, with the leading diagonal of the matrix in row
77
* ( k + 1 ) of the array, the first super-diagonal starting at
78
* position 2 in row k, and so on. The top left k by k triangle
79
* of the array A is not referenced.
80
* The following program segment will transfer an upper
81
* triangular band matrix from conventional full matrix storage
86
* DO 10, I = MAX( 1, J - K ), J
87
* A( M + I, J ) = matrix( I, J )
91
* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
92
* by n part of the array A must contain the lower triangular
93
* band part of the matrix of coefficients, supplied column by
94
* column, with the leading diagonal of the matrix in row 1 of
95
* the array, the first sub-diagonal starting at position 1 in
96
* row 2, and so on. The bottom right k by k triangle of the
97
* array A is not referenced.
98
* The following program segment will transfer a lower
99
* triangular band matrix from conventional full matrix storage
104
* DO 10, I = J, MIN( N, J + K )
105
* A( M + I, J ) = matrix( I, J )
109
* Note that when DIAG = 'U' or 'u' the elements of the array A
110
* corresponding to the diagonal elements of the matrix are not
111
* referenced, but are assumed to be unity.
115
* On entry, LDA specifies the first dimension of A as declared
116
* in the calling (sub) program. LDA must be at least
120
* X - COMPLEX array of dimension at least
121
* ( 1 + ( n - 1 )*abs( INCX ) ).
122
* Before entry, the incremented array X must contain the n
123
* element right-hand side vector b. On exit, X is overwritten
124
* with the solution vector x.
127
* On entry, INCX specifies the increment for the elements of
128
* X. INCX must not be zero.
132
* Level 2 Blas routine.
134
* -- Written on 22-October-1986.
135
* Jack Dongarra, Argonne National Lab.
136
* Jeremy Du Croz, Nag Central Office.
137
* Sven Hammarling, Nag Central Office.
138
* Richard Hanson, Sandia National Labs.
143
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
144
* .. Local Scalars ..
146
INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
147
LOGICAL NOCONJ, NOUNIT
148
* .. External Functions ..
151
* .. External Subroutines ..
153
* .. Intrinsic Functions ..
154
INTRINSIC CONJG, MAX, MIN
156
* .. Executable Statements ..
158
* Test the input parameters.
161
IF ( .NOT.LSAME( UPLO , 'U' ).AND.
162
$ .NOT.LSAME( UPLO , 'L' ) )THEN
164
ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
165
$ .NOT.LSAME( TRANS, 'T' ).AND.
166
$ .NOT.LSAME( TRANS, 'C' ) )THEN
168
ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
169
$ .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( 'CTBSV ', INFO )
185
* Quick return if possible.
190
NOCONJ = LSAME( TRANS, 'T' )
191
NOUNIT = LSAME( DIAG , 'N' )
193
* Set up the start point in X if the increment is not unity. This
194
* will be ( N - 1 )*INCX too small for descending loops.
197
KX = 1 - ( N - 1 )*INCX
198
ELSE IF( INCX.NE.1 )THEN
202
* Start the operations. In this version the elements of A are
203
* accessed by sequentially with one pass through A.
205
IF( LSAME( TRANS, 'N' ) )THEN
207
* Form x := inv( A )*x.
209
IF( LSAME( UPLO, 'U' ) )THEN
213
IF( X( J ).NE.ZERO )THEN
216
$ X( J ) = X( J )/A( KPLUS1, J )
218
DO 10, I = J - 1, MAX( 1, J - K ), -1
219
X( I ) = X( I ) - TEMP*A( L + I, J )
224
KX = KX + ( N - 1 )*INCX
228
IF( X( JX ).NE.ZERO )THEN
232
$ X( JX ) = X( JX )/A( KPLUS1, J )
234
DO 30, I = J - 1, MAX( 1, J - K ), -1
235
X( IX ) = X( IX ) - TEMP*A( L + I, J )
245
IF( X( J ).NE.ZERO )THEN
248
$ X( J ) = X( J )/A( 1, J )
250
DO 50, I = J + 1, MIN( N, J + K )
251
X( I ) = X( I ) - TEMP*A( L + I, J )
259
IF( X( JX ).NE.ZERO )THEN
263
$ X( JX ) = X( JX )/A( 1, J )
265
DO 70, I = J + 1, MIN( N, J + K )
266
X( IX ) = X( IX ) - TEMP*A( L + I, J )
276
* Form x := inv( A' )*x or x := inv( conjg( A') )*x.
278
IF( LSAME( UPLO, 'U' ) )THEN
285
DO 90, I = MAX( 1, J - K ), J - 1
286
TEMP = TEMP - A( L + I, J )*X( I )
289
$ TEMP = TEMP/A( KPLUS1, J )
291
DO 100, I = MAX( 1, J - K ), J - 1
292
TEMP = TEMP - CONJG( A( L + I, J ) )*X( I )
295
$ TEMP = TEMP/CONJG( A( KPLUS1, J ) )
306
DO 120, I = MAX( 1, J - K ), J - 1
307
TEMP = TEMP - A( L + I, J )*X( IX )
311
$ TEMP = TEMP/A( KPLUS1, J )
313
DO 130, I = MAX( 1, J - K ), J - 1
314
TEMP = TEMP - CONJG( A( L + I, J ) )*X( IX )
318
$ TEMP = TEMP/CONJG( A( KPLUS1, J ) )
332
DO 150, I = MIN( N, J + K ), J + 1, -1
333
TEMP = TEMP - A( L + I, J )*X( I )
336
$ TEMP = TEMP/A( 1, J )
338
DO 160, I = MIN( N, J + K ), J + 1, -1
339
TEMP = TEMP - CONJG( A( L + I, J ) )*X( I )
342
$ TEMP = TEMP/CONJG( A( 1, J ) )
347
KX = KX + ( N - 1 )*INCX
354
DO 180, I = MIN( N, J + K ), J + 1, -1
355
TEMP = TEMP - A( L + I, J )*X( IX )
359
$ TEMP = TEMP/A( 1, J )
361
DO 190, I = MIN( N, J + K ), J + 1, -1
362
TEMP = TEMP - CONJG( A( L + I, J ) )*X( IX )
366
$ TEMP = TEMP/CONJG( A( 1, J ) )
added
removed
ARPACK/BLAS/ctbsv.f
