• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1 /* ctbmv.f -- translated by f2c (version 20100827).
2    You must link the resulting object file with libf2c:
3 	on Microsoft Windows system, link with libf2c.lib;
4 	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 	or, if you install libf2c.a in a standard place, with -lf2c -lm
6 	-- in that order, at the end of the command line, as in
7 		cc *.o -lf2c -lm
8 	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9 
10 		http://www.netlib.org/f2c/libf2c.zip
11 */
12 
13 #include "datatypes.h"
14 
ctbmv_(char * uplo,char * trans,char * diag,integer * n,integer * k,complex * a,integer * lda,complex * x,integer * incx,ftnlen uplo_len,ftnlen trans_len,ftnlen diag_len)15 /* Subroutine */ int ctbmv_(char *uplo, char *trans, char *diag, integer *n,
16 	integer *k, complex *a, integer *lda, complex *x, integer *incx,
17 	ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
18 {
19     /* System generated locals */
20     integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
21     complex q__1, q__2, q__3;
22 
23     /* Builtin functions */
24     void r_cnjg(complex *, complex *);
25 
26     /* Local variables */
27     integer i__, j, l, ix, jx, kx, info;
28     complex temp;
29     extern logical lsame_(char *, char *, ftnlen, ftnlen);
30     integer kplus1;
31     extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
32     logical noconj, nounit;
33 
34 /*     .. Scalar Arguments .. */
35 /*     .. */
36 /*     .. Array Arguments .. */
37 /*     .. */
38 
39 /*  Purpose */
40 /*  ======= */
41 
42 /*  CTBMV  performs one of the matrix-vector operations */
43 
44 /*     x := A*x,   or   x := A'*x,   or   x := conjg( A' )*x, */
45 
46 /*  where x is an n element vector and  A is an n by n unit, or non-unit, */
47 /*  upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
48 
49 /*  Arguments */
50 /*  ========== */
51 
52 /*  UPLO   - CHARACTER*1. */
53 /*           On entry, UPLO specifies whether the matrix is an upper or */
54 /*           lower triangular matrix as follows: */
55 
56 /*              UPLO = 'U' or 'u'   A is an upper triangular matrix. */
57 
58 /*              UPLO = 'L' or 'l'   A is a lower triangular matrix. */
59 
60 /*           Unchanged on exit. */
61 
62 /*  TRANS  - CHARACTER*1. */
63 /*           On entry, TRANS specifies the operation to be performed as */
64 /*           follows: */
65 
66 /*              TRANS = 'N' or 'n'   x := A*x. */
67 
68 /*              TRANS = 'T' or 't'   x := A'*x. */
69 
70 /*              TRANS = 'C' or 'c'   x := conjg( A' )*x. */
71 
72 /*           Unchanged on exit. */
73 
74 /*  DIAG   - CHARACTER*1. */
75 /*           On entry, DIAG specifies whether or not A is unit */
76 /*           triangular as follows: */
77 
78 /*              DIAG = 'U' or 'u'   A is assumed to be unit triangular. */
79 
80 /*              DIAG = 'N' or 'n'   A is not assumed to be unit */
81 /*                                  triangular. */
82 
83 /*           Unchanged on exit. */
84 
85 /*  N      - INTEGER. */
86 /*           On entry, N specifies the order of the matrix A. */
87 /*           N must be at least zero. */
88 /*           Unchanged on exit. */
89 
90 /*  K      - INTEGER. */
91 /*           On entry with UPLO = 'U' or 'u', K specifies the number of */
92 /*           super-diagonals of the matrix A. */
93 /*           On entry with UPLO = 'L' or 'l', K specifies the number of */
94 /*           sub-diagonals of the matrix A. */
95 /*           K must satisfy  0 .le. K. */
96 /*           Unchanged on exit. */
97 
98 /*  A      - COMPLEX          array of DIMENSION ( LDA, n ). */
99 /*           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
100 /*           by n part of the array A must contain the upper triangular */
101 /*           band part of the matrix of coefficients, supplied column by */
102 /*           column, with the leading diagonal of the matrix in row */
103 /*           ( k + 1 ) of the array, the first super-diagonal starting at */
104 /*           position 2 in row k, and so on. The top left k by k triangle */
105 /*           of the array A is not referenced. */
106 /*           The following program segment will transfer an upper */
107 /*           triangular band matrix from conventional full matrix storage */
108 /*           to band storage: */
109 
110 /*                 DO 20, J = 1, N */
111 /*                    M = K + 1 - J */
112 /*                    DO 10, I = MAX( 1, J - K ), J */
113 /*                       A( M + I, J ) = matrix( I, J ) */
114 /*              10    CONTINUE */
115 /*              20 CONTINUE */
116 
117 /*           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
118 /*           by n part of the array A must contain the lower triangular */
119 /*           band part of the matrix of coefficients, supplied column by */
120 /*           column, with the leading diagonal of the matrix in row 1 of */
121 /*           the array, the first sub-diagonal starting at position 1 in */
122 /*           row 2, and so on. The bottom right k by k triangle of the */
123 /*           array A is not referenced. */
124 /*           The following program segment will transfer a lower */
125 /*           triangular band matrix from conventional full matrix storage */
126 /*           to band storage: */
127 
128 /*                 DO 20, J = 1, N */
129 /*                    M = 1 - J */
130 /*                    DO 10, I = J, MIN( N, J + K ) */
131 /*                       A( M + I, J ) = matrix( I, J ) */
132 /*              10    CONTINUE */
133 /*              20 CONTINUE */
134 
135 /*           Note that when DIAG = 'U' or 'u' the elements of the array A */
136 /*           corresponding to the diagonal elements of the matrix are not */
137 /*           referenced, but are assumed to be unity. */
138 /*           Unchanged on exit. */
139 
140 /*  LDA    - INTEGER. */
141 /*           On entry, LDA specifies the first dimension of A as declared */
142 /*           in the calling (sub) program. LDA must be at least */
143 /*           ( k + 1 ). */
144 /*           Unchanged on exit. */
145 
146 /*  X      - COMPLEX          array of dimension at least */
147 /*           ( 1 + ( n - 1 )*abs( INCX ) ). */
148 /*           Before entry, the incremented array X must contain the n */
149 /*           element vector x. On exit, X is overwritten with the */
150 /*           tranformed vector x. */
151 
152 /*  INCX   - INTEGER. */
153 /*           On entry, INCX specifies the increment for the elements of */
154 /*           X. INCX must not be zero. */
155 /*           Unchanged on exit. */
156 
157 /*  Further Details */
158 /*  =============== */
159 
160 /*  Level 2 Blas routine. */
161 
162 /*  -- Written on 22-October-1986. */
163 /*     Jack Dongarra, Argonne National Lab. */
164 /*     Jeremy Du Croz, Nag Central Office. */
165 /*     Sven Hammarling, Nag Central Office. */
166 /*     Richard Hanson, Sandia National Labs. */
167 
168 /*  ===================================================================== */
169 
170 /*     .. Parameters .. */
171 /*     .. */
172 /*     .. Local Scalars .. */
173 /*     .. */
174 /*     .. External Functions .. */
175 /*     .. */
176 /*     .. External Subroutines .. */
177 /*     .. */
178 /*     .. Intrinsic Functions .. */
179 /*     .. */
180 
181 /*     Test the input parameters. */
182 
183     /* Parameter adjustments */
184     a_dim1 = *lda;
185     a_offset = 1 + a_dim1;
186     a -= a_offset;
187     --x;
188 
189     /* Function Body */
190     info = 0;
191     if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
192 	    ftnlen)1, (ftnlen)1)) {
193 	info = 1;
194     } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans,
195 	    "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (
196 	    ftnlen)1)) {
197 	info = 2;
198     } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag,
199 	    "N", (ftnlen)1, (ftnlen)1)) {
200 	info = 3;
201     } else if (*n < 0) {
202 	info = 4;
203     } else if (*k < 0) {
204 	info = 5;
205     } else if (*lda < *k + 1) {
206 	info = 7;
207     } else if (*incx == 0) {
208 	info = 9;
209     }
210     if (info != 0) {
211 	xerbla_("CTBMV ", &info, (ftnlen)6);
212 	return 0;
213     }
214 
215 /*     Quick return if possible. */
216 
217     if (*n == 0) {
218 	return 0;
219     }
220 
221     noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
222     nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
223 
224 /*     Set up the start point in X if the increment is not unity. This */
225 /*     will be  ( N - 1 )*INCX   too small for descending loops. */
226 
227     if (*incx <= 0) {
228 	kx = 1 - (*n - 1) * *incx;
229     } else if (*incx != 1) {
230 	kx = 1;
231     }
232 
233 /*     Start the operations. In this version the elements of A are */
234 /*     accessed sequentially with one pass through A. */
235 
236     if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
237 
238 /*         Form  x := A*x. */
239 
240 	if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
241 	    kplus1 = *k + 1;
242 	    if (*incx == 1) {
243 		i__1 = *n;
244 		for (j = 1; j <= i__1; ++j) {
245 		    i__2 = j;
246 		    if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
247 			i__2 = j;
248 			temp.r = x[i__2].r, temp.i = x[i__2].i;
249 			l = kplus1 - j;
250 /* Computing MAX */
251 			i__2 = 1, i__3 = j - *k;
252 			i__4 = j - 1;
253 			for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
254 			    i__2 = i__;
255 			    i__3 = i__;
256 			    i__5 = l + i__ + j * a_dim1;
257 			    q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
258 				    q__2.i = temp.r * a[i__5].i + temp.i * a[
259 				    i__5].r;
260 			    q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +
261 				    q__2.i;
262 			    x[i__2].r = q__1.r, x[i__2].i = q__1.i;
263 /* L10: */
264 			}
265 			if (nounit) {
266 			    i__4 = j;
267 			    i__2 = j;
268 			    i__3 = kplus1 + j * a_dim1;
269 			    q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
270 				    i__3].i, q__1.i = x[i__2].r * a[i__3].i +
271 				    x[i__2].i * a[i__3].r;
272 			    x[i__4].r = q__1.r, x[i__4].i = q__1.i;
273 			}
274 		    }
275 /* L20: */
276 		}
277 	    } else {
278 		jx = kx;
279 		i__1 = *n;
280 		for (j = 1; j <= i__1; ++j) {
281 		    i__4 = jx;
282 		    if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
283 			i__4 = jx;
284 			temp.r = x[i__4].r, temp.i = x[i__4].i;
285 			ix = kx;
286 			l = kplus1 - j;
287 /* Computing MAX */
288 			i__4 = 1, i__2 = j - *k;
289 			i__3 = j - 1;
290 			for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
291 			    i__4 = ix;
292 			    i__2 = ix;
293 			    i__5 = l + i__ + j * a_dim1;
294 			    q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
295 				    q__2.i = temp.r * a[i__5].i + temp.i * a[
296 				    i__5].r;
297 			    q__1.r = x[i__2].r + q__2.r, q__1.i = x[i__2].i +
298 				    q__2.i;
299 			    x[i__4].r = q__1.r, x[i__4].i = q__1.i;
300 			    ix += *incx;
301 /* L30: */
302 			}
303 			if (nounit) {
304 			    i__3 = jx;
305 			    i__4 = jx;
306 			    i__2 = kplus1 + j * a_dim1;
307 			    q__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[
308 				    i__2].i, q__1.i = x[i__4].r * a[i__2].i +
309 				    x[i__4].i * a[i__2].r;
310 			    x[i__3].r = q__1.r, x[i__3].i = q__1.i;
311 			}
312 		    }
313 		    jx += *incx;
314 		    if (j > *k) {
315 			kx += *incx;
316 		    }
317 /* L40: */
318 		}
319 	    }
320 	} else {
321 	    if (*incx == 1) {
322 		for (j = *n; j >= 1; --j) {
323 		    i__1 = j;
324 		    if (x[i__1].r != 0.f || x[i__1].i != 0.f) {
325 			i__1 = j;
326 			temp.r = x[i__1].r, temp.i = x[i__1].i;
327 			l = 1 - j;
328 /* Computing MIN */
329 			i__1 = *n, i__3 = j + *k;
330 			i__4 = j + 1;
331 			for (i__ = min(i__1,i__3); i__ >= i__4; --i__) {
332 			    i__1 = i__;
333 			    i__3 = i__;
334 			    i__2 = l + i__ + j * a_dim1;
335 			    q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
336 				    q__2.i = temp.r * a[i__2].i + temp.i * a[
337 				    i__2].r;
338 			    q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +
339 				    q__2.i;
340 			    x[i__1].r = q__1.r, x[i__1].i = q__1.i;
341 /* L50: */
342 			}
343 			if (nounit) {
344 			    i__4 = j;
345 			    i__1 = j;
346 			    i__3 = j * a_dim1 + 1;
347 			    q__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[
348 				    i__3].i, q__1.i = x[i__1].r * a[i__3].i +
349 				    x[i__1].i * a[i__3].r;
350 			    x[i__4].r = q__1.r, x[i__4].i = q__1.i;
351 			}
352 		    }
353 /* L60: */
354 		}
355 	    } else {
356 		kx += (*n - 1) * *incx;
357 		jx = kx;
358 		for (j = *n; j >= 1; --j) {
359 		    i__4 = jx;
360 		    if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
361 			i__4 = jx;
362 			temp.r = x[i__4].r, temp.i = x[i__4].i;
363 			ix = kx;
364 			l = 1 - j;
365 /* Computing MIN */
366 			i__4 = *n, i__1 = j + *k;
367 			i__3 = j + 1;
368 			for (i__ = min(i__4,i__1); i__ >= i__3; --i__) {
369 			    i__4 = ix;
370 			    i__1 = ix;
371 			    i__2 = l + i__ + j * a_dim1;
372 			    q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
373 				    q__2.i = temp.r * a[i__2].i + temp.i * a[
374 				    i__2].r;
375 			    q__1.r = x[i__1].r + q__2.r, q__1.i = x[i__1].i +
376 				    q__2.i;
377 			    x[i__4].r = q__1.r, x[i__4].i = q__1.i;
378 			    ix -= *incx;
379 /* L70: */
380 			}
381 			if (nounit) {
382 			    i__3 = jx;
383 			    i__4 = jx;
384 			    i__1 = j * a_dim1 + 1;
385 			    q__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[
386 				    i__1].i, q__1.i = x[i__4].r * a[i__1].i +
387 				    x[i__4].i * a[i__1].r;
388 			    x[i__3].r = q__1.r, x[i__3].i = q__1.i;
389 			}
390 		    }
391 		    jx -= *incx;
392 		    if (*n - j >= *k) {
393 			kx -= *incx;
394 		    }
395 /* L80: */
396 		}
397 	    }
398 	}
399     } else {
400 
401 /*        Form  x := A'*x  or  x := conjg( A' )*x. */
402 
403 	if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
404 	    kplus1 = *k + 1;
405 	    if (*incx == 1) {
406 		for (j = *n; j >= 1; --j) {
407 		    i__3 = j;
408 		    temp.r = x[i__3].r, temp.i = x[i__3].i;
409 		    l = kplus1 - j;
410 		    if (noconj) {
411 			if (nounit) {
412 			    i__3 = kplus1 + j * a_dim1;
413 			    q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
414 				    q__1.i = temp.r * a[i__3].i + temp.i * a[
415 				    i__3].r;
416 			    temp.r = q__1.r, temp.i = q__1.i;
417 			}
418 /* Computing MAX */
419 			i__4 = 1, i__1 = j - *k;
420 			i__3 = max(i__4,i__1);
421 			for (i__ = j - 1; i__ >= i__3; --i__) {
422 			    i__4 = l + i__ + j * a_dim1;
423 			    i__1 = i__;
424 			    q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
425 				    i__1].i, q__2.i = a[i__4].r * x[i__1].i +
426 				    a[i__4].i * x[i__1].r;
427 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
428 				    q__2.i;
429 			    temp.r = q__1.r, temp.i = q__1.i;
430 /* L90: */
431 			}
432 		    } else {
433 			if (nounit) {
434 			    r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
435 			    q__1.r = temp.r * q__2.r - temp.i * q__2.i,
436 				    q__1.i = temp.r * q__2.i + temp.i *
437 				    q__2.r;
438 			    temp.r = q__1.r, temp.i = q__1.i;
439 			}
440 /* Computing MAX */
441 			i__4 = 1, i__1 = j - *k;
442 			i__3 = max(i__4,i__1);
443 			for (i__ = j - 1; i__ >= i__3; --i__) {
444 			    r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
445 			    i__4 = i__;
446 			    q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i,
447 				    q__2.i = q__3.r * x[i__4].i + q__3.i * x[
448 				    i__4].r;
449 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
450 				    q__2.i;
451 			    temp.r = q__1.r, temp.i = q__1.i;
452 /* L100: */
453 			}
454 		    }
455 		    i__3 = j;
456 		    x[i__3].r = temp.r, x[i__3].i = temp.i;
457 /* L110: */
458 		}
459 	    } else {
460 		kx += (*n - 1) * *incx;
461 		jx = kx;
462 		for (j = *n; j >= 1; --j) {
463 		    i__3 = jx;
464 		    temp.r = x[i__3].r, temp.i = x[i__3].i;
465 		    kx -= *incx;
466 		    ix = kx;
467 		    l = kplus1 - j;
468 		    if (noconj) {
469 			if (nounit) {
470 			    i__3 = kplus1 + j * a_dim1;
471 			    q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
472 				    q__1.i = temp.r * a[i__3].i + temp.i * a[
473 				    i__3].r;
474 			    temp.r = q__1.r, temp.i = q__1.i;
475 			}
476 /* Computing MAX */
477 			i__4 = 1, i__1 = j - *k;
478 			i__3 = max(i__4,i__1);
479 			for (i__ = j - 1; i__ >= i__3; --i__) {
480 			    i__4 = l + i__ + j * a_dim1;
481 			    i__1 = ix;
482 			    q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
483 				    i__1].i, q__2.i = a[i__4].r * x[i__1].i +
484 				    a[i__4].i * x[i__1].r;
485 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
486 				    q__2.i;
487 			    temp.r = q__1.r, temp.i = q__1.i;
488 			    ix -= *incx;
489 /* L120: */
490 			}
491 		    } else {
492 			if (nounit) {
493 			    r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
494 			    q__1.r = temp.r * q__2.r - temp.i * q__2.i,
495 				    q__1.i = temp.r * q__2.i + temp.i *
496 				    q__2.r;
497 			    temp.r = q__1.r, temp.i = q__1.i;
498 			}
499 /* Computing MAX */
500 			i__4 = 1, i__1 = j - *k;
501 			i__3 = max(i__4,i__1);
502 			for (i__ = j - 1; i__ >= i__3; --i__) {
503 			    r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
504 			    i__4 = ix;
505 			    q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i,
506 				    q__2.i = q__3.r * x[i__4].i + q__3.i * x[
507 				    i__4].r;
508 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
509 				    q__2.i;
510 			    temp.r = q__1.r, temp.i = q__1.i;
511 			    ix -= *incx;
512 /* L130: */
513 			}
514 		    }
515 		    i__3 = jx;
516 		    x[i__3].r = temp.r, x[i__3].i = temp.i;
517 		    jx -= *incx;
518 /* L140: */
519 		}
520 	    }
521 	} else {
522 	    if (*incx == 1) {
523 		i__3 = *n;
524 		for (j = 1; j <= i__3; ++j) {
525 		    i__4 = j;
526 		    temp.r = x[i__4].r, temp.i = x[i__4].i;
527 		    l = 1 - j;
528 		    if (noconj) {
529 			if (nounit) {
530 			    i__4 = j * a_dim1 + 1;
531 			    q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
532 				    q__1.i = temp.r * a[i__4].i + temp.i * a[
533 				    i__4].r;
534 			    temp.r = q__1.r, temp.i = q__1.i;
535 			}
536 /* Computing MIN */
537 			i__1 = *n, i__2 = j + *k;
538 			i__4 = min(i__1,i__2);
539 			for (i__ = j + 1; i__ <= i__4; ++i__) {
540 			    i__1 = l + i__ + j * a_dim1;
541 			    i__2 = i__;
542 			    q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
543 				    i__2].i, q__2.i = a[i__1].r * x[i__2].i +
544 				    a[i__1].i * x[i__2].r;
545 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
546 				    q__2.i;
547 			    temp.r = q__1.r, temp.i = q__1.i;
548 /* L150: */
549 			}
550 		    } else {
551 			if (nounit) {
552 			    r_cnjg(&q__2, &a[j * a_dim1 + 1]);
553 			    q__1.r = temp.r * q__2.r - temp.i * q__2.i,
554 				    q__1.i = temp.r * q__2.i + temp.i *
555 				    q__2.r;
556 			    temp.r = q__1.r, temp.i = q__1.i;
557 			}
558 /* Computing MIN */
559 			i__1 = *n, i__2 = j + *k;
560 			i__4 = min(i__1,i__2);
561 			for (i__ = j + 1; i__ <= i__4; ++i__) {
562 			    r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
563 			    i__1 = i__;
564 			    q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,
565 				    q__2.i = q__3.r * x[i__1].i + q__3.i * x[
566 				    i__1].r;
567 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
568 				    q__2.i;
569 			    temp.r = q__1.r, temp.i = q__1.i;
570 /* L160: */
571 			}
572 		    }
573 		    i__4 = j;
574 		    x[i__4].r = temp.r, x[i__4].i = temp.i;
575 /* L170: */
576 		}
577 	    } else {
578 		jx = kx;
579 		i__3 = *n;
580 		for (j = 1; j <= i__3; ++j) {
581 		    i__4 = jx;
582 		    temp.r = x[i__4].r, temp.i = x[i__4].i;
583 		    kx += *incx;
584 		    ix = kx;
585 		    l = 1 - j;
586 		    if (noconj) {
587 			if (nounit) {
588 			    i__4 = j * a_dim1 + 1;
589 			    q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
590 				    q__1.i = temp.r * a[i__4].i + temp.i * a[
591 				    i__4].r;
592 			    temp.r = q__1.r, temp.i = q__1.i;
593 			}
594 /* Computing MIN */
595 			i__1 = *n, i__2 = j + *k;
596 			i__4 = min(i__1,i__2);
597 			for (i__ = j + 1; i__ <= i__4; ++i__) {
598 			    i__1 = l + i__ + j * a_dim1;
599 			    i__2 = ix;
600 			    q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
601 				    i__2].i, q__2.i = a[i__1].r * x[i__2].i +
602 				    a[i__1].i * x[i__2].r;
603 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
604 				    q__2.i;
605 			    temp.r = q__1.r, temp.i = q__1.i;
606 			    ix += *incx;
607 /* L180: */
608 			}
609 		    } else {
610 			if (nounit) {
611 			    r_cnjg(&q__2, &a[j * a_dim1 + 1]);
612 			    q__1.r = temp.r * q__2.r - temp.i * q__2.i,
613 				    q__1.i = temp.r * q__2.i + temp.i *
614 				    q__2.r;
615 			    temp.r = q__1.r, temp.i = q__1.i;
616 			}
617 /* Computing MIN */
618 			i__1 = *n, i__2 = j + *k;
619 			i__4 = min(i__1,i__2);
620 			for (i__ = j + 1; i__ <= i__4; ++i__) {
621 			    r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
622 			    i__1 = ix;
623 			    q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,
624 				    q__2.i = q__3.r * x[i__1].i + q__3.i * x[
625 				    i__1].r;
626 			    q__1.r = temp.r + q__2.r, q__1.i = temp.i +
627 				    q__2.i;
628 			    temp.r = q__1.r, temp.i = q__1.i;
629 			    ix += *incx;
630 /* L190: */
631 			}
632 		    }
633 		    i__4 = jx;
634 		    x[i__4].r = temp.r, x[i__4].i = temp.i;
635 		    jx += *incx;
636 /* L200: */
637 		}
638 	    }
639 	}
640     }
641 
642     return 0;
643 
644 /*     End of CTBMV . */
645 
646 } /* ctbmv_ */
647 
648