1 /*
3 BLIS
4 An object-based framework for developing high-performance BLAS-like
5 libraries.
7 Copyright (C) 2014, The University of Texas at Austin
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions are
11 met:
12 - Redistributions of source code must retain the above copyright
13 notice, this list of conditions and the following disclaimer.
14 - Redistributions in binary form must reproduce the above copyright
15 notice, this list of conditions and the following disclaimer in the
16 documentation and/or other materials provided with the distribution.
17 - Neither the name of The University of Texas at Austin nor the names
18 of its contributors may be used to endorse or promote products
19 derived from this software without specific prior written permission.
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33 */
35 #include "blis.h"
37 #ifdef BLIS_ENABLE_BLAS2BLIS
39 /* dsbmv.f -- translated by f2c (version 19991025).
40 You must link the resulting object file with the libraries:
41 -lf2c -lm (in that order)
42 */
44 /* Subroutine */ int PASTEF77(d,sbmv)(character *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy)
45 {
46 /* System generated locals */
47 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
49 /* Local variables */
50 integer info;
51 doublereal temp1, temp2;
52 integer i__, j, l;
53 extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen);
54 integer kplus1, ix, iy, jx, jy, kx, ky;
55 extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen);
57 /* .. Scalar Arguments .. */
58 /* .. Array Arguments .. */
59 /* .. */
61 /* Purpose */
62 /* ======= */
64 /* DSBMV performs the matrix-vector operation */
66 /* y := alpha*A*x + beta*y, */
68 /* where alpha and beta are scalars, x and y are n element vectors and */
69 /* A is an n by n symmetric band matrix, with k super-diagonals. */
71 /* Parameters */
72 /* ========== */
74 /* UPLO - CHARACTER*1. */
75 /* On entry, UPLO specifies whether the upper or lower */
76 /* triangular part of the band matrix A is being supplied as */
77 /* follows: */
79 /* UPLO = 'U' or 'u' The upper triangular part of A is */
80 /* being supplied. */
82 /* UPLO = 'L' or 'l' The lower triangular part of A is */
83 /* being supplied. */
85 /* Unchanged on exit. */
87 /* N - INTEGER. */
88 /* On entry, N specifies the order of the matrix A. */
89 /* N must be at least zero. */
90 /* Unchanged on exit. */
92 /* K - INTEGER. */
93 /* On entry, K specifies the number of super-diagonals of the */
94 /* matrix A. K must satisfy 0 .le. K. */
95 /* Unchanged on exit. */
97 /* ALPHA - DOUBLE PRECISION. */
98 /* On entry, ALPHA specifies the scalar alpha. */
99 /* Unchanged on exit. */
101 /* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
102 /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
103 /* by n part of the array A must contain the upper triangular */
104 /* band part of the symmetric matrix, supplied column by */
105 /* column, with the leading diagonal of the matrix in row */
106 /* ( k + 1 ) of the array, the first super-diagonal starting at */
107 /* position 2 in row k, and so on. The top left k by k triangle */
108 /* of the array A is not referenced. */
109 /* The following program segment will transfer the upper */
110 /* triangular part of a symmetric band matrix from conventional */
111 /* full matrix storage to band storage: */
113 /* DO 20, J = 1, N */
114 /* M = K + 1 - J */
115 /* DO 10, I = MAX( 1, J - K ), J */
116 /* A( M + I, J ) = matrix( I, J ) */
117 /* 10 CONTINUE */
118 /* 20 CONTINUE */
120 /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
121 /* by n part of the array A must contain the lower triangular */
122 /* band part of the symmetric matrix, supplied column by */
123 /* column, with the leading diagonal of the matrix in row 1 of */
124 /* the array, the first sub-diagonal starting at position 1 in */
125 /* row 2, and so on. The bottom right k by k triangle of the */
126 /* array A is not referenced. */
127 /* The following program segment will transfer the lower */
128 /* triangular part of a symmetric band matrix from conventional */
129 /* full matrix storage to band storage: */
131 /* DO 20, J = 1, N */
132 /* M = 1 - J */
133 /* DO 10, I = J, MIN( N, J + K ) */
134 /* A( M + I, J ) = matrix( I, J ) */
135 /* 10 CONTINUE */
136 /* 20 CONTINUE */
138 /* Unchanged on exit. */
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. */
146 /* X - DOUBLE PRECISION array of DIMENSION at least */
147 /* ( 1 + ( n - 1 )*abs( INCX ) ). */
148 /* Before entry, the incremented array X must contain the */
149 /* vector x. */
150 /* Unchanged on exit. */
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. */
157 /* BETA - DOUBLE PRECISION. */
158 /* On entry, BETA specifies the scalar beta. */
159 /* Unchanged on exit. */
161 /* Y - DOUBLE PRECISION array of DIMENSION at least */
162 /* ( 1 + ( n - 1 )*abs( INCY ) ). */
163 /* Before entry, the incremented array Y must contain the */
164 /* vector y. On exit, Y is overwritten by the updated vector y. */
166 /* INCY - INTEGER. */
167 /* On entry, INCY specifies the increment for the elements of */
168 /* Y. INCY must not be zero. */
169 /* Unchanged on exit. */
172 /* Level 2 Blas routine. */
174 /* -- Written on 22-October-1986. */
175 /* Jack Dongarra, Argonne National Lab. */
176 /* Jeremy Du Croz, Nag Central Office. */
177 /* Sven Hammarling, Nag Central Office. */
178 /* Richard Hanson, Sandia National Labs. */
181 /* .. Parameters .. */
182 /* .. Local Scalars .. */
183 /* .. External Functions .. */
184 /* .. External Subroutines .. */
185 /* .. Intrinsic Functions .. */
186 /* .. */
187 /* .. Executable Statements .. */
189 /* Test the input parameters. */
191 /* Parameter adjustments */
192 a_dim1 = *lda;
193 a_offset = 1 + a_dim1 * 1;
194 a -= a_offset;
195 --x;
196 --y;
198 /* Function Body */
199 info = 0;
200 if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", (
201 ftnlen)1, (ftnlen)1)) {
202 info = 1;
203 } else if (*n < 0) {
204 info = 2;
205 } else if (*k < 0) {
206 info = 3;
207 } else if (*lda < *k + 1) {
208 info = 6;
209 } else if (*incx == 0) {
210 info = 8;
211 } else if (*incy == 0) {
212 info = 11;
213 }
214 if (info != 0) {
215 PASTEF770(xerbla)("DSBMV ", &info, (ftnlen)6);
216 return 0;
217 }
219 /* Quick return if possible. */
221 if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
222 return 0;
223 }
225 /* Set up the start points in X and Y. */
227 if (*incx > 0) {
228 kx = 1;
229 } else {
230 kx = 1 - (*n - 1) * *incx;
231 }
232 if (*incy > 0) {
233 ky = 1;
234 } else {
235 ky = 1 - (*n - 1) * *incy;
236 }
238 /* Start the operations. In this version the elements of the array A */
239 /* are accessed sequentially with one pass through A. */
241 /* First form y := beta*y. */
243 if (*beta != 1.) {
244 if (*incy == 1) {
245 if (*beta == 0.) {
246 i__1 = *n;
247 for (i__ = 1; i__ <= i__1; ++i__) {
248 y[i__] = 0.;
249 /* L10: */
250 }
251 } else {
252 i__1 = *n;
253 for (i__ = 1; i__ <= i__1; ++i__) {
254 y[i__] = *beta * y[i__];
255 /* L20: */
256 }
257 }
258 } else {
259 iy = ky;
260 if (*beta == 0.) {
261 i__1 = *n;
262 for (i__ = 1; i__ <= i__1; ++i__) {
263 y[iy] = 0.;
264 iy += *incy;
265 /* L30: */
266 }
267 } else {
268 i__1 = *n;
269 for (i__ = 1; i__ <= i__1; ++i__) {
270 y[iy] = *beta * y[iy];
271 iy += *incy;
272 /* L40: */
273 }
274 }
275 }
276 }
277 if (*alpha == 0.) {
278 return 0;
279 }
280 if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) {
282 /* Form y when upper triangle of A is stored. */
284 kplus1 = *k + 1;
285 if (*incx == 1 && *incy == 1) {
286 i__1 = *n;
287 for (j = 1; j <= i__1; ++j) {
288 temp1 = *alpha * x[j];
289 temp2 = 0.;
290 l = kplus1 - j;
291 /* Computing MAX */
292 i__2 = 1, i__3 = j - *k;
293 i__4 = j - 1;
294 for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) {
295 y[i__] += temp1 * a[l + i__ + j * a_dim1];
296 temp2 += a[l + i__ + j * a_dim1] * x[i__];
297 /* L50: */
298 }
299 y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
300 /* L60: */
301 }
302 } else {
303 jx = kx;
304 jy = ky;
305 i__1 = *n;
306 for (j = 1; j <= i__1; ++j) {
307 temp1 = *alpha * x[jx];
308 temp2 = 0.;
309 ix = kx;
310 iy = ky;
311 l = kplus1 - j;
312 /* Computing MAX */
313 i__4 = 1, i__2 = j - *k;
314 i__3 = j - 1;
315 for (i__ = f2c_max(i__4,i__2); i__ <= i__3; ++i__) {
316 y[iy] += temp1 * a[l + i__ + j * a_dim1];
317 temp2 += a[l + i__ + j * a_dim1] * x[ix];
318 ix += *incx;
319 iy += *incy;
320 /* L70: */
321 }
322 y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha *
323 temp2;
324 jx += *incx;
325 jy += *incy;
326 if (j > *k) {
327 kx += *incx;
328 ky += *incy;
329 }
330 /* L80: */
331 }
332 }
333 } else {
335 /* Form y when lower triangle of A is stored. */
337 if (*incx == 1 && *incy == 1) {
338 i__1 = *n;
339 for (j = 1; j <= i__1; ++j) {
340 temp1 = *alpha * x[j];
341 temp2 = 0.;
342 y[j] += temp1 * a[j * a_dim1 + 1];
343 l = 1 - j;
344 /* Computing MIN */
345 i__4 = *n, i__2 = j + *k;
346 i__3 = f2c_min(i__4,i__2);
347 for (i__ = j + 1; i__ <= i__3; ++i__) {
348 y[i__] += temp1 * a[l + i__ + j * a_dim1];
349 temp2 += a[l + i__ + j * a_dim1] * x[i__];
350 /* L90: */
351 }
352 y[j] += *alpha * temp2;
353 /* L100: */
354 }
355 } else {
356 jx = kx;
357 jy = ky;
358 i__1 = *n;
359 for (j = 1; j <= i__1; ++j) {
360 temp1 = *alpha * x[jx];
361 temp2 = 0.;
362 y[jy] += temp1 * a[j * a_dim1 + 1];
363 l = 1 - j;
364 ix = jx;
365 iy = jy;
366 /* Computing MIN */
367 i__4 = *n, i__2 = j + *k;
368 i__3 = f2c_min(i__4,i__2);
369 for (i__ = j + 1; i__ <= i__3; ++i__) {
370 ix += *incx;
371 iy += *incy;
372 y[iy] += temp1 * a[l + i__ + j * a_dim1];
373 temp2 += a[l + i__ + j * a_dim1] * x[ix];
374 /* L110: */
375 }
376 y[jy] += *alpha * temp2;
377 jx += *incx;
378 jy += *incy;
379 /* L120: */
380 }
381 }
382 }
384 return 0;
386 /* End of DSBMV . */
388 } /* dsbmv_ */
390 /* ssbmv.f -- translated by f2c (version 19991025).
391 You must link the resulting object file with the libraries:
392 -lf2c -lm (in that order)
393 */
395 /* Subroutine */ int PASTEF77(s,sbmv)(character *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x, integer *incx, real *beta, real *y, integer *incy)
396 {
397 /* System generated locals */
398 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
400 /* Local variables */
401 integer info;
402 real temp1, temp2;
403 integer i__, j, l;
404 extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen);
405 integer kplus1, ix, iy, jx, jy, kx, ky;
406 extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen);
408 /* .. Scalar Arguments .. */
409 /* .. Array Arguments .. */
410 /* .. */
412 /* Purpose */
413 /* ======= */
415 /* SSBMV performs the matrix-vector operation */
417 /* y := alpha*A*x + beta*y, */
419 /* where alpha and beta are scalars, x and y are n element vectors and */
420 /* A is an n by n symmetric band matrix, with k super-diagonals. */
422 /* Parameters */
423 /* ========== */
425 /* UPLO - CHARACTER*1. */
426 /* On entry, UPLO specifies whether the upper or lower */
427 /* triangular part of the band matrix A is being supplied as */
428 /* follows: */
430 /* UPLO = 'U' or 'u' The upper triangular part of A is */
431 /* being supplied. */
433 /* UPLO = 'L' or 'l' The lower triangular part of A is */
434 /* being supplied. */
436 /* Unchanged on exit. */
438 /* N - INTEGER. */
439 /* On entry, N specifies the order of the matrix A. */
440 /* N must be at least zero. */
441 /* Unchanged on exit. */
443 /* K - INTEGER. */
444 /* On entry, K specifies the number of super-diagonals of the */
445 /* matrix A. K must satisfy 0 .le. K. */
446 /* Unchanged on exit. */
448 /* ALPHA - REAL . */
449 /* On entry, ALPHA specifies the scalar alpha. */
450 /* Unchanged on exit. */
452 /* A - REAL array of DIMENSION ( LDA, n ). */
453 /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
454 /* by n part of the array A must contain the upper triangular */
455 /* band part of the symmetric matrix, supplied column by */
456 /* column, with the leading diagonal of the matrix in row */
457 /* ( k + 1 ) of the array, the first super-diagonal starting at */
458 /* position 2 in row k, and so on. The top left k by k triangle */
459 /* of the array A is not referenced. */
460 /* The following program segment will transfer the upper */
461 /* triangular part of a symmetric band matrix from conventional */
462 /* full matrix storage to band storage: */
464 /* DO 20, J = 1, N */
465 /* M = K + 1 - J */
466 /* DO 10, I = MAX( 1, J - K ), J */
467 /* A( M + I, J ) = matrix( I, J ) */
468 /* 10 CONTINUE */
469 /* 20 CONTINUE */
471 /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
472 /* by n part of the array A must contain the lower triangular */
473 /* band part of the symmetric matrix, supplied column by */
474 /* column, with the leading diagonal of the matrix in row 1 of */
475 /* the array, the first sub-diagonal starting at position 1 in */
476 /* row 2, and so on. The bottom right k by k triangle of the */
477 /* array A is not referenced. */
478 /* The following program segment will transfer the lower */
479 /* triangular part of a symmetric band matrix from conventional */
480 /* full matrix storage to band storage: */
482 /* DO 20, J = 1, N */
483 /* M = 1 - J */
484 /* DO 10, I = J, MIN( N, J + K ) */
485 /* A( M + I, J ) = matrix( I, J ) */
486 /* 10 CONTINUE */
487 /* 20 CONTINUE */
489 /* Unchanged on exit. */
491 /* LDA - INTEGER. */
492 /* On entry, LDA specifies the first dimension of A as declared */
493 /* in the calling (sub) program. LDA must be at least */
494 /* ( k + 1 ). */
495 /* Unchanged on exit. */
497 /* X - REAL array of DIMENSION at least */
498 /* ( 1 + ( n - 1 )*abs( INCX ) ). */
499 /* Before entry, the incremented array X must contain the */
500 /* vector x. */
501 /* Unchanged on exit. */
503 /* INCX - INTEGER. */
504 /* On entry, INCX specifies the increment for the elements of */
505 /* X. INCX must not be zero. */
506 /* Unchanged on exit. */
508 /* BETA - REAL . */
509 /* On entry, BETA specifies the scalar beta. */
510 /* Unchanged on exit. */
512 /* Y - REAL array of DIMENSION at least */
513 /* ( 1 + ( n - 1 )*abs( INCY ) ). */
514 /* Before entry, the incremented array Y must contain the */
515 /* vector y. On exit, Y is overwritten by the updated vector y. */
517 /* INCY - INTEGER. */
518 /* On entry, INCY specifies the increment for the elements of */
519 /* Y. INCY must not be zero. */
520 /* Unchanged on exit. */
523 /* Level 2 Blas routine. */
525 /* -- Written on 22-October-1986. */
526 /* Jack Dongarra, Argonne National Lab. */
527 /* Jeremy Du Croz, Nag Central Office. */
528 /* Sven Hammarling, Nag Central Office. */
529 /* Richard Hanson, Sandia National Labs. */
532 /* .. Parameters .. */
533 /* .. Local Scalars .. */
534 /* .. External Functions .. */
535 /* .. External Subroutines .. */
536 /* .. Intrinsic Functions .. */
537 /* .. */
538 /* .. Executable Statements .. */
540 /* Test the input parameters. */
542 /* Parameter adjustments */
543 a_dim1 = *lda;
544 a_offset = 1 + a_dim1 * 1;
545 a -= a_offset;
546 --x;
547 --y;
549 /* Function Body */
550 info = 0;
551 if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", (
552 ftnlen)1, (ftnlen)1)) {
553 info = 1;
554 } else if (*n < 0) {
555 info = 2;
556 } else if (*k < 0) {
557 info = 3;
558 } else if (*lda < *k + 1) {
559 info = 6;
560 } else if (*incx == 0) {
561 info = 8;
562 } else if (*incy == 0) {
563 info = 11;
564 }
565 if (info != 0) {
566 PASTEF770(xerbla)("SSBMV ", &info, (ftnlen)6);
567 return 0;
568 }
570 /* Quick return if possible. */
572 if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
573 return 0;
574 }
576 /* Set up the start points in X and Y. */
578 if (*incx > 0) {
579 kx = 1;
580 } else {
581 kx = 1 - (*n - 1) * *incx;
582 }
583 if (*incy > 0) {
584 ky = 1;
585 } else {
586 ky = 1 - (*n - 1) * *incy;
587 }
589 /* Start the operations. In this version the elements of the array A */
590 /* are accessed sequentially with one pass through A. */
592 /* First form y := beta*y. */
594 if (*beta != 1.f) {
595 if (*incy == 1) {
596 if (*beta == 0.f) {
597 i__1 = *n;
598 for (i__ = 1; i__ <= i__1; ++i__) {
599 y[i__] = 0.f;
600 /* L10: */
601 }
602 } else {
603 i__1 = *n;
604 for (i__ = 1; i__ <= i__1; ++i__) {
605 y[i__] = *beta * y[i__];
606 /* L20: */
607 }
608 }
609 } else {
610 iy = ky;
611 if (*beta == 0.f) {
612 i__1 = *n;
613 for (i__ = 1; i__ <= i__1; ++i__) {
614 y[iy] = 0.f;
615 iy += *incy;
616 /* L30: */
617 }
618 } else {
619 i__1 = *n;
620 for (i__ = 1; i__ <= i__1; ++i__) {
621 y[iy] = *beta * y[iy];
622 iy += *incy;
623 /* L40: */
624 }
625 }
626 }
627 }
628 if (*alpha == 0.f) {
629 return 0;
630 }
631 if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) {
633 /* Form y when upper triangle of A is stored. */
635 kplus1 = *k + 1;
636 if (*incx == 1 && *incy == 1) {
637 i__1 = *n;
638 for (j = 1; j <= i__1; ++j) {
639 temp1 = *alpha * x[j];
640 temp2 = 0.f;
641 l = kplus1 - j;
642 /* Computing MAX */
643 i__2 = 1, i__3 = j - *k;
644 i__4 = j - 1;
645 for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) {
646 y[i__] += temp1 * a[l + i__ + j * a_dim1];
647 temp2 += a[l + i__ + j * a_dim1] * x[i__];
648 /* L50: */
649 }
650 y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
651 /* L60: */
652 }
653 } else {
654 jx = kx;
655 jy = ky;
656 i__1 = *n;
657 for (j = 1; j <= i__1; ++j) {
658 temp1 = *alpha * x[jx];
659 temp2 = 0.f;
660 ix = kx;
661 iy = ky;
662 l = kplus1 - j;
663 /* Computing MAX */
664 i__4 = 1, i__2 = j - *k;
665 i__3 = j - 1;
666 for (i__ = f2c_max(i__4,i__2); i__ <= i__3; ++i__) {
667 y[iy] += temp1 * a[l + i__ + j * a_dim1];
668 temp2 += a[l + i__ + j * a_dim1] * x[ix];
669 ix += *incx;
670 iy += *incy;
671 /* L70: */
672 }
673 y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha *
674 temp2;
675 jx += *incx;
676 jy += *incy;
677 if (j > *k) {
678 kx += *incx;
679 ky += *incy;
680 }
681 /* L80: */
682 }
683 }
684 } else {
686 /* Form y when lower triangle of A is stored. */
688 if (*incx == 1 && *incy == 1) {
689 i__1 = *n;
690 for (j = 1; j <= i__1; ++j) {
691 temp1 = *alpha * x[j];
692 temp2 = 0.f;
693 y[j] += temp1 * a[j * a_dim1 + 1];
694 l = 1 - j;
695 /* Computing MIN */
696 i__4 = *n, i__2 = j + *k;
697 i__3 = f2c_min(i__4,i__2);
698 for (i__ = j + 1; i__ <= i__3; ++i__) {
699 y[i__] += temp1 * a[l + i__ + j * a_dim1];
700 temp2 += a[l + i__ + j * a_dim1] * x[i__];
701 /* L90: */
702 }
703 y[j] += *alpha * temp2;
704 /* L100: */
705 }
706 } else {
707 jx = kx;
708 jy = ky;
709 i__1 = *n;
710 for (j = 1; j <= i__1; ++j) {
711 temp1 = *alpha * x[jx];
712 temp2 = 0.f;
713 y[jy] += temp1 * a[j * a_dim1 + 1];
714 l = 1 - j;
715 ix = jx;
716 iy = jy;
717 /* Computing MIN */
718 i__4 = *n, i__2 = j + *k;
719 i__3 = f2c_min(i__4,i__2);
720 for (i__ = j + 1; i__ <= i__3; ++i__) {
721 ix += *incx;
722 iy += *incy;
723 y[iy] += temp1 * a[l + i__ + j * a_dim1];
724 temp2 += a[l + i__ + j * a_dim1] * x[ix];
725 /* L110: */
726 }
727 y[jy] += *alpha * temp2;
728 jx += *incx;
729 jy += *incy;
730 /* L120: */
731 }
732 }
733 }
735 return 0;
737 /* End of SSBMV . */
739 } /* ssbmv_ */
741 #endif