Apply clang-format to lapack/blas directories
diff --git a/blas/f2c/chbmv.c b/blas/f2c/chbmv.c
index f218fe3..2b9d528 100644
--- a/blas/f2c/chbmv.c
+++ b/blas/f2c/chbmv.c
@@ -1,487 +1,456 @@
/* chbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int chbmv_(char *uplo, integer *n, integer *k, complex *
- alpha, complex *a, integer *lda, complex *x, integer *incx, complex *
- beta, complex *y, integer *incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
- real r__1;
- complex q__1, q__2, q__3, q__4;
+/* Subroutine */ int chbmv_(char *uplo, integer *n, integer *k, complex *alpha, complex *a, integer *lda, complex *x,
+ integer *incx, complex *beta, complex *y, integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ real r__1;
+ complex q__1, q__2, q__3, q__4;
- /* Builtin functions */
- void r_cnjg(complex *, complex *);
+ /* Builtin functions */
+ void r_cnjg(complex *, complex *);
- /* Local variables */
- integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
- complex temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
+ complex temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* CHBMV performs the matrix-vector operation */
+ /* CHBMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n hermitian band matrix, with k super-diagonals. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n hermitian band matrix, with k super-diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the band matrix A is being supplied as */
-/* follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the band matrix A is being supplied as */
+ /* follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* being supplied. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* being supplied. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry, K specifies the number of super-diagonals of the */
-/* matrix A. K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry, K specifies the number of super-diagonals of the */
+ /* matrix A. K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* ALPHA - COMPLEX . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - COMPLEX . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* A - COMPLEX array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the hermitian matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer the upper */
-/* triangular part of a hermitian band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* A - COMPLEX array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the hermitian matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer the upper */
+ /* triangular part of a hermitian band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the hermitian matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer the lower */
-/* triangular part of a hermitian band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the hermitian matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer the lower */
+ /* triangular part of a hermitian band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that the imaginary parts of the diagonal elements need */
-/* not be set and are assumed to be zero. */
-/* Unchanged on exit. */
+ /* Note that the imaginary parts of the diagonal elements need */
+ /* not be set and are assumed to be zero. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - COMPLEX array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the */
-/* vector x. */
-/* Unchanged on exit. */
+ /* X - COMPLEX array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the */
+ /* vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - COMPLEX . */
-/* On entry, BETA specifies the scalar beta. */
-/* Unchanged on exit. */
+ /* BETA - COMPLEX . */
+ /* On entry, BETA specifies the scalar beta. */
+ /* Unchanged on exit. */
-/* Y - COMPLEX array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the */
-/* vector y. On exit, Y is overwritten by the updated vector y. */
+ /* Y - COMPLEX array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the */
+ /* vector y. On exit, Y is overwritten by the updated vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
- --y;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*k < 0) {
- info = 3;
- } else if (*lda < *k + 1) {
- info = 6;
- } else if (*incx == 0) {
- info = 8;
- } else if (*incy == 0) {
- info = 11;
- }
- if (info != 0) {
- xerbla_("CHBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f &&
- beta->i == 0.f))) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array A */
-/* are accessed sequentially with one pass through A. */
-
-/* First form y := beta*y. */
-
- if (beta->r != 1.f || beta->i != 0.f) {
- if (*incy == 1) {
- if (beta->r == 0.f && beta->i == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- y[i__2].r = 0.f, y[i__2].i = 0.f;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- i__3 = i__;
- q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (beta->r == 0.f && beta->i == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- y[i__2].r = 0.f, y[i__2].i = 0.f;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- i__3 = iy;
- q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (alpha->r == 0.f && alpha->i == 0.f) {
- return 0;
- }
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when upper triangle of A is stored. */
-
- kplus1 = *k + 1;
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- i__2 = i__;
- i__3 = i__;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__2 = i__;
- q__2.r = q__3.r * x[i__2].r - q__3.i * x[i__2].i, q__2.i =
- q__3.r * x[i__2].i + q__3.i * x[i__2].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
-/* L50: */
- }
- i__4 = j;
- i__2 = j;
- i__3 = kplus1 + j * a_dim1;
- r__1 = a[i__3].r;
- q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
- q__2.r = y[i__2].r + q__3.r, q__2.i = y[i__2].i + q__3.i;
- q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
- y[i__4].r = q__1.r, y[i__4].i = q__1.i;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__4 = jx;
- q__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, q__1.i =
- alpha->r * x[i__4].i + alpha->i * x[i__4].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- ix = kx;
- iy = ky;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- i__4 = iy;
- i__2 = iy;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
- y[i__4].r = q__1.r, y[i__4].i = q__1.i;
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i =
- q__3.r * x[i__4].i + q__3.i * x[i__4].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- i__3 = jy;
- i__4 = jy;
- i__2 = kplus1 + j * a_dim1;
- r__1 = a[i__2].r;
- q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
- q__2.r = y[i__4].r + q__3.r, q__2.i = y[i__4].i + q__3.i;
- q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- jx += *incx;
- jy += *incy;
- if (j > *k) {
- kx += *incx;
- ky += *incy;
- }
-/* L80: */
- }
- }
- } else {
-
-/* Form y when lower triangle of A is stored. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__3 = j;
- q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i =
- alpha->r * x[i__3].i + alpha->i * x[i__3].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- i__3 = j;
- i__4 = j;
- i__2 = j * a_dim1 + 1;
- r__1 = a[i__2].r;
- q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- i__4 = i__;
- i__2 = i__;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
- y[i__4].r = q__1.r, y[i__4].i = q__1.i;
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__4 = i__;
- q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i =
- q__3.r * x[i__4].i + q__3.i * x[i__4].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
-/* L90: */
- }
- i__3 = j;
- i__4 = j;
- q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__3 = jx;
- q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i =
- alpha->r * x[i__3].i + alpha->i * x[i__3].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- i__3 = jy;
- i__4 = jy;
- i__2 = j * a_dim1 + 1;
- r__1 = a[i__2].r;
- q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- l = 1 - j;
- ix = jx;
- iy = jy;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- ix += *incx;
- iy += *incy;
- i__4 = iy;
- i__2 = iy;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
- y[i__4].r = q__1.r, y[i__4].i = q__1.i;
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i =
- q__3.r * x[i__4].i + q__3.i * x[i__4].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
-/* L110: */
- }
- i__3 = jy;
- i__4 = jy;
- q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- jx += *incx;
- jy += *incy;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*k < 0) {
+ info = 3;
+ } else if (*lda < *k + 1) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("CHBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of CHBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array A */
+ /* are accessed sequentially with one pass through A. */
+
+ /* First form y := beta*y. */
+
+ if (beta->r != 1.f || beta->i != 0.f) {
+ if (*incy == 1) {
+ if (beta->r == 0.f && beta->i == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0.f, y[i__2].i = 0.f;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, q__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (beta->r == 0.f && beta->i == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0.f, y[i__2].i = 0.f;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, q__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (alpha->r == 0.f && alpha->i == 0.f) {
+ return 0;
+ }
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when upper triangle of A is stored. */
+
+ kplus1 = *k + 1;
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__2 = i__;
+ q__2.r = q__3.r * x[i__2].r - q__3.i * x[i__2].i, q__2.i = q__3.r * x[i__2].i + q__3.i * x[i__2].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ /* L50: */
+ }
+ i__4 = j;
+ i__2 = j;
+ i__3 = kplus1 + j * a_dim1;
+ r__1 = a[i__3].r;
+ q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
+ q__2.r = y[i__2].r + q__3.r, q__2.i = y[i__2].i + q__3.i;
+ q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
+ y[i__4].r = q__1.r, y[i__4].i = q__1.i;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__4 = jx;
+ q__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, q__1.i = alpha->r * x[i__4].i + alpha->i * x[i__4].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ ix = kx;
+ iy = ky;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ i__4 = iy;
+ i__2 = iy;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
+ y[i__4].r = q__1.r, y[i__4].i = q__1.i;
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i = q__3.r * x[i__4].i + q__3.i * x[i__4].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ i__3 = jy;
+ i__4 = jy;
+ i__2 = kplus1 + j * a_dim1;
+ r__1 = a[i__2].r;
+ q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
+ q__2.r = y[i__4].r + q__3.r, q__2.i = y[i__4].i + q__3.i;
+ q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ jx += *incx;
+ jy += *incy;
+ if (j > *k) {
+ kx += *incx;
+ ky += *incy;
+ }
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when lower triangle of A is stored. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__3 = j;
+ q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i = alpha->r * x[i__3].i + alpha->i * x[i__3].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ i__3 = j;
+ i__4 = j;
+ i__2 = j * a_dim1 + 1;
+ r__1 = a[i__2].r;
+ q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ i__4 = i__;
+ i__2 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
+ y[i__4].r = q__1.r, y[i__4].i = q__1.i;
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__4 = i__;
+ q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i = q__3.r * x[i__4].i + q__3.i * x[i__4].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ /* L90: */
+ }
+ i__3 = j;
+ i__4 = j;
+ q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__3 = jx;
+ q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i = alpha->r * x[i__3].i + alpha->i * x[i__3].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ i__3 = jy;
+ i__4 = jy;
+ i__2 = j * a_dim1 + 1;
+ r__1 = a[i__2].r;
+ q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ l = 1 - j;
+ ix = jx;
+ iy = jy;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ i__4 = iy;
+ i__2 = iy;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ q__1.r = y[i__2].r + q__2.r, q__1.i = y[i__2].i + q__2.i;
+ y[i__4].r = q__1.r, y[i__4].i = q__1.i;
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i = q__3.r * x[i__4].i + q__3.i * x[i__4].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ /* L110: */
+ }
+ i__3 = jy;
+ i__4 = jy;
+ q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ jx += *incx;
+ jy += *incy;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of CHBMV . */
} /* chbmv_ */
-
diff --git a/blas/f2c/chpmv.c b/blas/f2c/chpmv.c
index 65bab1c..3dd5e58 100644
--- a/blas/f2c/chpmv.c
+++ b/blas/f2c/chpmv.c
@@ -1,438 +1,407 @@
/* chpmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int chpmv_(char *uplo, integer *n, complex *alpha, complex *
- ap, complex *x, integer *incx, complex *beta, complex *y, integer *
- incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4, i__5;
- real r__1;
- complex q__1, q__2, q__3, q__4;
+/* Subroutine */ int chpmv_(char *uplo, integer *n, complex *alpha, complex *ap, complex *x, integer *incx,
+ complex *beta, complex *y, integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer i__1, i__2, i__3, i__4, i__5;
+ real r__1;
+ complex q__1, q__2, q__3, q__4;
- /* Builtin functions */
- void r_cnjg(complex *, complex *);
+ /* Builtin functions */
+ void r_cnjg(complex *, complex *);
- /* Local variables */
- integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
- complex temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
+ complex temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* CHPMV performs the matrix-vector operation */
+ /* CHPMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n hermitian matrix, supplied in packed form. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n hermitian matrix, supplied in packed form. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the matrix A is supplied in the packed */
-/* array AP as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the matrix A is supplied in the packed */
+ /* array AP as follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* supplied in AP. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* supplied in AP. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* ALPHA - COMPLEX . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - COMPLEX . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* AP - COMPLEX array of DIMENSION at least */
-/* ( ( n*( n + 1 ) )/2 ). */
-/* Before entry with UPLO = 'U' or 'u', the array AP must */
-/* contain the upper triangular part of the hermitian matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
-/* and a( 2, 2 ) respectively, and so on. */
-/* Before entry with UPLO = 'L' or 'l', the array AP must */
-/* contain the lower triangular part of the hermitian matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
-/* and a( 3, 1 ) respectively, and so on. */
-/* Note that the imaginary parts of the diagonal elements need */
-/* not be set and are assumed to be zero. */
-/* Unchanged on exit. */
+ /* AP - COMPLEX array of DIMENSION at least */
+ /* ( ( n*( n + 1 ) )/2 ). */
+ /* Before entry with UPLO = 'U' or 'u', the array AP must */
+ /* contain the upper triangular part of the hermitian matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
+ /* and a( 2, 2 ) respectively, and so on. */
+ /* Before entry with UPLO = 'L' or 'l', the array AP must */
+ /* contain the lower triangular part of the hermitian matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
+ /* and a( 3, 1 ) respectively, and so on. */
+ /* Note that the imaginary parts of the diagonal elements need */
+ /* not be set and are assumed to be zero. */
+ /* Unchanged on exit. */
-/* X - COMPLEX array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. */
-/* Unchanged on exit. */
+ /* X - COMPLEX array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - COMPLEX . */
-/* On entry, BETA specifies the scalar beta. When BETA is */
-/* supplied as zero then Y need not be set on input. */
-/* Unchanged on exit. */
+ /* BETA - COMPLEX . */
+ /* On entry, BETA specifies the scalar beta. When BETA is */
+ /* supplied as zero then Y need not be set on input. */
+ /* Unchanged on exit. */
-/* Y - COMPLEX array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the n */
-/* element vector y. On exit, Y is overwritten by the updated */
-/* vector y. */
+ /* Y - COMPLEX array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the n */
+ /* element vector y. On exit, Y is overwritten by the updated */
+ /* vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- --y;
- --x;
- --ap;
+ /* Parameter adjustments */
+ --y;
+ --x;
+ --ap;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*incx == 0) {
- info = 6;
- } else if (*incy == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("CHPMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f &&
- beta->i == 0.f))) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array AP */
-/* are accessed sequentially with one pass through AP. */
-
-/* First form y := beta*y. */
-
- if (beta->r != 1.f || beta->i != 0.f) {
- if (*incy == 1) {
- if (beta->r == 0.f && beta->i == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- y[i__2].r = 0.f, y[i__2].i = 0.f;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- i__3 = i__;
- q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (beta->r == 0.f && beta->i == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- y[i__2].r = 0.f, y[i__2].i = 0.f;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- i__3 = iy;
- q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (alpha->r == 0.f && alpha->i == 0.f) {
- return 0;
- }
- kk = 1;
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when AP contains the upper triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- k = kk;
- i__2 = j - 1;
- for (i__ = 1; i__ <= i__2; ++i__) {
- i__3 = i__;
- i__4 = i__;
- i__5 = k;
- q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- r_cnjg(&q__3, &ap[k]);
- i__3 = i__;
- q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =
- q__3.r * x[i__3].i + q__3.i * x[i__3].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
- ++k;
-/* L50: */
- }
- i__2 = j;
- i__3 = j;
- i__4 = kk + j - 1;
- r__1 = ap[i__4].r;
- q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
- q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
- q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- kk += j;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = jx;
- q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- ix = kx;
- iy = ky;
- i__2 = kk + j - 2;
- for (k = kk; k <= i__2; ++k) {
- i__3 = iy;
- i__4 = iy;
- i__5 = k;
- q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- r_cnjg(&q__3, &ap[k]);
- i__3 = ix;
- q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =
- q__3.r * x[i__3].i + q__3.i * x[i__3].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- i__2 = jy;
- i__3 = jy;
- i__4 = kk + j - 1;
- r__1 = ap[i__4].r;
- q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
- q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
- q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- jx += *incx;
- jy += *incy;
- kk += j;
-/* L80: */
- }
- }
- } else {
-
-/* Form y when AP contains the lower triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- i__2 = j;
- i__3 = j;
- i__4 = kk;
- r__1 = ap[i__4].r;
- q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
- q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- k = kk + 1;
- i__2 = *n;
- for (i__ = j + 1; i__ <= i__2; ++i__) {
- i__3 = i__;
- i__4 = i__;
- i__5 = k;
- q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- r_cnjg(&q__3, &ap[k]);
- i__3 = i__;
- q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =
- q__3.r * x[i__3].i + q__3.i * x[i__3].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
- ++k;
-/* L90: */
- }
- i__2 = j;
- i__3 = j;
- q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- kk += *n - j + 1;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = jx;
- q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = q__1.r, temp1.i = q__1.i;
- temp2.r = 0.f, temp2.i = 0.f;
- i__2 = jy;
- i__3 = jy;
- i__4 = kk;
- r__1 = ap[i__4].r;
- q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
- q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- ix = jx;
- iy = jy;
- i__2 = kk + *n - j;
- for (k = kk + 1; k <= i__2; ++k) {
- ix += *incx;
- iy += *incy;
- i__3 = iy;
- i__4 = iy;
- i__5 = k;
- q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
- y[i__3].r = q__1.r, y[i__3].i = q__1.i;
- r_cnjg(&q__3, &ap[k]);
- i__3 = ix;
- q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =
- q__3.r * x[i__3].i + q__3.i * x[i__3].r;
- q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
- temp2.r = q__1.r, temp2.i = q__1.i;
-/* L110: */
- }
- i__2 = jy;
- i__3 = jy;
- q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
- y[i__2].r = q__1.r, y[i__2].i = q__1.i;
- jx += *incx;
- jy += *incy;
- kk += *n - j + 1;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 6;
+ } else if (*incy == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("CHPMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of CHPMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array AP */
+ /* are accessed sequentially with one pass through AP. */
+
+ /* First form y := beta*y. */
+
+ if (beta->r != 1.f || beta->i != 0.f) {
+ if (*incy == 1) {
+ if (beta->r == 0.f && beta->i == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0.f, y[i__2].i = 0.f;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, q__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (beta->r == 0.f && beta->i == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0.f, y[i__2].i = 0.f;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, q__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (alpha->r == 0.f && alpha->i == 0.f) {
+ return 0;
+ }
+ kk = 1;
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when AP contains the upper triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ k = kk;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = k;
+ q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ r_cnjg(&q__3, &ap[k]);
+ i__3 = i__;
+ q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ ++k;
+ /* L50: */
+ }
+ i__2 = j;
+ i__3 = j;
+ i__4 = kk + j - 1;
+ r__1 = ap[i__4].r;
+ q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
+ q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
+ q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ kk += j;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ ix = kx;
+ iy = ky;
+ i__2 = kk + j - 2;
+ for (k = kk; k <= i__2; ++k) {
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = k;
+ q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ r_cnjg(&q__3, &ap[k]);
+ i__3 = ix;
+ q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = kk + j - 1;
+ r__1 = ap[i__4].r;
+ q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;
+ q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
+ q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ jx += *incx;
+ jy += *incy;
+ kk += j;
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when AP contains the lower triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ i__2 = j;
+ i__3 = j;
+ i__4 = kk;
+ r__1 = ap[i__4].r;
+ q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
+ q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ k = kk + 1;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = k;
+ q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ r_cnjg(&q__3, &ap[k]);
+ i__3 = i__;
+ q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ ++k;
+ /* L90: */
+ }
+ i__2 = j;
+ i__3 = j;
+ q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ kk += *n - j + 1;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = q__1.r, temp1.i = q__1.i;
+ temp2.r = 0.f, temp2.i = 0.f;
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = kk;
+ r__1 = ap[i__4].r;
+ q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;
+ q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ ix = jx;
+ iy = jy;
+ i__2 = kk + *n - j;
+ for (k = kk + 1; k <= i__2; ++k) {
+ ix += *incx;
+ iy += *incy;
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = k;
+ q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, q__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
+ y[i__3].r = q__1.r, y[i__3].i = q__1.i;
+ r_cnjg(&q__3, &ap[k]);
+ i__3 = ix;
+ q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3].r;
+ q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
+ temp2.r = q__1.r, temp2.i = q__1.i;
+ /* L110: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
+ y[i__2].r = q__1.r, y[i__2].i = q__1.i;
+ jx += *incx;
+ jy += *incy;
+ kk += *n - j + 1;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of CHPMV . */
} /* chpmv_ */
-
diff --git a/blas/f2c/complexdots.c b/blas/f2c/complexdots.c
index a856a23..a0a01e6 100644
--- a/blas/f2c/complexdots.c
+++ b/blas/f2c/complexdots.c
@@ -6,79 +6,68 @@
/* complexdots.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-complex cdotc_(integer *n, complex *cx, integer
- *incx, complex *cy, integer *incy)
-{
- complex res;
- extern /* Subroutine */ int cdotcw_(integer *, complex *, integer *,
- complex *, integer *, complex *);
+complex cdotc_(integer *n, complex *cx, integer *incx, complex *cy, integer *incy) {
+ complex res;
+ extern /* Subroutine */ int cdotcw_(integer *, complex *, integer *, complex *, integer *, complex *);
- /* Parameter adjustments */
- --cy;
- --cx;
+ /* Parameter adjustments */
+ --cy;
+ --cx;
- /* Function Body */
- cdotcw_(n, &cx[1], incx, &cy[1], incy, &res);
- return res;
+ /* Function Body */
+ cdotcw_(n, &cx[1], incx, &cy[1], incy, &res);
+ return res;
} /* cdotc_ */
-complex cdotu_(integer *n, complex *cx, integer
- *incx, complex *cy, integer *incy)
-{
- complex res;
- extern /* Subroutine */ int cdotuw_(integer *, complex *, integer *,
- complex *, integer *, complex *);
+complex cdotu_(integer *n, complex *cx, integer *incx, complex *cy, integer *incy) {
+ complex res;
+ extern /* Subroutine */ int cdotuw_(integer *, complex *, integer *, complex *, integer *, complex *);
- /* Parameter adjustments */
- --cy;
- --cx;
+ /* Parameter adjustments */
+ --cy;
+ --cx;
- /* Function Body */
- cdotuw_(n, &cx[1], incx, &cy[1], incy, &res);
- return res;
+ /* Function Body */
+ cdotuw_(n, &cx[1], incx, &cy[1], incy, &res);
+ return res;
} /* cdotu_ */
-doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx,
- doublecomplex *cy, integer *incy)
-{
- doublecomplex res;
- extern /* Subroutine */ int zdotcw_(integer *, doublecomplex *, integer *,
- doublecomplex *, integer *, doublecomplex *);
+doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy) {
+ doublecomplex res;
+ extern /* Subroutine */ int zdotcw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *);
- /* Parameter adjustments */
- --cy;
- --cx;
+ /* Parameter adjustments */
+ --cy;
+ --cx;
- /* Function Body */
- zdotcw_(n, &cx[1], incx, &cy[1], incy, &res);
- return res;
+ /* Function Body */
+ zdotcw_(n, &cx[1], incx, &cy[1], incy, &res);
+ return res;
} /* zdotc_ */
-doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx,
- doublecomplex *cy, integer *incy)
-{
- doublecomplex res;
- extern /* Subroutine */ int zdotuw_(integer *, doublecomplex *, integer *,
- doublecomplex *, integer *, doublecomplex *);
+doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy) {
+ doublecomplex res;
+ extern /* Subroutine */ int zdotuw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *);
- /* Parameter adjustments */
- --cy;
- --cx;
+ /* Parameter adjustments */
+ --cy;
+ --cx;
- /* Function Body */
- zdotuw_(n, &cx[1], incx, &cy[1], incy, &res);
- return res;
+ /* Function Body */
+ zdotuw_(n, &cx[1], incx, &cy[1], incy, &res);
+ return res;
} /* zdotu_ */
-
diff --git a/blas/f2c/ctbmv.c b/blas/f2c/ctbmv.c
index a6e0dae..8038e72 100644
--- a/blas/f2c/ctbmv.c
+++ b/blas/f2c/ctbmv.c
@@ -1,647 +1,587 @@
/* ctbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int 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)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
- complex q__1, q__2, q__3;
+/* Subroutine */ int 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) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ complex q__1, q__2, q__3;
- /* Builtin functions */
- void r_cnjg(complex *, complex *);
+ /* Builtin functions */
+ void r_cnjg(complex *, complex *);
- /* Local variables */
- integer i__, j, l, ix, jx, kx, info;
- complex temp;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
- logical noconj, nounit;
+ /* Local variables */
+ integer i__, j, l, ix, jx, kx, info;
+ complex temp;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ logical noconj, nounit;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* CTBMV performs one of the matrix-vector operations */
+ /* CTBMV performs one of the matrix-vector operations */
-/* x := A*x, or x := A'*x, or x := conjg( A' )*x, */
+ /* x := A*x, or x := A'*x, or x := conjg( A' )*x, */
-/* where x is an n element vector and A is an n by n unit, or non-unit, */
-/* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
+ /* where x is an n element vector and A is an n by n unit, or non-unit, */
+ /* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the matrix is an upper or */
-/* lower triangular matrix as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the matrix is an upper or */
+ /* lower triangular matrix as follows: */
-/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+ /* UPLO = 'U' or 'u' A is an upper triangular matrix. */
-/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+ /* UPLO = 'L' or 'l' A is a lower triangular matrix. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* TRANS - CHARACTER*1. */
-/* On entry, TRANS specifies the operation to be performed as */
-/* follows: */
+ /* TRANS - CHARACTER*1. */
+ /* On entry, TRANS specifies the operation to be performed as */
+ /* follows: */
-/* TRANS = 'N' or 'n' x := A*x. */
+ /* TRANS = 'N' or 'n' x := A*x. */
-/* TRANS = 'T' or 't' x := A'*x. */
+ /* TRANS = 'T' or 't' x := A'*x. */
-/* TRANS = 'C' or 'c' x := conjg( A' )*x. */
+ /* TRANS = 'C' or 'c' x := conjg( A' )*x. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* DIAG - CHARACTER*1. */
-/* On entry, DIAG specifies whether or not A is unit */
-/* triangular as follows: */
+ /* DIAG - CHARACTER*1. */
+ /* On entry, DIAG specifies whether or not A is unit */
+ /* triangular as follows: */
-/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+ /* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
-/* DIAG = 'N' or 'n' A is not assumed to be unit */
-/* triangular. */
+ /* DIAG = 'N' or 'n' A is not assumed to be unit */
+ /* triangular. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry with UPLO = 'U' or 'u', K specifies the number of */
-/* super-diagonals of the matrix A. */
-/* On entry with UPLO = 'L' or 'l', K specifies the number of */
-/* sub-diagonals of the matrix A. */
-/* K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry with UPLO = 'U' or 'u', K specifies the number of */
+ /* super-diagonals of the matrix A. */
+ /* On entry with UPLO = 'L' or 'l', K specifies the number of */
+ /* sub-diagonals of the matrix A. */
+ /* K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* A - COMPLEX array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer an upper */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* A - COMPLEX array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer an upper */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer a lower */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer a lower */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that when DIAG = 'U' or 'u' the elements of the array A */
-/* corresponding to the diagonal elements of the matrix are not */
-/* referenced, but are assumed to be unity. */
-/* Unchanged on exit. */
+ /* Note that when DIAG = 'U' or 'u' the elements of the array A */
+ /* corresponding to the diagonal elements of the matrix are not */
+ /* referenced, but are assumed to be unity. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - COMPLEX array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. On exit, X is overwritten with the */
-/* transformed vector x. */
+ /* X - COMPLEX array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. On exit, X is overwritten with the */
+ /* transformed vector x. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans,
- "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (
- ftnlen)1)) {
- info = 2;
- } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag,
- "N", (ftnlen)1, (ftnlen)1)) {
- info = 3;
- } else if (*n < 0) {
- info = 4;
- } else if (*k < 0) {
- info = 5;
- } else if (*lda < *k + 1) {
- info = 7;
- } else if (*incx == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("CTBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0) {
- return 0;
- }
-
- noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
- nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
-
-/* Set up the start point in X if the increment is not unity. This */
-/* will be ( N - 1 )*INCX too small for descending loops. */
-
- if (*incx <= 0) {
- kx = 1 - (*n - 1) * *incx;
- } else if (*incx != 1) {
- kx = 1;
- }
-
-/* Start the operations. In this version the elements of A are */
-/* accessed sequentially with one pass through A. */
-
- if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
-
-/* Form x := A*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
- i__2 = j;
- temp.r = x[i__2].r, temp.i = x[i__2].i;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- i__2 = i__;
- i__3 = i__;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
- q__2.i = temp.r * a[i__5].i + temp.i * a[
- i__5].r;
- q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +
- q__2.i;
- x[i__2].r = q__1.r, x[i__2].i = q__1.i;
-/* L10: */
- }
- if (nounit) {
- i__4 = j;
- i__2 = j;
- i__3 = kplus1 + j * a_dim1;
- q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
- i__3].i, q__1.i = x[i__2].r * a[i__3].i +
- x[i__2].i * a[i__3].r;
- x[i__4].r = q__1.r, x[i__4].i = q__1.i;
- }
- }
-/* L20: */
- }
- } else {
- jx = kx;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__4 = jx;
- if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- ix = kx;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- i__4 = ix;
- i__2 = ix;
- i__5 = l + i__ + j * a_dim1;
- q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
- q__2.i = temp.r * a[i__5].i + temp.i * a[
- i__5].r;
- q__1.r = x[i__2].r + q__2.r, q__1.i = x[i__2].i +
- q__2.i;
- x[i__4].r = q__1.r, x[i__4].i = q__1.i;
- ix += *incx;
-/* L30: */
- }
- if (nounit) {
- i__3 = jx;
- i__4 = jx;
- i__2 = kplus1 + j * a_dim1;
- q__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[
- i__2].i, q__1.i = x[i__4].r * a[i__2].i +
- x[i__4].i * a[i__2].r;
- x[i__3].r = q__1.r, x[i__3].i = q__1.i;
- }
- }
- jx += *incx;
- if (j > *k) {
- kx += *incx;
- }
-/* L40: */
- }
- }
- } else {
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- i__1 = j;
- if (x[i__1].r != 0.f || x[i__1].i != 0.f) {
- i__1 = j;
- temp.r = x[i__1].r, temp.i = x[i__1].i;
- l = 1 - j;
-/* Computing MIN */
- i__1 = *n, i__3 = j + *k;
- i__4 = j + 1;
- for (i__ = min(i__1,i__3); i__ >= i__4; --i__) {
- i__1 = i__;
- i__3 = i__;
- i__2 = l + i__ + j * a_dim1;
- q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
- q__2.i = temp.r * a[i__2].i + temp.i * a[
- i__2].r;
- q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +
- q__2.i;
- x[i__1].r = q__1.r, x[i__1].i = q__1.i;
-/* L50: */
- }
- if (nounit) {
- i__4 = j;
- i__1 = j;
- i__3 = j * a_dim1 + 1;
- q__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[
- i__3].i, q__1.i = x[i__1].r * a[i__3].i +
- x[i__1].i * a[i__3].r;
- x[i__4].r = q__1.r, x[i__4].i = q__1.i;
- }
- }
-/* L60: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- i__4 = jx;
- if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- ix = kx;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__1 = j + *k;
- i__3 = j + 1;
- for (i__ = min(i__4,i__1); i__ >= i__3; --i__) {
- i__4 = ix;
- i__1 = ix;
- i__2 = l + i__ + j * a_dim1;
- q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
- q__2.i = temp.r * a[i__2].i + temp.i * a[
- i__2].r;
- q__1.r = x[i__1].r + q__2.r, q__1.i = x[i__1].i +
- q__2.i;
- x[i__4].r = q__1.r, x[i__4].i = q__1.i;
- ix -= *incx;
-/* L70: */
- }
- if (nounit) {
- i__3 = jx;
- i__4 = jx;
- i__1 = j * a_dim1 + 1;
- q__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[
- i__1].i, q__1.i = x[i__4].r * a[i__1].i +
- x[i__4].i * a[i__1].r;
- x[i__3].r = q__1.r, x[i__3].i = q__1.i;
- }
- }
- jx -= *incx;
- if (*n - j >= *k) {
- kx -= *incx;
- }
-/* L80: */
- }
- }
- }
- } else {
-
-/* Form x := A'*x or x := conjg( A' )*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- i__3 = j;
- temp.r = x[i__3].r, temp.i = x[i__3].i;
- l = kplus1 - j;
- if (noconj) {
- if (nounit) {
- i__3 = kplus1 + j * a_dim1;
- q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
- q__1.i = temp.r * a[i__3].i + temp.i * a[
- i__3].r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- i__4 = l + i__ + j * a_dim1;
- i__1 = i__;
- q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
- i__1].i, q__2.i = a[i__4].r * x[i__1].i +
- a[i__4].i * x[i__1].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
-/* L90: */
- }
- } else {
- if (nounit) {
- r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
- q__1.r = temp.r * q__2.r - temp.i * q__2.i,
- q__1.i = temp.r * q__2.i + temp.i *
- q__2.r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__4 = i__;
- q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i,
- q__2.i = q__3.r * x[i__4].i + q__3.i * x[
- i__4].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
-/* L100: */
- }
- }
- i__3 = j;
- x[i__3].r = temp.r, x[i__3].i = temp.i;
-/* L110: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- i__3 = jx;
- temp.r = x[i__3].r, temp.i = x[i__3].i;
- kx -= *incx;
- ix = kx;
- l = kplus1 - j;
- if (noconj) {
- if (nounit) {
- i__3 = kplus1 + j * a_dim1;
- q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
- q__1.i = temp.r * a[i__3].i + temp.i * a[
- i__3].r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- i__4 = l + i__ + j * a_dim1;
- i__1 = ix;
- q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
- i__1].i, q__2.i = a[i__4].r * x[i__1].i +
- a[i__4].i * x[i__1].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
- ix -= *incx;
-/* L120: */
- }
- } else {
- if (nounit) {
- r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
- q__1.r = temp.r * q__2.r - temp.i * q__2.i,
- q__1.i = temp.r * q__2.i + temp.i *
- q__2.r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i,
- q__2.i = q__3.r * x[i__4].i + q__3.i * x[
- i__4].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
- ix -= *incx;
-/* L130: */
- }
- }
- i__3 = jx;
- x[i__3].r = temp.r, x[i__3].i = temp.i;
- jx -= *incx;
-/* L140: */
- }
- }
- } else {
- if (*incx == 1) {
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- i__4 = j;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- l = 1 - j;
- if (noconj) {
- if (nounit) {
- i__4 = j * a_dim1 + 1;
- q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
- q__1.i = temp.r * a[i__4].i + temp.i * a[
- i__4].r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- i__1 = l + i__ + j * a_dim1;
- i__2 = i__;
- q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
- i__2].i, q__2.i = a[i__1].r * x[i__2].i +
- a[i__1].i * x[i__2].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
-/* L150: */
- }
- } else {
- if (nounit) {
- r_cnjg(&q__2, &a[j * a_dim1 + 1]);
- q__1.r = temp.r * q__2.r - temp.i * q__2.i,
- q__1.i = temp.r * q__2.i + temp.i *
- q__2.r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__1 = i__;
- q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,
- q__2.i = q__3.r * x[i__1].i + q__3.i * x[
- i__1].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
-/* L160: */
- }
- }
- i__4 = j;
- x[i__4].r = temp.r, x[i__4].i = temp.i;
-/* L170: */
- }
- } else {
- jx = kx;
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- kx += *incx;
- ix = kx;
- l = 1 - j;
- if (noconj) {
- if (nounit) {
- i__4 = j * a_dim1 + 1;
- q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
- q__1.i = temp.r * a[i__4].i + temp.i * a[
- i__4].r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- i__1 = l + i__ + j * a_dim1;
- i__2 = ix;
- q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
- i__2].i, q__2.i = a[i__1].r * x[i__2].i +
- a[i__1].i * x[i__2].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
- ix += *incx;
-/* L180: */
- }
- } else {
- if (nounit) {
- r_cnjg(&q__2, &a[j * a_dim1 + 1]);
- q__1.r = temp.r * q__2.r - temp.i * q__2.i,
- q__1.i = temp.r * q__2.i + temp.i *
- q__2.r;
- temp.r = q__1.r, temp.i = q__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
- i__1 = ix;
- q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,
- q__2.i = q__3.r * x[i__1].i + q__3.i * x[
- i__1].r;
- q__1.r = temp.r + q__2.r, q__1.i = temp.i +
- q__2.i;
- temp.r = q__1.r, temp.i = q__1.i;
- ix += *incx;
-/* L190: */
- }
- }
- i__4 = jx;
- x[i__4].r = temp.r, x[i__4].i = temp.i;
- jx += *incx;
-/* L200: */
- }
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
+ !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
+ info = 2;
+ } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < *k + 1) {
+ info = 7;
+ } else if (*incx == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("CTBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of CTBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
+ nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
+
+ /* Set up the start point in X if the increment is not unity. This */
+ /* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+ /* Start the operations. In this version the elements of A are */
+ /* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
+ /* Form x := A*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, q__2.i = temp.r * a[i__5].i + temp.i * a[i__5].r;
+ q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i + q__2.i;
+ x[i__2].r = q__1.r, x[i__2].i = q__1.i;
+ /* L10: */
+ }
+ if (nounit) {
+ i__4 = j;
+ i__2 = j;
+ i__3 = kplus1 + j * a_dim1;
+ q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[i__3].i,
+ q__1.i = x[i__2].r * a[i__3].i + x[i__2].i * a[i__3].r;
+ x[i__4].r = q__1.r, x[i__4].i = q__1.i;
+ }
+ }
+ /* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__4 = jx;
+ if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ ix = kx;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ i__4 = ix;
+ i__2 = ix;
+ i__5 = l + i__ + j * a_dim1;
+ q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, q__2.i = temp.r * a[i__5].i + temp.i * a[i__5].r;
+ q__1.r = x[i__2].r + q__2.r, q__1.i = x[i__2].i + q__2.i;
+ x[i__4].r = q__1.r, x[i__4].i = q__1.i;
+ ix += *incx;
+ /* L30: */
+ }
+ if (nounit) {
+ i__3 = jx;
+ i__4 = jx;
+ i__2 = kplus1 + j * a_dim1;
+ q__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[i__2].i,
+ q__1.i = x[i__4].r * a[i__2].i + x[i__4].i * a[i__2].r;
+ x[i__3].r = q__1.r, x[i__3].i = q__1.i;
+ }
+ }
+ jx += *incx;
+ if (j > *k) {
+ kx += *incx;
+ }
+ /* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ if (x[i__1].r != 0.f || x[i__1].i != 0.f) {
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ l = 1 - j;
+ /* Computing MIN */
+ i__1 = *n, i__3 = j + *k;
+ i__4 = j + 1;
+ for (i__ = min(i__1, i__3); i__ >= i__4; --i__) {
+ i__1 = i__;
+ i__3 = i__;
+ i__2 = l + i__ + j * a_dim1;
+ q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, q__2.i = temp.r * a[i__2].i + temp.i * a[i__2].r;
+ q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i + q__2.i;
+ x[i__1].r = q__1.r, x[i__1].i = q__1.i;
+ /* L50: */
+ }
+ if (nounit) {
+ i__4 = j;
+ i__1 = j;
+ i__3 = j * a_dim1 + 1;
+ q__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[i__3].i,
+ q__1.i = x[i__1].r * a[i__3].i + x[i__1].i * a[i__3].r;
+ x[i__4].r = q__1.r, x[i__4].i = q__1.i;
+ }
+ }
+ /* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ i__4 = jx;
+ if (x[i__4].r != 0.f || x[i__4].i != 0.f) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ ix = kx;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__1 = j + *k;
+ i__3 = j + 1;
+ for (i__ = min(i__4, i__1); i__ >= i__3; --i__) {
+ i__4 = ix;
+ i__1 = ix;
+ i__2 = l + i__ + j * a_dim1;
+ q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, q__2.i = temp.r * a[i__2].i + temp.i * a[i__2].r;
+ q__1.r = x[i__1].r + q__2.r, q__1.i = x[i__1].i + q__2.i;
+ x[i__4].r = q__1.r, x[i__4].i = q__1.i;
+ ix -= *incx;
+ /* L70: */
+ }
+ if (nounit) {
+ i__3 = jx;
+ i__4 = jx;
+ i__1 = j * a_dim1 + 1;
+ q__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[i__1].i,
+ q__1.i = x[i__4].r * a[i__1].i + x[i__4].i * a[i__1].r;
+ x[i__3].r = q__1.r, x[i__3].i = q__1.i;
+ }
+ }
+ jx -= *incx;
+ if (*n - j >= *k) {
+ kx -= *incx;
+ }
+ /* L80: */
+ }
+ }
+ }
+ } else {
+ /* Form x := A'*x or x := conjg( A' )*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__3 = j;
+ temp.r = x[i__3].r, temp.i = x[i__3].i;
+ l = kplus1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__3 = kplus1 + j * a_dim1;
+ q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, q__1.i = temp.r * a[i__3].i + temp.i * a[i__3].r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ i__4 = l + i__ + j * a_dim1;
+ i__1 = i__;
+ q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
+ q__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ /* L90: */
+ }
+ } else {
+ if (nounit) {
+ r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
+ q__1.r = temp.r * q__2.r - temp.i * q__2.i, q__1.i = temp.r * q__2.i + temp.i * q__2.r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__4 = i__;
+ q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i = q__3.r * x[i__4].i + q__3.i * x[i__4].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ /* L100: */
+ }
+ }
+ i__3 = j;
+ x[i__3].r = temp.r, x[i__3].i = temp.i;
+ /* L110: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ i__3 = jx;
+ temp.r = x[i__3].r, temp.i = x[i__3].i;
+ kx -= *incx;
+ ix = kx;
+ l = kplus1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__3 = kplus1 + j * a_dim1;
+ q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, q__1.i = temp.r * a[i__3].i + temp.i * a[i__3].r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ i__4 = l + i__ + j * a_dim1;
+ i__1 = ix;
+ q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
+ q__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ ix -= *incx;
+ /* L120: */
+ }
+ } else {
+ if (nounit) {
+ r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
+ q__1.r = temp.r * q__2.r - temp.i * q__2.i, q__1.i = temp.r * q__2.i + temp.i * q__2.r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.i = q__3.r * x[i__4].i + q__3.i * x[i__4].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ ix -= *incx;
+ /* L130: */
+ }
+ }
+ i__3 = jx;
+ x[i__3].r = temp.r, x[i__3].i = temp.i;
+ jx -= *incx;
+ /* L140: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ i__4 = j;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ l = 1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__4 = j * a_dim1 + 1;
+ q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, q__1.i = temp.r * a[i__4].i + temp.i * a[i__4].r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ i__1 = l + i__ + j * a_dim1;
+ i__2 = i__;
+ q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
+ q__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ /* L150: */
+ }
+ } else {
+ if (nounit) {
+ r_cnjg(&q__2, &a[j * a_dim1 + 1]);
+ q__1.r = temp.r * q__2.r - temp.i * q__2.i, q__1.i = temp.r * q__2.i + temp.i * q__2.r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__1 = i__;
+ q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i, q__2.i = q__3.r * x[i__1].i + q__3.i * x[i__1].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ /* L160: */
+ }
+ }
+ i__4 = j;
+ x[i__4].r = temp.r, x[i__4].i = temp.i;
+ /* L170: */
+ }
+ } else {
+ jx = kx;
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ kx += *incx;
+ ix = kx;
+ l = 1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__4 = j * a_dim1 + 1;
+ q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, q__1.i = temp.r * a[i__4].i + temp.i * a[i__4].r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ i__1 = l + i__ + j * a_dim1;
+ i__2 = ix;
+ q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
+ q__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ ix += *incx;
+ /* L180: */
+ }
+ } else {
+ if (nounit) {
+ r_cnjg(&q__2, &a[j * a_dim1 + 1]);
+ q__1.r = temp.r * q__2.r - temp.i * q__2.i, q__1.i = temp.r * q__2.i + temp.i * q__2.r;
+ temp.r = q__1.r, temp.i = q__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
+ i__1 = ix;
+ q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i, q__2.i = q__3.r * x[i__1].i + q__3.i * x[i__1].r;
+ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
+ temp.r = q__1.r, temp.i = q__1.i;
+ ix += *incx;
+ /* L190: */
+ }
+ }
+ i__4 = jx;
+ x[i__4].r = temp.r, x[i__4].i = temp.i;
+ jx += *incx;
+ /* L200: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of CTBMV . */
} /* ctbmv_ */
-
diff --git a/blas/f2c/d_cnjg.c b/blas/f2c/d_cnjg.c
index 623090c..dad02f5 100644
--- a/blas/f2c/d_cnjg.c
+++ b/blas/f2c/d_cnjg.c
@@ -1,6 +1,6 @@
-#include "datatypes.h"
+#include "datatypes.h"
void d_cnjg(doublecomplex *r, doublecomplex *z) {
- r->r = z->r;
- r->i = -(z->i);
+ r->r = z->r;
+ r->i = -(z->i);
}
diff --git a/blas/f2c/drotm.c b/blas/f2c/drotm.c
index 17a779b..65183df 100644
--- a/blas/f2c/drotm.c
+++ b/blas/f2c/drotm.c
@@ -1,215 +1,213 @@
/* drotm.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx,
- doublereal *dy, integer *incy, doublereal *dparam)
-{
- /* Initialized data */
+/* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy,
+ doublereal *dparam) {
+ /* Initialized data */
- static doublereal zero = 0.;
- static doublereal two = 2.;
+ static doublereal zero = 0.;
+ static doublereal two = 2.;
- /* System generated locals */
- integer i__1, i__2;
+ /* System generated locals */
+ integer i__1, i__2;
- /* Local variables */
- integer i__;
- doublereal w, z__;
- integer kx, ky;
- doublereal dh11, dh12, dh21, dh22, dflag;
- integer nsteps;
+ /* Local variables */
+ integer i__;
+ doublereal w, z__;
+ integer kx, ky;
+ doublereal dh11, dh12, dh21, dh22, dflag;
+ integer nsteps;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
+ /* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
-/* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */
-/* (DY**T) */
+ /* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */
+ /* (DY**T) */
-/* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
-/* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */
-/* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
+ /* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
+ /* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */
+ /* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
-/* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
+ /* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
-/* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
-/* H=( ) ( ) ( ) ( ) */
-/* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
-/* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */
+ /* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
+ /* H=( ) ( ) ( ) ( ) */
+ /* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
+ /* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */
-/* Arguments */
-/* ========= */
+ /* Arguments */
+ /* ========= */
-/* N (input) INTEGER */
-/* number of elements in input vector(s) */
+ /* N (input) INTEGER */
+ /* number of elements in input vector(s) */
-/* DX (input/output) DOUBLE PRECISION array, dimension N */
-/* double precision vector with N elements */
+ /* DX (input/output) DOUBLE PRECISION array, dimension N */
+ /* double precision vector with N elements */
-/* INCX (input) INTEGER */
-/* storage spacing between elements of DX */
+ /* INCX (input) INTEGER */
+ /* storage spacing between elements of DX */
-/* DY (input/output) DOUBLE PRECISION array, dimension N */
-/* double precision vector with N elements */
+ /* DY (input/output) DOUBLE PRECISION array, dimension N */
+ /* double precision vector with N elements */
-/* INCY (input) INTEGER */
-/* storage spacing between elements of DY */
+ /* INCY (input) INTEGER */
+ /* storage spacing between elements of DY */
-/* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */
-/* DPARAM(1)=DFLAG */
-/* DPARAM(2)=DH11 */
-/* DPARAM(3)=DH21 */
-/* DPARAM(4)=DH12 */
-/* DPARAM(5)=DH22 */
+ /* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */
+ /* DPARAM(1)=DFLAG */
+ /* DPARAM(2)=DH11 */
+ /* DPARAM(3)=DH21 */
+ /* DPARAM(4)=DH12 */
+ /* DPARAM(5)=DH22 */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Local Scalars .. */
-/* .. */
-/* .. Data statements .. */
- /* Parameter adjustments */
- --dparam;
- --dy;
- --dx;
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. Data statements .. */
+ /* Parameter adjustments */
+ --dparam;
+ --dy;
+ --dx;
- /* Function Body */
-/* .. */
+ /* Function Body */
+ /* .. */
- dflag = dparam[1];
- if (*n <= 0 || dflag + two == zero) {
- goto L140;
- }
- if (! (*incx == *incy && *incx > 0)) {
- goto L70;
- }
+ dflag = dparam[1];
+ if (*n <= 0 || dflag + two == zero) {
+ goto L140;
+ }
+ if (!(*incx == *incy && *incx > 0)) {
+ goto L70;
+ }
- nsteps = *n * *incx;
- if (dflag < 0.) {
- goto L50;
- } else if (dflag == 0) {
- goto L10;
- } else {
- goto L30;
- }
+ nsteps = *n * *incx;
+ if (dflag < 0.) {
+ goto L50;
+ } else if (dflag == 0) {
+ goto L10;
+ } else {
+ goto L30;
+ }
L10:
- dh12 = dparam[4];
- dh21 = dparam[3];
- i__1 = nsteps;
- i__2 = *incx;
- for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
- w = dx[i__];
- z__ = dy[i__];
- dx[i__] = w + z__ * dh12;
- dy[i__] = w * dh21 + z__;
-/* L20: */
- }
- goto L140;
+ dh12 = dparam[4];
+ dh21 = dparam[3];
+ i__1 = nsteps;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ w = dx[i__];
+ z__ = dy[i__];
+ dx[i__] = w + z__ * dh12;
+ dy[i__] = w * dh21 + z__;
+ /* L20: */
+ }
+ goto L140;
L30:
- dh11 = dparam[2];
- dh22 = dparam[5];
- i__2 = nsteps;
- i__1 = *incx;
- for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
- w = dx[i__];
- z__ = dy[i__];
- dx[i__] = w * dh11 + z__;
- dy[i__] = -w + dh22 * z__;
-/* L40: */
- }
- goto L140;
+ dh11 = dparam[2];
+ dh22 = dparam[5];
+ i__2 = nsteps;
+ i__1 = *incx;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+ w = dx[i__];
+ z__ = dy[i__];
+ dx[i__] = w * dh11 + z__;
+ dy[i__] = -w + dh22 * z__;
+ /* L40: */
+ }
+ goto L140;
L50:
- dh11 = dparam[2];
- dh12 = dparam[4];
- dh21 = dparam[3];
- dh22 = dparam[5];
- i__1 = nsteps;
- i__2 = *incx;
- for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
- w = dx[i__];
- z__ = dy[i__];
- dx[i__] = w * dh11 + z__ * dh12;
- dy[i__] = w * dh21 + z__ * dh22;
-/* L60: */
- }
- goto L140;
+ dh11 = dparam[2];
+ dh12 = dparam[4];
+ dh21 = dparam[3];
+ dh22 = dparam[5];
+ i__1 = nsteps;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ w = dx[i__];
+ z__ = dy[i__];
+ dx[i__] = w * dh11 + z__ * dh12;
+ dy[i__] = w * dh21 + z__ * dh22;
+ /* L60: */
+ }
+ goto L140;
L70:
- kx = 1;
- ky = 1;
- if (*incx < 0) {
- kx = (1 - *n) * *incx + 1;
- }
- if (*incy < 0) {
- ky = (1 - *n) * *incy + 1;
- }
+ kx = 1;
+ ky = 1;
+ if (*incx < 0) {
+ kx = (1 - *n) * *incx + 1;
+ }
+ if (*incy < 0) {
+ ky = (1 - *n) * *incy + 1;
+ }
- if (dflag < 0.) {
- goto L120;
- } else if (dflag == 0) {
- goto L80;
- } else {
- goto L100;
- }
+ if (dflag < 0.) {
+ goto L120;
+ } else if (dflag == 0) {
+ goto L80;
+ } else {
+ goto L100;
+ }
L80:
- dh12 = dparam[4];
- dh21 = dparam[3];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = dx[kx];
- z__ = dy[ky];
- dx[kx] = w + z__ * dh12;
- dy[ky] = w * dh21 + z__;
- kx += *incx;
- ky += *incy;
-/* L90: */
- }
- goto L140;
+ dh12 = dparam[4];
+ dh21 = dparam[3];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = dx[kx];
+ z__ = dy[ky];
+ dx[kx] = w + z__ * dh12;
+ dy[ky] = w * dh21 + z__;
+ kx += *incx;
+ ky += *incy;
+ /* L90: */
+ }
+ goto L140;
L100:
- dh11 = dparam[2];
- dh22 = dparam[5];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = dx[kx];
- z__ = dy[ky];
- dx[kx] = w * dh11 + z__;
- dy[ky] = -w + dh22 * z__;
- kx += *incx;
- ky += *incy;
-/* L110: */
- }
- goto L140;
+ dh11 = dparam[2];
+ dh22 = dparam[5];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = dx[kx];
+ z__ = dy[ky];
+ dx[kx] = w * dh11 + z__;
+ dy[ky] = -w + dh22 * z__;
+ kx += *incx;
+ ky += *incy;
+ /* L110: */
+ }
+ goto L140;
L120:
- dh11 = dparam[2];
- dh12 = dparam[4];
- dh21 = dparam[3];
- dh22 = dparam[5];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = dx[kx];
- z__ = dy[ky];
- dx[kx] = w * dh11 + z__ * dh12;
- dy[ky] = w * dh21 + z__ * dh22;
- kx += *incx;
- ky += *incy;
-/* L130: */
- }
+ dh11 = dparam[2];
+ dh12 = dparam[4];
+ dh21 = dparam[3];
+ dh22 = dparam[5];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = dx[kx];
+ z__ = dy[ky];
+ dx[kx] = w * dh11 + z__ * dh12;
+ dy[ky] = w * dh21 + z__ * dh22;
+ kx += *incx;
+ ky += *incy;
+ /* L130: */
+ }
L140:
- return 0;
+ return 0;
} /* drotm_ */
-
diff --git a/blas/f2c/drotmg.c b/blas/f2c/drotmg.c
index a63eb10..1a7115a 100644
--- a/blas/f2c/drotmg.c
+++ b/blas/f2c/drotmg.c
@@ -1,293 +1,293 @@
/* drotmg.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *
- dx1, doublereal *dy1, doublereal *dparam)
-{
- /* Initialized data */
+/* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam) {
+ /* Initialized data */
- static doublereal zero = 0.;
- static doublereal one = 1.;
- static doublereal two = 2.;
- static doublereal gam = 4096.;
- static doublereal gamsq = 16777216.;
- static doublereal rgamsq = 5.9604645e-8;
+ static doublereal zero = 0.;
+ static doublereal one = 1.;
+ static doublereal two = 2.;
+ static doublereal gam = 4096.;
+ static doublereal gamsq = 16777216.;
+ static doublereal rgamsq = 5.9604645e-8;
- /* Format strings */
- static char fmt_120[] = "";
- static char fmt_150[] = "";
- static char fmt_180[] = "";
- static char fmt_210[] = "";
+ /* Format strings */
+ static char fmt_120[] = "";
+ static char fmt_150[] = "";
+ static char fmt_180[] = "";
+ static char fmt_210[] = "";
- /* System generated locals */
- doublereal d__1;
+ /* System generated locals */
+ doublereal d__1;
- /* Local variables */
- doublereal du, dp1, dp2, dq1, dq2, dh11, dh12, dh21, dh22;
- integer igo;
- doublereal dflag, dtemp;
+ /* Local variables */
+ doublereal du, dp1, dp2, dq1, dq2, dh11, dh12, dh21, dh22;
+ integer igo;
+ doublereal dflag, dtemp;
- /* Assigned format variables */
- static char *igo_fmt;
+ /* Assigned format variables */
+ static char *igo_fmt;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS */
-/* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)* */
-/* DY2)**T. */
-/* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
+ /* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS */
+ /* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)* */
+ /* DY2)**T. */
+ /* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
-/* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
+ /* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
-/* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
-/* H=( ) ( ) ( ) ( ) */
-/* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
-/* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 */
-/* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE */
-/* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) */
+ /* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
+ /* H=( ) ( ) ( ) ( ) */
+ /* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
+ /* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 */
+ /* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE */
+ /* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) */
-/* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE */
-/* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */
-/* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
+ /* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE */
+ /* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */
+ /* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
+ /* Arguments */
+ /* ========= */
-/* Arguments */
-/* ========= */
+ /* DD1 (input/output) DOUBLE PRECISION */
-/* DD1 (input/output) DOUBLE PRECISION */
+ /* DD2 (input/output) DOUBLE PRECISION */
-/* DD2 (input/output) DOUBLE PRECISION */
+ /* DX1 (input/output) DOUBLE PRECISION */
-/* DX1 (input/output) DOUBLE PRECISION */
+ /* DY1 (input) DOUBLE PRECISION */
-/* DY1 (input) DOUBLE PRECISION */
+ /* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */
+ /* DPARAM(1)=DFLAG */
+ /* DPARAM(2)=DH11 */
+ /* DPARAM(3)=DH21 */
+ /* DPARAM(4)=DH12 */
+ /* DPARAM(5)=DH22 */
-/* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */
-/* DPARAM(1)=DFLAG */
-/* DPARAM(2)=DH11 */
-/* DPARAM(3)=DH21 */
-/* DPARAM(4)=DH12 */
-/* DPARAM(5)=DH22 */
+ /* ===================================================================== */
-/* ===================================================================== */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
+ /* .. Data statements .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
-/* .. Data statements .. */
+ /* Parameter adjustments */
+ --dparam;
- /* Parameter adjustments */
- --dparam;
-
- /* Function Body */
-/* .. */
- if (! (*dd1 < zero)) {
- goto L10;
- }
-/* GO ZERO-H-D-AND-DX1.. */
- goto L60;
+ /* Function Body */
+ /* .. */
+ if (!(*dd1 < zero)) {
+ goto L10;
+ }
+ /* GO ZERO-H-D-AND-DX1.. */
+ goto L60;
L10:
-/* CASE-DD1-NONNEGATIVE */
- dp2 = *dd2 * *dy1;
- if (! (dp2 == zero)) {
- goto L20;
- }
- dflag = -two;
- goto L260;
+ /* CASE-DD1-NONNEGATIVE */
+ dp2 = *dd2 * *dy1;
+ if (!(dp2 == zero)) {
+ goto L20;
+ }
+ dflag = -two;
+ goto L260;
/* REGULAR-CASE.. */
L20:
- dp1 = *dd1 * *dx1;
- dq2 = dp2 * *dy1;
- dq1 = dp1 * *dx1;
+ dp1 = *dd1 * *dx1;
+ dq2 = dp2 * *dy1;
+ dq1 = dp1 * *dx1;
- if (! (abs(dq1) > abs(dq2))) {
- goto L40;
- }
- dh21 = -(*dy1) / *dx1;
- dh12 = dp2 / dp1;
+ if (!(abs(dq1) > abs(dq2))) {
+ goto L40;
+ }
+ dh21 = -(*dy1) / *dx1;
+ dh12 = dp2 / dp1;
- du = one - dh12 * dh21;
+ du = one - dh12 * dh21;
- if (! (du <= zero)) {
- goto L30;
- }
-/* GO ZERO-H-D-AND-DX1.. */
- goto L60;
+ if (!(du <= zero)) {
+ goto L30;
+ }
+ /* GO ZERO-H-D-AND-DX1.. */
+ goto L60;
L30:
- dflag = zero;
- *dd1 /= du;
- *dd2 /= du;
- *dx1 *= du;
-/* GO SCALE-CHECK.. */
- goto L100;
+ dflag = zero;
+ *dd1 /= du;
+ *dd2 /= du;
+ *dx1 *= du;
+ /* GO SCALE-CHECK.. */
+ goto L100;
L40:
- if (! (dq2 < zero)) {
- goto L50;
- }
-/* GO ZERO-H-D-AND-DX1.. */
- goto L60;
+ if (!(dq2 < zero)) {
+ goto L50;
+ }
+ /* GO ZERO-H-D-AND-DX1.. */
+ goto L60;
L50:
- dflag = one;
- dh11 = dp1 / dp2;
- dh22 = *dx1 / *dy1;
- du = one + dh11 * dh22;
- dtemp = *dd2 / du;
- *dd2 = *dd1 / du;
- *dd1 = dtemp;
- *dx1 = *dy1 * du;
-/* GO SCALE-CHECK */
- goto L100;
+ dflag = one;
+ dh11 = dp1 / dp2;
+ dh22 = *dx1 / *dy1;
+ du = one + dh11 * dh22;
+ dtemp = *dd2 / du;
+ *dd2 = *dd1 / du;
+ *dd1 = dtemp;
+ *dx1 = *dy1 * du;
+ /* GO SCALE-CHECK */
+ goto L100;
/* PROCEDURE..ZERO-H-D-AND-DX1.. */
L60:
- dflag = -one;
- dh11 = zero;
- dh12 = zero;
- dh21 = zero;
- dh22 = zero;
+ dflag = -one;
+ dh11 = zero;
+ dh12 = zero;
+ dh21 = zero;
+ dh22 = zero;
- *dd1 = zero;
- *dd2 = zero;
- *dx1 = zero;
-/* RETURN.. */
- goto L220;
+ *dd1 = zero;
+ *dd2 = zero;
+ *dx1 = zero;
+ /* RETURN.. */
+ goto L220;
/* PROCEDURE..FIX-H.. */
L70:
- if (! (dflag >= zero)) {
- goto L90;
- }
-
- if (! (dflag == zero)) {
- goto L80;
- }
- dh11 = one;
- dh22 = one;
- dflag = -one;
+ if (!(dflag >= zero)) {
goto L90;
+ }
+
+ if (!(dflag == zero)) {
+ goto L80;
+ }
+ dh11 = one;
+ dh22 = one;
+ dflag = -one;
+ goto L90;
L80:
- dh21 = -one;
- dh12 = one;
- dflag = -one;
+ dh21 = -one;
+ dh12 = one;
+ dflag = -one;
L90:
- switch (igo) {
- case 0: goto L120;
- case 1: goto L150;
- case 2: goto L180;
- case 3: goto L210;
- }
+ switch (igo) {
+ case 0:
+ goto L120;
+ case 1:
+ goto L150;
+ case 2:
+ goto L180;
+ case 3:
+ goto L210;
+ }
/* PROCEDURE..SCALE-CHECK */
L100:
L110:
- if (! (*dd1 <= rgamsq)) {
- goto L130;
- }
- if (*dd1 == zero) {
- goto L160;
- }
- igo = 0;
- igo_fmt = fmt_120;
-/* FIX-H.. */
- goto L70;
+ if (!(*dd1 <= rgamsq)) {
+ goto L130;
+ }
+ if (*dd1 == zero) {
+ goto L160;
+ }
+ igo = 0;
+ igo_fmt = fmt_120;
+ /* FIX-H.. */
+ goto L70;
L120:
-/* Computing 2nd power */
- d__1 = gam;
- *dd1 *= d__1 * d__1;
- *dx1 /= gam;
- dh11 /= gam;
- dh12 /= gam;
- goto L110;
+ /* Computing 2nd power */
+ d__1 = gam;
+ *dd1 *= d__1 * d__1;
+ *dx1 /= gam;
+ dh11 /= gam;
+ dh12 /= gam;
+ goto L110;
L130:
L140:
- if (! (*dd1 >= gamsq)) {
- goto L160;
- }
- igo = 1;
- igo_fmt = fmt_150;
-/* FIX-H.. */
- goto L70;
+ if (!(*dd1 >= gamsq)) {
+ goto L160;
+ }
+ igo = 1;
+ igo_fmt = fmt_150;
+ /* FIX-H.. */
+ goto L70;
L150:
-/* Computing 2nd power */
- d__1 = gam;
- *dd1 /= d__1 * d__1;
- *dx1 *= gam;
- dh11 *= gam;
- dh12 *= gam;
- goto L140;
+ /* Computing 2nd power */
+ d__1 = gam;
+ *dd1 /= d__1 * d__1;
+ *dx1 *= gam;
+ dh11 *= gam;
+ dh12 *= gam;
+ goto L140;
L160:
L170:
- if (! (abs(*dd2) <= rgamsq)) {
- goto L190;
- }
- if (*dd2 == zero) {
- goto L220;
- }
- igo = 2;
- igo_fmt = fmt_180;
-/* FIX-H.. */
- goto L70;
+ if (!(abs(*dd2) <= rgamsq)) {
+ goto L190;
+ }
+ if (*dd2 == zero) {
+ goto L220;
+ }
+ igo = 2;
+ igo_fmt = fmt_180;
+ /* FIX-H.. */
+ goto L70;
L180:
-/* Computing 2nd power */
- d__1 = gam;
- *dd2 *= d__1 * d__1;
- dh21 /= gam;
- dh22 /= gam;
- goto L170;
+ /* Computing 2nd power */
+ d__1 = gam;
+ *dd2 *= d__1 * d__1;
+ dh21 /= gam;
+ dh22 /= gam;
+ goto L170;
L190:
L200:
- if (! (abs(*dd2) >= gamsq)) {
- goto L220;
- }
- igo = 3;
- igo_fmt = fmt_210;
-/* FIX-H.. */
- goto L70;
+ if (!(abs(*dd2) >= gamsq)) {
+ goto L220;
+ }
+ igo = 3;
+ igo_fmt = fmt_210;
+ /* FIX-H.. */
+ goto L70;
L210:
-/* Computing 2nd power */
- d__1 = gam;
- *dd2 /= d__1 * d__1;
- dh21 *= gam;
- dh22 *= gam;
- goto L200;
+ /* Computing 2nd power */
+ d__1 = gam;
+ *dd2 /= d__1 * d__1;
+ dh21 *= gam;
+ dh22 *= gam;
+ goto L200;
L220:
- if (dflag < 0.) {
- goto L250;
- } else if (dflag == 0) {
- goto L230;
- } else {
- goto L240;
- }
+ if (dflag < 0.) {
+ goto L250;
+ } else if (dflag == 0) {
+ goto L230;
+ } else {
+ goto L240;
+ }
L230:
- dparam[3] = dh21;
- dparam[4] = dh12;
- goto L260;
+ dparam[3] = dh21;
+ dparam[4] = dh12;
+ goto L260;
L240:
- dparam[2] = dh11;
- dparam[5] = dh22;
- goto L260;
+ dparam[2] = dh11;
+ dparam[5] = dh22;
+ goto L260;
L250:
- dparam[2] = dh11;
- dparam[3] = dh21;
- dparam[4] = dh12;
- dparam[5] = dh22;
+ dparam[2] = dh11;
+ dparam[3] = dh21;
+ dparam[4] = dh12;
+ dparam[5] = dh22;
L260:
- dparam[1] = dflag;
- return 0;
+ dparam[1] = dflag;
+ return 0;
} /* drotmg_ */
-
diff --git a/blas/f2c/dsbmv.c b/blas/f2c/dsbmv.c
index c6b4b21..9b11b15 100644
--- a/blas/f2c/dsbmv.c
+++ b/blas/f2c/dsbmv.c
@@ -1,366 +1,359 @@
/* dsbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int dsbmv_(char *uplo, integer *n, integer *k, doublereal *
- alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
- doublereal *beta, doublereal *y, integer *incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+/* Subroutine */ int dsbmv_(char *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy,
+ ftnlen uplo_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
- /* Local variables */
- integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
- doublereal temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
+ doublereal temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* DSBMV performs the matrix-vector operation */
+ /* DSBMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n symmetric band matrix, with k super-diagonals. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n symmetric band matrix, with k super-diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the band matrix A is being supplied as */
-/* follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the band matrix A is being supplied as */
+ /* follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* being supplied. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* being supplied. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry, K specifies the number of super-diagonals of the */
-/* matrix A. K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry, K specifies the number of super-diagonals of the */
+ /* matrix A. K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* ALPHA - DOUBLE PRECISION. */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - DOUBLE PRECISION. */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the symmetric matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer the upper */
-/* triangular part of a symmetric band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the symmetric matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer the upper */
+ /* triangular part of a symmetric band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the symmetric matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer the lower */
-/* triangular part of a symmetric band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the symmetric matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer the lower */
+ /* triangular part of a symmetric band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - DOUBLE PRECISION array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the */
-/* vector x. */
-/* Unchanged on exit. */
+ /* X - DOUBLE PRECISION array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the */
+ /* vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - DOUBLE PRECISION. */
-/* On entry, BETA specifies the scalar beta. */
-/* Unchanged on exit. */
+ /* BETA - DOUBLE PRECISION. */
+ /* On entry, BETA specifies the scalar beta. */
+ /* Unchanged on exit. */
-/* Y - DOUBLE PRECISION array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the */
-/* vector y. On exit, Y is overwritten by the updated vector y. */
+ /* Y - DOUBLE PRECISION array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the */
+ /* vector y. On exit, Y is overwritten by the updated vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
+ /* Level 2 Blas routine. */
-/* Level 2 Blas routine. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* ===================================================================== */
-/* ===================================================================== */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* Test the input parameters. */
-/* Test the input parameters. */
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
- --y;
-
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*k < 0) {
- info = 3;
- } else if (*lda < *k + 1) {
- info = 6;
- } else if (*incx == 0) {
- info = 8;
- } else if (*incy == 0) {
- info = 11;
- }
- if (info != 0) {
- xerbla_("DSBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array A */
-/* are accessed sequentially with one pass through A. */
-
-/* First form y := beta*y. */
-
- if (*beta != 1.) {
- if (*incy == 1) {
- if (*beta == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = 0.;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = *beta * y[i__];
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (*beta == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = 0.;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = *beta * y[iy];
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (*alpha == 0.) {
- return 0;
- }
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when upper triangle of A is stored. */
-
- kplus1 = *k + 1;
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- y[i__] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[i__];
-/* L50: */
- }
- y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.;
- ix = kx;
- iy = ky;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- y[iy] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[ix];
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha *
- temp2;
- jx += *incx;
- jy += *incy;
- if (j > *k) {
- kx += *incx;
- ky += *incy;
- }
-/* L80: */
- }
- }
- } else {
-
-/* Form y when lower triangle of A is stored. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.;
- y[j] += temp1 * a[j * a_dim1 + 1];
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- y[i__] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[i__];
-/* L90: */
- }
- y[j] += *alpha * temp2;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.;
- y[jy] += temp1 * a[j * a_dim1 + 1];
- l = 1 - j;
- ix = jx;
- iy = jy;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- ix += *incx;
- iy += *incy;
- y[iy] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[ix];
-/* L110: */
- }
- y[jy] += *alpha * temp2;
- jx += *incx;
- jy += *incy;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*k < 0) {
+ info = 3;
+ } else if (*lda < *k + 1) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DSBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of DSBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array A */
+ /* are accessed sequentially with one pass through A. */
+
+ /* First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when upper triangle of A is stored. */
+
+ kplus1 = *k + 1;
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ y[i__] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[i__];
+ /* L50: */
+ }
+ y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ ix = kx;
+ iy = ky;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ y[iy] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ if (j > *k) {
+ kx += *incx;
+ ky += *incy;
+ }
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when lower triangle of A is stored. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ y[j] += temp1 * a[j * a_dim1 + 1];
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ y[i__] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[i__];
+ /* L90: */
+ }
+ y[j] += *alpha * temp2;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ y[jy] += temp1 * a[j * a_dim1 + 1];
+ l = 1 - j;
+ ix = jx;
+ iy = jy;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[ix];
+ /* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of DSBMV . */
} /* dsbmv_ */
-
diff --git a/blas/f2c/dspmv.c b/blas/f2c/dspmv.c
index 0b4e92d..2d037ff 100644
--- a/blas/f2c/dspmv.c
+++ b/blas/f2c/dspmv.c
@@ -1,316 +1,310 @@
/* dspmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int dspmv_(char *uplo, integer *n, doublereal *alpha,
- doublereal *ap, doublereal *x, integer *incx, doublereal *beta,
- doublereal *y, integer *incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer i__1, i__2;
+/* Subroutine */ int dspmv_(char *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer i__1, i__2;
- /* Local variables */
- integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
- doublereal temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
+ doublereal temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* DSPMV performs the matrix-vector operation */
+ /* DSPMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n symmetric matrix, supplied in packed form. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n symmetric matrix, supplied in packed form. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the matrix A is supplied in the packed */
-/* array AP as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the matrix A is supplied in the packed */
+ /* array AP as follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* supplied in AP. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* supplied in AP. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* ALPHA - DOUBLE PRECISION. */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - DOUBLE PRECISION. */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* AP - DOUBLE PRECISION array of DIMENSION at least */
-/* ( ( n*( n + 1 ) )/2 ). */
-/* Before entry with UPLO = 'U' or 'u', the array AP must */
-/* contain the upper triangular part of the symmetric matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
-/* and a( 2, 2 ) respectively, and so on. */
-/* Before entry with UPLO = 'L' or 'l', the array AP must */
-/* contain the lower triangular part of the symmetric matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
-/* and a( 3, 1 ) respectively, and so on. */
-/* Unchanged on exit. */
+ /* AP - DOUBLE PRECISION array of DIMENSION at least */
+ /* ( ( n*( n + 1 ) )/2 ). */
+ /* Before entry with UPLO = 'U' or 'u', the array AP must */
+ /* contain the upper triangular part of the symmetric matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
+ /* and a( 2, 2 ) respectively, and so on. */
+ /* Before entry with UPLO = 'L' or 'l', the array AP must */
+ /* contain the lower triangular part of the symmetric matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
+ /* and a( 3, 1 ) respectively, and so on. */
+ /* Unchanged on exit. */
-/* X - DOUBLE PRECISION array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. */
-/* Unchanged on exit. */
+ /* X - DOUBLE PRECISION array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - DOUBLE PRECISION. */
-/* On entry, BETA specifies the scalar beta. When BETA is */
-/* supplied as zero then Y need not be set on input. */
-/* Unchanged on exit. */
+ /* BETA - DOUBLE PRECISION. */
+ /* On entry, BETA specifies the scalar beta. When BETA is */
+ /* supplied as zero then Y need not be set on input. */
+ /* Unchanged on exit. */
-/* Y - DOUBLE PRECISION array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the n */
-/* element vector y. On exit, Y is overwritten by the updated */
-/* vector y. */
+ /* Y - DOUBLE PRECISION array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the n */
+ /* element vector y. On exit, Y is overwritten by the updated */
+ /* vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- --y;
- --x;
- --ap;
+ /* Parameter adjustments */
+ --y;
+ --x;
+ --ap;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*incx == 0) {
- info = 6;
- } else if (*incy == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("DSPMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array AP */
-/* are accessed sequentially with one pass through AP. */
-
-/* First form y := beta*y. */
-
- if (*beta != 1.) {
- if (*incy == 1) {
- if (*beta == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = 0.;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = *beta * y[i__];
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (*beta == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = 0.;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = *beta * y[iy];
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (*alpha == 0.) {
- return 0;
- }
- kk = 1;
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when AP contains the upper triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.;
- k = kk;
- i__2 = j - 1;
- for (i__ = 1; i__ <= i__2; ++i__) {
- y[i__] += temp1 * ap[k];
- temp2 += ap[k] * x[i__];
- ++k;
-/* L50: */
- }
- y[j] = y[j] + temp1 * ap[kk + j - 1] + *alpha * temp2;
- kk += j;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.;
- ix = kx;
- iy = ky;
- i__2 = kk + j - 2;
- for (k = kk; k <= i__2; ++k) {
- y[iy] += temp1 * ap[k];
- temp2 += ap[k] * x[ix];
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- y[jy] = y[jy] + temp1 * ap[kk + j - 1] + *alpha * temp2;
- jx += *incx;
- jy += *incy;
- kk += j;
-/* L80: */
- }
- }
- } else {
-
-/* Form y when AP contains the lower triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.;
- y[j] += temp1 * ap[kk];
- k = kk + 1;
- i__2 = *n;
- for (i__ = j + 1; i__ <= i__2; ++i__) {
- y[i__] += temp1 * ap[k];
- temp2 += ap[k] * x[i__];
- ++k;
-/* L90: */
- }
- y[j] += *alpha * temp2;
- kk += *n - j + 1;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.;
- y[jy] += temp1 * ap[kk];
- ix = jx;
- iy = jy;
- i__2 = kk + *n - j;
- for (k = kk + 1; k <= i__2; ++k) {
- ix += *incx;
- iy += *incy;
- y[iy] += temp1 * ap[k];
- temp2 += ap[k] * x[ix];
-/* L110: */
- }
- y[jy] += *alpha * temp2;
- jx += *incx;
- jy += *incy;
- kk += *n - j + 1;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 6;
+ } else if (*incy == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DSPMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of DSPMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array AP */
+ /* are accessed sequentially with one pass through AP. */
+
+ /* First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ kk = 1;
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when AP contains the upper triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ k = kk;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * ap[k];
+ temp2 += ap[k] * x[i__];
+ ++k;
+ /* L50: */
+ }
+ y[j] = y[j] + temp1 * ap[kk + j - 1] + *alpha * temp2;
+ kk += j;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ ix = kx;
+ iy = ky;
+ i__2 = kk + j - 2;
+ for (k = kk; k <= i__2; ++k) {
+ y[iy] += temp1 * ap[k];
+ temp2 += ap[k] * x[ix];
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ y[jy] = y[jy] + temp1 * ap[kk + j - 1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ kk += j;
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when AP contains the lower triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ y[j] += temp1 * ap[kk];
+ k = kk + 1;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * ap[k];
+ temp2 += ap[k] * x[i__];
+ ++k;
+ /* L90: */
+ }
+ y[j] += *alpha * temp2;
+ kk += *n - j + 1;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ y[jy] += temp1 * ap[kk];
+ ix = jx;
+ iy = jy;
+ i__2 = kk + *n - j;
+ for (k = kk + 1; k <= i__2; ++k) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * ap[k];
+ temp2 += ap[k] * x[ix];
+ /* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ kk += *n - j + 1;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of DSPMV . */
} /* dspmv_ */
-
diff --git a/blas/f2c/dtbmv.c b/blas/f2c/dtbmv.c
index aa67d19..96c9780 100644
--- a/blas/f2c/dtbmv.c
+++ b/blas/f2c/dtbmv.c
@@ -1,428 +1,420 @@
/* dtbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int dtbmv_(char *uplo, char *trans, char *diag, integer *n,
- integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx,
- ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+/* Subroutine */ int dtbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublereal *a, integer *lda,
+ doublereal *x, integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
- /* Local variables */
- integer i__, j, l, ix, jx, kx, info;
- doublereal temp;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
- logical nounit;
+ /* Local variables */
+ integer i__, j, l, ix, jx, kx, info;
+ doublereal temp;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ logical nounit;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* DTBMV performs one of the matrix-vector operations */
+ /* DTBMV performs one of the matrix-vector operations */
-/* x := A*x, or x := A'*x, */
+ /* x := A*x, or x := A'*x, */
-/* where x is an n element vector and A is an n by n unit, or non-unit, */
-/* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
+ /* where x is an n element vector and A is an n by n unit, or non-unit, */
+ /* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the matrix is an upper or */
-/* lower triangular matrix as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the matrix is an upper or */
+ /* lower triangular matrix as follows: */
-/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+ /* UPLO = 'U' or 'u' A is an upper triangular matrix. */
-/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+ /* UPLO = 'L' or 'l' A is a lower triangular matrix. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* TRANS - CHARACTER*1. */
-/* On entry, TRANS specifies the operation to be performed as */
-/* follows: */
+ /* TRANS - CHARACTER*1. */
+ /* On entry, TRANS specifies the operation to be performed as */
+ /* follows: */
-/* TRANS = 'N' or 'n' x := A*x. */
+ /* TRANS = 'N' or 'n' x := A*x. */
-/* TRANS = 'T' or 't' x := A'*x. */
+ /* TRANS = 'T' or 't' x := A'*x. */
-/* TRANS = 'C' or 'c' x := A'*x. */
+ /* TRANS = 'C' or 'c' x := A'*x. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* DIAG - CHARACTER*1. */
-/* On entry, DIAG specifies whether or not A is unit */
-/* triangular as follows: */
+ /* DIAG - CHARACTER*1. */
+ /* On entry, DIAG specifies whether or not A is unit */
+ /* triangular as follows: */
-/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+ /* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
-/* DIAG = 'N' or 'n' A is not assumed to be unit */
-/* triangular. */
+ /* DIAG = 'N' or 'n' A is not assumed to be unit */
+ /* triangular. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry with UPLO = 'U' or 'u', K specifies the number of */
-/* super-diagonals of the matrix A. */
-/* On entry with UPLO = 'L' or 'l', K specifies the number of */
-/* sub-diagonals of the matrix A. */
-/* K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry with UPLO = 'U' or 'u', K specifies the number of */
+ /* super-diagonals of the matrix A. */
+ /* On entry with UPLO = 'L' or 'l', K specifies the number of */
+ /* sub-diagonals of the matrix A. */
+ /* K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer an upper */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer an upper */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer a lower */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer a lower */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that when DIAG = 'U' or 'u' the elements of the array A */
-/* corresponding to the diagonal elements of the matrix are not */
-/* referenced, but are assumed to be unity. */
-/* Unchanged on exit. */
+ /* Note that when DIAG = 'U' or 'u' the elements of the array A */
+ /* corresponding to the diagonal elements of the matrix are not */
+ /* referenced, but are assumed to be unity. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - DOUBLE PRECISION array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. On exit, X is overwritten with the */
-/* transformed vector x. */
+ /* X - DOUBLE PRECISION array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. On exit, X is overwritten with the */
+ /* transformed vector x. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans,
- "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (
- ftnlen)1)) {
- info = 2;
- } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag,
- "N", (ftnlen)1, (ftnlen)1)) {
- info = 3;
- } else if (*n < 0) {
- info = 4;
- } else if (*k < 0) {
- info = 5;
- } else if (*lda < *k + 1) {
- info = 7;
- } else if (*incx == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("DTBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0) {
- return 0;
- }
-
- nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
-
-/* Set up the start point in X if the increment is not unity. This */
-/* will be ( N - 1 )*INCX too small for descending loops. */
-
- if (*incx <= 0) {
- kx = 1 - (*n - 1) * *incx;
- } else if (*incx != 1) {
- kx = 1;
- }
-
-/* Start the operations. In this version the elements of A are */
-/* accessed sequentially with one pass through A. */
-
- if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
-
-/* Form x := A*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- if (x[j] != 0.) {
- temp = x[j];
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- x[i__] += temp * a[l + i__ + j * a_dim1];
-/* L10: */
- }
- if (nounit) {
- x[j] *= a[kplus1 + j * a_dim1];
- }
- }
-/* L20: */
- }
- } else {
- jx = kx;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- if (x[jx] != 0.) {
- temp = x[jx];
- ix = kx;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- x[ix] += temp * a[l + i__ + j * a_dim1];
- ix += *incx;
-/* L30: */
- }
- if (nounit) {
- x[jx] *= a[kplus1 + j * a_dim1];
- }
- }
- jx += *incx;
- if (j > *k) {
- kx += *incx;
- }
-/* L40: */
- }
- }
- } else {
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- if (x[j] != 0.) {
- temp = x[j];
- l = 1 - j;
-/* Computing MIN */
- i__1 = *n, i__3 = j + *k;
- i__4 = j + 1;
- for (i__ = min(i__1,i__3); i__ >= i__4; --i__) {
- x[i__] += temp * a[l + i__ + j * a_dim1];
-/* L50: */
- }
- if (nounit) {
- x[j] *= a[j * a_dim1 + 1];
- }
- }
-/* L60: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- if (x[jx] != 0.) {
- temp = x[jx];
- ix = kx;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__1 = j + *k;
- i__3 = j + 1;
- for (i__ = min(i__4,i__1); i__ >= i__3; --i__) {
- x[ix] += temp * a[l + i__ + j * a_dim1];
- ix -= *incx;
-/* L70: */
- }
- if (nounit) {
- x[jx] *= a[j * a_dim1 + 1];
- }
- }
- jx -= *incx;
- if (*n - j >= *k) {
- kx -= *incx;
- }
-/* L80: */
- }
- }
- }
- } else {
-
-/* Form x := A'*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- temp = x[j];
- l = kplus1 - j;
- if (nounit) {
- temp *= a[kplus1 + j * a_dim1];
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- temp += a[l + i__ + j * a_dim1] * x[i__];
-/* L90: */
- }
- x[j] = temp;
-/* L100: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- temp = x[jx];
- kx -= *incx;
- ix = kx;
- l = kplus1 - j;
- if (nounit) {
- temp *= a[kplus1 + j * a_dim1];
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- temp += a[l + i__ + j * a_dim1] * x[ix];
- ix -= *incx;
-/* L110: */
- }
- x[jx] = temp;
- jx -= *incx;
-/* L120: */
- }
- }
- } else {
- if (*incx == 1) {
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- temp = x[j];
- l = 1 - j;
- if (nounit) {
- temp *= a[j * a_dim1 + 1];
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- temp += a[l + i__ + j * a_dim1] * x[i__];
-/* L130: */
- }
- x[j] = temp;
-/* L140: */
- }
- } else {
- jx = kx;
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- temp = x[jx];
- kx += *incx;
- ix = kx;
- l = 1 - j;
- if (nounit) {
- temp *= a[j * a_dim1 + 1];
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- temp += a[l + i__ + j * a_dim1] * x[ix];
- ix += *incx;
-/* L150: */
- }
- x[jx] = temp;
- jx += *incx;
-/* L160: */
- }
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
+ !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
+ info = 2;
+ } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < *k + 1) {
+ info = 7;
+ } else if (*incx == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DTBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of DTBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
+
+ /* Set up the start point in X if the increment is not unity. This */
+ /* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+ /* Start the operations. In this version the elements of A are */
+ /* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
+ /* Form x := A*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ x[i__] += temp * a[l + i__ + j * a_dim1];
+ /* L10: */
+ }
+ if (nounit) {
+ x[j] *= a[kplus1 + j * a_dim1];
+ }
+ }
+ /* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ x[ix] += temp * a[l + i__ + j * a_dim1];
+ ix += *incx;
+ /* L30: */
+ }
+ if (nounit) {
+ x[jx] *= a[kplus1 + j * a_dim1];
+ }
+ }
+ jx += *incx;
+ if (j > *k) {
+ kx += *incx;
+ }
+ /* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ l = 1 - j;
+ /* Computing MIN */
+ i__1 = *n, i__3 = j + *k;
+ i__4 = j + 1;
+ for (i__ = min(i__1, i__3); i__ >= i__4; --i__) {
+ x[i__] += temp * a[l + i__ + j * a_dim1];
+ /* L50: */
+ }
+ if (nounit) {
+ x[j] *= a[j * a_dim1 + 1];
+ }
+ }
+ /* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__1 = j + *k;
+ i__3 = j + 1;
+ for (i__ = min(i__4, i__1); i__ >= i__3; --i__) {
+ x[ix] += temp * a[l + i__ + j * a_dim1];
+ ix -= *incx;
+ /* L70: */
+ }
+ if (nounit) {
+ x[jx] *= a[j * a_dim1 + 1];
+ }
+ }
+ jx -= *incx;
+ if (*n - j >= *k) {
+ kx -= *incx;
+ }
+ /* L80: */
+ }
+ }
+ }
+ } else {
+ /* Form x := A'*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ l = kplus1 - j;
+ if (nounit) {
+ temp *= a[kplus1 + j * a_dim1];
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ temp += a[l + i__ + j * a_dim1] * x[i__];
+ /* L90: */
+ }
+ x[j] = temp;
+ /* L100: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ kx -= *incx;
+ ix = kx;
+ l = kplus1 - j;
+ if (nounit) {
+ temp *= a[kplus1 + j * a_dim1];
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ temp += a[l + i__ + j * a_dim1] * x[ix];
+ ix -= *incx;
+ /* L110: */
+ }
+ x[jx] = temp;
+ jx -= *incx;
+ /* L120: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ temp = x[j];
+ l = 1 - j;
+ if (nounit) {
+ temp *= a[j * a_dim1 + 1];
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ temp += a[l + i__ + j * a_dim1] * x[i__];
+ /* L130: */
+ }
+ x[j] = temp;
+ /* L140: */
+ }
+ } else {
+ jx = kx;
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ temp = x[jx];
+ kx += *incx;
+ ix = kx;
+ l = 1 - j;
+ if (nounit) {
+ temp *= a[j * a_dim1 + 1];
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ temp += a[l + i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ /* L150: */
+ }
+ x[jx] = temp;
+ jx += *incx;
+ /* L160: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of DTBMV . */
} /* dtbmv_ */
-
diff --git a/blas/f2c/lsame.c b/blas/f2c/lsame.c
index 46324d9..550e0f1 100644
--- a/blas/f2c/lsame.c
+++ b/blas/f2c/lsame.c
@@ -1,117 +1,109 @@
/* lsame.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
-{
- /* System generated locals */
- logical ret_val;
+logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len) {
+ /* System generated locals */
+ logical ret_val;
- /* Local variables */
- integer inta, intb, zcode;
+ /* Local variables */
+ integer inta, intb, zcode;
+ /* -- LAPACK auxiliary routine (version 3.1) -- */
+ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+ /* November 2006 */
-/* -- LAPACK auxiliary routine (version 3.1) -- */
-/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
-/* November 2006 */
+ /* .. Scalar Arguments .. */
+ /* .. */
-/* .. Scalar Arguments .. */
-/* .. */
+ /* Purpose */
+ /* ======= */
-/* Purpose */
-/* ======= */
+ /* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
+ /* case. */
-/* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
-/* case. */
+ /* Arguments */
+ /* ========= */
-/* Arguments */
-/* ========= */
+ /* CA (input) CHARACTER*1 */
-/* CA (input) CHARACTER*1 */
+ /* CB (input) CHARACTER*1 */
+ /* CA and CB specify the single characters to be compared. */
-/* CB (input) CHARACTER*1 */
-/* CA and CB specify the single characters to be compared. */
+ /* ===================================================================== */
-/* ===================================================================== */
+ /* .. Intrinsic Functions .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
+ /* Test if the characters are equal */
-/* Test if the characters are equal */
-
- ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
- if (ret_val) {
- return ret_val;
- }
-
-/* Now test for equivalence if both characters are alphabetic. */
-
- zcode = 'Z';
-
-/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
-/* machines, on which ICHAR returns a value with bit 8 set. */
-/* ICHAR('A') on Prime machines returns 193 which is the same as */
-/* ICHAR('A') on an EBCDIC machine. */
-
- inta = *(unsigned char *)ca;
- intb = *(unsigned char *)cb;
-
- if (zcode == 90 || zcode == 122) {
-
-/* ASCII is assumed - ZCODE is the ASCII code of either lower or */
-/* upper case 'Z'. */
-
- if (inta >= 97 && inta <= 122) {
- inta += -32;
- }
- if (intb >= 97 && intb <= 122) {
- intb += -32;
- }
-
- } else if (zcode == 233 || zcode == 169) {
-
-/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
-/* upper case 'Z'. */
-
- if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) ||
- (inta >= 162 && inta <= 169)) {
- inta += 64;
- }
- if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) ||
- (intb >= 162 && intb <= 169)) {
- intb += 64;
- }
-
- } else if (zcode == 218 || zcode == 250) {
-
-/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
-/* plus 128 of either lower or upper case 'Z'. */
-
- if (inta >= 225 && inta <= 250) {
- inta += -32;
- }
- if (intb >= 225 && intb <= 250) {
- intb += -32;
- }
- }
- ret_val = inta == intb;
-
-/* RETURN */
-
-/* End of LSAME */
-
+ ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
+ if (ret_val) {
return ret_val;
-} /* lsame_ */
+ }
+ /* Now test for equivalence if both characters are alphabetic. */
+
+ zcode = 'Z';
+
+ /* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
+ /* machines, on which ICHAR returns a value with bit 8 set. */
+ /* ICHAR('A') on Prime machines returns 193 which is the same as */
+ /* ICHAR('A') on an EBCDIC machine. */
+
+ inta = *(unsigned char *)ca;
+ intb = *(unsigned char *)cb;
+
+ if (zcode == 90 || zcode == 122) {
+ /* ASCII is assumed - ZCODE is the ASCII code of either lower or */
+ /* upper case 'Z'. */
+
+ if (inta >= 97 && inta <= 122) {
+ inta += -32;
+ }
+ if (intb >= 97 && intb <= 122) {
+ intb += -32;
+ }
+
+ } else if (zcode == 233 || zcode == 169) {
+ /* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
+ /* upper case 'Z'. */
+
+ if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta >= 162 && inta <= 169)) {
+ inta += 64;
+ }
+ if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb >= 162 && intb <= 169)) {
+ intb += 64;
+ }
+
+ } else if (zcode == 218 || zcode == 250) {
+ /* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
+ /* plus 128 of either lower or upper case 'Z'. */
+
+ if (inta >= 225 && inta <= 250) {
+ inta += -32;
+ }
+ if (intb >= 225 && intb <= 250) {
+ intb += -32;
+ }
+ }
+ ret_val = inta == intb;
+
+ /* RETURN */
+
+ /* End of LSAME */
+
+ return ret_val;
+} /* lsame_ */
diff --git a/blas/f2c/r_cnjg.c b/blas/f2c/r_cnjg.c
index c08182f..dd4d346 100644
--- a/blas/f2c/r_cnjg.c
+++ b/blas/f2c/r_cnjg.c
@@ -1,6 +1,6 @@
-#include "datatypes.h"
+#include "datatypes.h"
void r_cnjg(complex *r, complex *z) {
- r->r = z->r;
- r->i = -(z->i);
+ r->r = z->r;
+ r->i = -(z->i);
}
diff --git a/blas/f2c/srotm.c b/blas/f2c/srotm.c
index bd5944a..7e9ab84 100644
--- a/blas/f2c/srotm.c
+++ b/blas/f2c/srotm.c
@@ -1,216 +1,212 @@
/* srotm.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy,
- integer *incy, real *sparam)
-{
- /* Initialized data */
+/* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam) {
+ /* Initialized data */
- static real zero = 0.f;
- static real two = 2.f;
+ static real zero = 0.f;
+ static real two = 2.f;
- /* System generated locals */
- integer i__1, i__2;
+ /* System generated locals */
+ integer i__1, i__2;
- /* Local variables */
- integer i__;
- real w, z__;
- integer kx, ky;
- real sh11, sh12, sh21, sh22, sflag;
- integer nsteps;
+ /* Local variables */
+ integer i__;
+ real w, z__;
+ integer kx, ky;
+ real sh11, sh12, sh21, sh22, sflag;
+ integer nsteps;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
+ /* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
-/* (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN */
-/* (DX**T) */
+ /* (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN */
+ /* (DX**T) */
-/* SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
-/* LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. */
-/* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
+ /* SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
+ /* LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. */
+ /* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
-/* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 */
+ /* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 */
-/* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) */
-/* H=( ) ( ) ( ) ( ) */
-/* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
-/* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */
+ /* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) */
+ /* H=( ) ( ) ( ) ( ) */
+ /* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
+ /* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */
+ /* Arguments */
+ /* ========= */
-/* Arguments */
-/* ========= */
+ /* N (input) INTEGER */
+ /* number of elements in input vector(s) */
-/* N (input) INTEGER */
-/* number of elements in input vector(s) */
+ /* SX (input/output) REAL array, dimension N */
+ /* double precision vector with N elements */
-/* SX (input/output) REAL array, dimension N */
-/* double precision vector with N elements */
+ /* INCX (input) INTEGER */
+ /* storage spacing between elements of SX */
-/* INCX (input) INTEGER */
-/* storage spacing between elements of SX */
+ /* SY (input/output) REAL array, dimension N */
+ /* double precision vector with N elements */
-/* SY (input/output) REAL array, dimension N */
-/* double precision vector with N elements */
+ /* INCY (input) INTEGER */
+ /* storage spacing between elements of SY */
-/* INCY (input) INTEGER */
-/* storage spacing between elements of SY */
+ /* SPARAM (input/output) REAL array, dimension 5 */
+ /* SPARAM(1)=SFLAG */
+ /* SPARAM(2)=SH11 */
+ /* SPARAM(3)=SH21 */
+ /* SPARAM(4)=SH12 */
+ /* SPARAM(5)=SH22 */
-/* SPARAM (input/output) REAL array, dimension 5 */
-/* SPARAM(1)=SFLAG */
-/* SPARAM(2)=SH11 */
-/* SPARAM(3)=SH21 */
-/* SPARAM(4)=SH12 */
-/* SPARAM(5)=SH22 */
+ /* ===================================================================== */
-/* ===================================================================== */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. Data statements .. */
+ /* Parameter adjustments */
+ --sparam;
+ --sy;
+ --sx;
-/* .. Local Scalars .. */
-/* .. */
-/* .. Data statements .. */
- /* Parameter adjustments */
- --sparam;
- --sy;
- --sx;
+ /* Function Body */
+ /* .. */
- /* Function Body */
-/* .. */
+ sflag = sparam[1];
+ if (*n <= 0 || sflag + two == zero) {
+ goto L140;
+ }
+ if (!(*incx == *incy && *incx > 0)) {
+ goto L70;
+ }
- sflag = sparam[1];
- if (*n <= 0 || sflag + two == zero) {
- goto L140;
- }
- if (! (*incx == *incy && *incx > 0)) {
- goto L70;
- }
-
- nsteps = *n * *incx;
- if (sflag < 0.f) {
- goto L50;
- } else if (sflag == 0) {
- goto L10;
- } else {
- goto L30;
- }
+ nsteps = *n * *incx;
+ if (sflag < 0.f) {
+ goto L50;
+ } else if (sflag == 0) {
+ goto L10;
+ } else {
+ goto L30;
+ }
L10:
- sh12 = sparam[4];
- sh21 = sparam[3];
- i__1 = nsteps;
- i__2 = *incx;
- for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
- w = sx[i__];
- z__ = sy[i__];
- sx[i__] = w + z__ * sh12;
- sy[i__] = w * sh21 + z__;
-/* L20: */
- }
- goto L140;
+ sh12 = sparam[4];
+ sh21 = sparam[3];
+ i__1 = nsteps;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ w = sx[i__];
+ z__ = sy[i__];
+ sx[i__] = w + z__ * sh12;
+ sy[i__] = w * sh21 + z__;
+ /* L20: */
+ }
+ goto L140;
L30:
- sh11 = sparam[2];
- sh22 = sparam[5];
- i__2 = nsteps;
- i__1 = *incx;
- for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
- w = sx[i__];
- z__ = sy[i__];
- sx[i__] = w * sh11 + z__;
- sy[i__] = -w + sh22 * z__;
-/* L40: */
- }
- goto L140;
+ sh11 = sparam[2];
+ sh22 = sparam[5];
+ i__2 = nsteps;
+ i__1 = *incx;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+ w = sx[i__];
+ z__ = sy[i__];
+ sx[i__] = w * sh11 + z__;
+ sy[i__] = -w + sh22 * z__;
+ /* L40: */
+ }
+ goto L140;
L50:
- sh11 = sparam[2];
- sh12 = sparam[4];
- sh21 = sparam[3];
- sh22 = sparam[5];
- i__1 = nsteps;
- i__2 = *incx;
- for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
- w = sx[i__];
- z__ = sy[i__];
- sx[i__] = w * sh11 + z__ * sh12;
- sy[i__] = w * sh21 + z__ * sh22;
-/* L60: */
- }
- goto L140;
+ sh11 = sparam[2];
+ sh12 = sparam[4];
+ sh21 = sparam[3];
+ sh22 = sparam[5];
+ i__1 = nsteps;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ w = sx[i__];
+ z__ = sy[i__];
+ sx[i__] = w * sh11 + z__ * sh12;
+ sy[i__] = w * sh21 + z__ * sh22;
+ /* L60: */
+ }
+ goto L140;
L70:
- kx = 1;
- ky = 1;
- if (*incx < 0) {
- kx = (1 - *n) * *incx + 1;
- }
- if (*incy < 0) {
- ky = (1 - *n) * *incy + 1;
- }
+ kx = 1;
+ ky = 1;
+ if (*incx < 0) {
+ kx = (1 - *n) * *incx + 1;
+ }
+ if (*incy < 0) {
+ ky = (1 - *n) * *incy + 1;
+ }
- if (sflag < 0.f) {
- goto L120;
- } else if (sflag == 0) {
- goto L80;
- } else {
- goto L100;
- }
+ if (sflag < 0.f) {
+ goto L120;
+ } else if (sflag == 0) {
+ goto L80;
+ } else {
+ goto L100;
+ }
L80:
- sh12 = sparam[4];
- sh21 = sparam[3];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = sx[kx];
- z__ = sy[ky];
- sx[kx] = w + z__ * sh12;
- sy[ky] = w * sh21 + z__;
- kx += *incx;
- ky += *incy;
-/* L90: */
- }
- goto L140;
+ sh12 = sparam[4];
+ sh21 = sparam[3];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = sx[kx];
+ z__ = sy[ky];
+ sx[kx] = w + z__ * sh12;
+ sy[ky] = w * sh21 + z__;
+ kx += *incx;
+ ky += *incy;
+ /* L90: */
+ }
+ goto L140;
L100:
- sh11 = sparam[2];
- sh22 = sparam[5];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = sx[kx];
- z__ = sy[ky];
- sx[kx] = w * sh11 + z__;
- sy[ky] = -w + sh22 * z__;
- kx += *incx;
- ky += *incy;
-/* L110: */
- }
- goto L140;
+ sh11 = sparam[2];
+ sh22 = sparam[5];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = sx[kx];
+ z__ = sy[ky];
+ sx[kx] = w * sh11 + z__;
+ sy[ky] = -w + sh22 * z__;
+ kx += *incx;
+ ky += *incy;
+ /* L110: */
+ }
+ goto L140;
L120:
- sh11 = sparam[2];
- sh12 = sparam[4];
- sh21 = sparam[3];
- sh22 = sparam[5];
- i__2 = *n;
- for (i__ = 1; i__ <= i__2; ++i__) {
- w = sx[kx];
- z__ = sy[ky];
- sx[kx] = w * sh11 + z__ * sh12;
- sy[ky] = w * sh21 + z__ * sh22;
- kx += *incx;
- ky += *incy;
-/* L130: */
- }
+ sh11 = sparam[2];
+ sh12 = sparam[4];
+ sh21 = sparam[3];
+ sh22 = sparam[5];
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w = sx[kx];
+ z__ = sy[ky];
+ sx[kx] = w * sh11 + z__ * sh12;
+ sy[ky] = w * sh21 + z__ * sh22;
+ kx += *incx;
+ ky += *incy;
+ /* L130: */
+ }
L140:
- return 0;
+ return 0;
} /* srotm_ */
-
diff --git a/blas/f2c/srotmg.c b/blas/f2c/srotmg.c
index 75f789f..3527568 100644
--- a/blas/f2c/srotmg.c
+++ b/blas/f2c/srotmg.c
@@ -1,295 +1,293 @@
/* srotmg.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real
- *sparam)
-{
- /* Initialized data */
+/* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam) {
+ /* Initialized data */
- static real zero = 0.f;
- static real one = 1.f;
- static real two = 2.f;
- static real gam = 4096.f;
- static real gamsq = 16777200.f;
- static real rgamsq = 5.96046e-8f;
+ static real zero = 0.f;
+ static real one = 1.f;
+ static real two = 2.f;
+ static real gam = 4096.f;
+ static real gamsq = 16777200.f;
+ static real rgamsq = 5.96046e-8f;
- /* Format strings */
- static char fmt_120[] = "";
- static char fmt_150[] = "";
- static char fmt_180[] = "";
- static char fmt_210[] = "";
+ /* Format strings */
+ static char fmt_120[] = "";
+ static char fmt_150[] = "";
+ static char fmt_180[] = "";
+ static char fmt_210[] = "";
- /* System generated locals */
- real r__1;
+ /* System generated locals */
+ real r__1;
- /* Local variables */
- real su, sp1, sp2, sq1, sq2, sh11, sh12, sh21, sh22;
- integer igo;
- real sflag, stemp;
+ /* Local variables */
+ real su, sp1, sp2, sq1, sq2, sh11, sh12, sh21, sh22;
+ integer igo;
+ real sflag, stemp;
- /* Assigned format variables */
- static char *igo_fmt;
+ /* Assigned format variables */
+ static char *igo_fmt;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS */
-/* THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)* */
-/* SY2)**T. */
-/* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
+ /* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS */
+ /* THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)* */
+ /* SY2)**T. */
+ /* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
-/* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 */
+ /* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 */
-/* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) */
-/* H=( ) ( ) ( ) ( ) */
-/* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
-/* LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 */
-/* RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE */
-/* VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) */
+ /* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) */
+ /* H=( ) ( ) ( ) ( ) */
+ /* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
+ /* LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 */
+ /* RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE */
+ /* VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) */
-/* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE */
-/* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */
-/* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
+ /* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE */
+ /* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */
+ /* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
+ /* Arguments */
+ /* ========= */
-/* Arguments */
-/* ========= */
+ /* SD1 (input/output) REAL */
+ /* SD2 (input/output) REAL */
-/* SD1 (input/output) REAL */
+ /* SX1 (input/output) REAL */
-/* SD2 (input/output) REAL */
+ /* SY1 (input) REAL */
-/* SX1 (input/output) REAL */
+ /* SPARAM (input/output) REAL array, dimension 5 */
+ /* SPARAM(1)=SFLAG */
+ /* SPARAM(2)=SH11 */
+ /* SPARAM(3)=SH21 */
+ /* SPARAM(4)=SH12 */
+ /* SPARAM(5)=SH22 */
-/* SY1 (input) REAL */
+ /* ===================================================================== */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
+ /* .. Data statements .. */
-/* SPARAM (input/output) REAL array, dimension 5 */
-/* SPARAM(1)=SFLAG */
-/* SPARAM(2)=SH11 */
-/* SPARAM(3)=SH21 */
-/* SPARAM(4)=SH12 */
-/* SPARAM(5)=SH22 */
+ /* Parameter adjustments */
+ --sparam;
-/* ===================================================================== */
-
-/* .. Local Scalars .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
-/* .. Data statements .. */
-
- /* Parameter adjustments */
- --sparam;
-
- /* Function Body */
-/* .. */
- if (! (*sd1 < zero)) {
- goto L10;
- }
-/* GO ZERO-H-D-AND-SX1.. */
- goto L60;
+ /* Function Body */
+ /* .. */
+ if (!(*sd1 < zero)) {
+ goto L10;
+ }
+ /* GO ZERO-H-D-AND-SX1.. */
+ goto L60;
L10:
-/* CASE-SD1-NONNEGATIVE */
- sp2 = *sd2 * *sy1;
- if (! (sp2 == zero)) {
- goto L20;
- }
- sflag = -two;
- goto L260;
+ /* CASE-SD1-NONNEGATIVE */
+ sp2 = *sd2 * *sy1;
+ if (!(sp2 == zero)) {
+ goto L20;
+ }
+ sflag = -two;
+ goto L260;
/* REGULAR-CASE.. */
L20:
- sp1 = *sd1 * *sx1;
- sq2 = sp2 * *sy1;
- sq1 = sp1 * *sx1;
+ sp1 = *sd1 * *sx1;
+ sq2 = sp2 * *sy1;
+ sq1 = sp1 * *sx1;
- if (! (dabs(sq1) > dabs(sq2))) {
- goto L40;
- }
- sh21 = -(*sy1) / *sx1;
- sh12 = sp2 / sp1;
+ if (!(dabs(sq1) > dabs(sq2))) {
+ goto L40;
+ }
+ sh21 = -(*sy1) / *sx1;
+ sh12 = sp2 / sp1;
- su = one - sh12 * sh21;
+ su = one - sh12 * sh21;
- if (! (su <= zero)) {
- goto L30;
- }
-/* GO ZERO-H-D-AND-SX1.. */
- goto L60;
+ if (!(su <= zero)) {
+ goto L30;
+ }
+ /* GO ZERO-H-D-AND-SX1.. */
+ goto L60;
L30:
- sflag = zero;
- *sd1 /= su;
- *sd2 /= su;
- *sx1 *= su;
-/* GO SCALE-CHECK.. */
- goto L100;
+ sflag = zero;
+ *sd1 /= su;
+ *sd2 /= su;
+ *sx1 *= su;
+ /* GO SCALE-CHECK.. */
+ goto L100;
L40:
- if (! (sq2 < zero)) {
- goto L50;
- }
-/* GO ZERO-H-D-AND-SX1.. */
- goto L60;
+ if (!(sq2 < zero)) {
+ goto L50;
+ }
+ /* GO ZERO-H-D-AND-SX1.. */
+ goto L60;
L50:
- sflag = one;
- sh11 = sp1 / sp2;
- sh22 = *sx1 / *sy1;
- su = one + sh11 * sh22;
- stemp = *sd2 / su;
- *sd2 = *sd1 / su;
- *sd1 = stemp;
- *sx1 = *sy1 * su;
-/* GO SCALE-CHECK */
- goto L100;
+ sflag = one;
+ sh11 = sp1 / sp2;
+ sh22 = *sx1 / *sy1;
+ su = one + sh11 * sh22;
+ stemp = *sd2 / su;
+ *sd2 = *sd1 / su;
+ *sd1 = stemp;
+ *sx1 = *sy1 * su;
+ /* GO SCALE-CHECK */
+ goto L100;
/* PROCEDURE..ZERO-H-D-AND-SX1.. */
L60:
- sflag = -one;
- sh11 = zero;
- sh12 = zero;
- sh21 = zero;
- sh22 = zero;
+ sflag = -one;
+ sh11 = zero;
+ sh12 = zero;
+ sh21 = zero;
+ sh22 = zero;
- *sd1 = zero;
- *sd2 = zero;
- *sx1 = zero;
-/* RETURN.. */
- goto L220;
+ *sd1 = zero;
+ *sd2 = zero;
+ *sx1 = zero;
+ /* RETURN.. */
+ goto L220;
/* PROCEDURE..FIX-H.. */
L70:
- if (! (sflag >= zero)) {
- goto L90;
- }
-
- if (! (sflag == zero)) {
- goto L80;
- }
- sh11 = one;
- sh22 = one;
- sflag = -one;
+ if (!(sflag >= zero)) {
goto L90;
+ }
+
+ if (!(sflag == zero)) {
+ goto L80;
+ }
+ sh11 = one;
+ sh22 = one;
+ sflag = -one;
+ goto L90;
L80:
- sh21 = -one;
- sh12 = one;
- sflag = -one;
+ sh21 = -one;
+ sh12 = one;
+ sflag = -one;
L90:
- switch (igo) {
- case 0: goto L120;
- case 1: goto L150;
- case 2: goto L180;
- case 3: goto L210;
- }
+ switch (igo) {
+ case 0:
+ goto L120;
+ case 1:
+ goto L150;
+ case 2:
+ goto L180;
+ case 3:
+ goto L210;
+ }
/* PROCEDURE..SCALE-CHECK */
L100:
L110:
- if (! (*sd1 <= rgamsq)) {
- goto L130;
- }
- if (*sd1 == zero) {
- goto L160;
- }
- igo = 0;
- igo_fmt = fmt_120;
-/* FIX-H.. */
- goto L70;
+ if (!(*sd1 <= rgamsq)) {
+ goto L130;
+ }
+ if (*sd1 == zero) {
+ goto L160;
+ }
+ igo = 0;
+ igo_fmt = fmt_120;
+ /* FIX-H.. */
+ goto L70;
L120:
-/* Computing 2nd power */
- r__1 = gam;
- *sd1 *= r__1 * r__1;
- *sx1 /= gam;
- sh11 /= gam;
- sh12 /= gam;
- goto L110;
+ /* Computing 2nd power */
+ r__1 = gam;
+ *sd1 *= r__1 * r__1;
+ *sx1 /= gam;
+ sh11 /= gam;
+ sh12 /= gam;
+ goto L110;
L130:
L140:
- if (! (*sd1 >= gamsq)) {
- goto L160;
- }
- igo = 1;
- igo_fmt = fmt_150;
-/* FIX-H.. */
- goto L70;
+ if (!(*sd1 >= gamsq)) {
+ goto L160;
+ }
+ igo = 1;
+ igo_fmt = fmt_150;
+ /* FIX-H.. */
+ goto L70;
L150:
-/* Computing 2nd power */
- r__1 = gam;
- *sd1 /= r__1 * r__1;
- *sx1 *= gam;
- sh11 *= gam;
- sh12 *= gam;
- goto L140;
+ /* Computing 2nd power */
+ r__1 = gam;
+ *sd1 /= r__1 * r__1;
+ *sx1 *= gam;
+ sh11 *= gam;
+ sh12 *= gam;
+ goto L140;
L160:
L170:
- if (! (dabs(*sd2) <= rgamsq)) {
- goto L190;
- }
- if (*sd2 == zero) {
- goto L220;
- }
- igo = 2;
- igo_fmt = fmt_180;
-/* FIX-H.. */
- goto L70;
+ if (!(dabs(*sd2) <= rgamsq)) {
+ goto L190;
+ }
+ if (*sd2 == zero) {
+ goto L220;
+ }
+ igo = 2;
+ igo_fmt = fmt_180;
+ /* FIX-H.. */
+ goto L70;
L180:
-/* Computing 2nd power */
- r__1 = gam;
- *sd2 *= r__1 * r__1;
- sh21 /= gam;
- sh22 /= gam;
- goto L170;
+ /* Computing 2nd power */
+ r__1 = gam;
+ *sd2 *= r__1 * r__1;
+ sh21 /= gam;
+ sh22 /= gam;
+ goto L170;
L190:
L200:
- if (! (dabs(*sd2) >= gamsq)) {
- goto L220;
- }
- igo = 3;
- igo_fmt = fmt_210;
-/* FIX-H.. */
- goto L70;
+ if (!(dabs(*sd2) >= gamsq)) {
+ goto L220;
+ }
+ igo = 3;
+ igo_fmt = fmt_210;
+ /* FIX-H.. */
+ goto L70;
L210:
-/* Computing 2nd power */
- r__1 = gam;
- *sd2 /= r__1 * r__1;
- sh21 *= gam;
- sh22 *= gam;
- goto L200;
+ /* Computing 2nd power */
+ r__1 = gam;
+ *sd2 /= r__1 * r__1;
+ sh21 *= gam;
+ sh22 *= gam;
+ goto L200;
L220:
- if (sflag < 0.f) {
- goto L250;
- } else if (sflag == 0) {
- goto L230;
- } else {
- goto L240;
- }
+ if (sflag < 0.f) {
+ goto L250;
+ } else if (sflag == 0) {
+ goto L230;
+ } else {
+ goto L240;
+ }
L230:
- sparam[3] = sh21;
- sparam[4] = sh12;
- goto L260;
+ sparam[3] = sh21;
+ sparam[4] = sh12;
+ goto L260;
L240:
- sparam[2] = sh11;
- sparam[5] = sh22;
- goto L260;
+ sparam[2] = sh11;
+ sparam[5] = sh22;
+ goto L260;
L250:
- sparam[2] = sh11;
- sparam[3] = sh21;
- sparam[4] = sh12;
- sparam[5] = sh22;
+ sparam[2] = sh11;
+ sparam[3] = sh21;
+ sparam[4] = sh12;
+ sparam[5] = sh22;
L260:
- sparam[1] = sflag;
- return 0;
+ sparam[1] = sflag;
+ return 0;
} /* srotmg_ */
-
diff --git a/blas/f2c/ssbmv.c b/blas/f2c/ssbmv.c
index 8599325..61fd213 100644
--- a/blas/f2c/ssbmv.c
+++ b/blas/f2c/ssbmv.c
@@ -1,368 +1,361 @@
/* ssbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha,
- real *a, integer *lda, real *x, integer *incx, real *beta, real *y,
- integer *incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+/* Subroutine */ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x,
+ integer *incx, real *beta, real *y, integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
- /* Local variables */
- integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
- real temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
+ real temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* SSBMV performs the matrix-vector operation */
+ /* SSBMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n symmetric band matrix, with k super-diagonals. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n symmetric band matrix, with k super-diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the band matrix A is being supplied as */
-/* follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the band matrix A is being supplied as */
+ /* follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* being supplied. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* being supplied. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry, K specifies the number of super-diagonals of the */
-/* matrix A. K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry, K specifies the number of super-diagonals of the */
+ /* matrix A. K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* ALPHA - REAL . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - REAL . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* A - REAL array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the symmetric matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer the upper */
-/* triangular part of a symmetric band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* A - REAL array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the symmetric matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer the upper */
+ /* triangular part of a symmetric band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the symmetric matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer the lower */
-/* triangular part of a symmetric band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the symmetric matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer the lower */
+ /* triangular part of a symmetric band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - REAL array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the */
-/* vector x. */
-/* Unchanged on exit. */
+ /* X - REAL array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the */
+ /* vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - REAL . */
-/* On entry, BETA specifies the scalar beta. */
-/* Unchanged on exit. */
+ /* BETA - REAL . */
+ /* On entry, BETA specifies the scalar beta. */
+ /* Unchanged on exit. */
-/* Y - REAL array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the */
-/* vector y. On exit, Y is overwritten by the updated vector y. */
+ /* Y - REAL array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the */
+ /* vector y. On exit, Y is overwritten by the updated vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
- --y;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*k < 0) {
- info = 3;
- } else if (*lda < *k + 1) {
- info = 6;
- } else if (*incx == 0) {
- info = 8;
- } else if (*incy == 0) {
- info = 11;
- }
- if (info != 0) {
- xerbla_("SSBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array A */
-/* are accessed sequentially with one pass through A. */
-
-/* First form y := beta*y. */
-
- if (*beta != 1.f) {
- if (*incy == 1) {
- if (*beta == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = 0.f;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = *beta * y[i__];
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (*beta == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = 0.f;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = *beta * y[iy];
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (*alpha == 0.f) {
- return 0;
- }
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when upper triangle of A is stored. */
-
- kplus1 = *k + 1;
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.f;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- y[i__] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[i__];
-/* L50: */
- }
- y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.f;
- ix = kx;
- iy = ky;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- y[iy] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[ix];
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha *
- temp2;
- jx += *incx;
- jy += *incy;
- if (j > *k) {
- kx += *incx;
- ky += *incy;
- }
-/* L80: */
- }
- }
- } else {
-
-/* Form y when lower triangle of A is stored. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.f;
- y[j] += temp1 * a[j * a_dim1 + 1];
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- y[i__] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[i__];
-/* L90: */
- }
- y[j] += *alpha * temp2;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.f;
- y[jy] += temp1 * a[j * a_dim1 + 1];
- l = 1 - j;
- ix = jx;
- iy = jy;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- ix += *incx;
- iy += *incy;
- y[iy] += temp1 * a[l + i__ + j * a_dim1];
- temp2 += a[l + i__ + j * a_dim1] * x[ix];
-/* L110: */
- }
- y[jy] += *alpha * temp2;
- jx += *incx;
- jy += *incy;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*k < 0) {
+ info = 3;
+ } else if (*lda < *k + 1) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("SSBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of SSBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array A */
+ /* are accessed sequentially with one pass through A. */
+
+ /* First form y := beta*y. */
+
+ if (*beta != 1.f) {
+ if (*incy == 1) {
+ if (*beta == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.f;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.f;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.f) {
+ return 0;
+ }
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when upper triangle of A is stored. */
+
+ kplus1 = *k + 1;
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.f;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ y[i__] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[i__];
+ /* L50: */
+ }
+ y[j] = y[j] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.f;
+ ix = kx;
+ iy = ky;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ y[iy] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ if (j > *k) {
+ kx += *incx;
+ ky += *incy;
+ }
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when lower triangle of A is stored. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.f;
+ y[j] += temp1 * a[j * a_dim1 + 1];
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ y[i__] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[i__];
+ /* L90: */
+ }
+ y[j] += *alpha * temp2;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.f;
+ y[jy] += temp1 * a[j * a_dim1 + 1];
+ l = 1 - j;
+ ix = jx;
+ iy = jy;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * a[l + i__ + j * a_dim1];
+ temp2 += a[l + i__ + j * a_dim1] * x[ix];
+ /* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of SSBMV . */
} /* ssbmv_ */
-
diff --git a/blas/f2c/sspmv.c b/blas/f2c/sspmv.c
index 47858ec..cc4d02d 100644
--- a/blas/f2c/sspmv.c
+++ b/blas/f2c/sspmv.c
@@ -1,316 +1,310 @@
/* sspmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int sspmv_(char *uplo, integer *n, real *alpha, real *ap,
- real *x, integer *incx, real *beta, real *y, integer *incy, ftnlen
- uplo_len)
-{
- /* System generated locals */
- integer i__1, i__2;
+/* Subroutine */ int sspmv_(char *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx, real *beta, real *y,
+ integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer i__1, i__2;
- /* Local variables */
- integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
- real temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
+ real temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* SSPMV performs the matrix-vector operation */
+ /* SSPMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n symmetric matrix, supplied in packed form. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n symmetric matrix, supplied in packed form. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the matrix A is supplied in the packed */
-/* array AP as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the matrix A is supplied in the packed */
+ /* array AP as follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* supplied in AP. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* supplied in AP. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* ALPHA - REAL . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - REAL . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* AP - REAL array of DIMENSION at least */
-/* ( ( n*( n + 1 ) )/2 ). */
-/* Before entry with UPLO = 'U' or 'u', the array AP must */
-/* contain the upper triangular part of the symmetric matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
-/* and a( 2, 2 ) respectively, and so on. */
-/* Before entry with UPLO = 'L' or 'l', the array AP must */
-/* contain the lower triangular part of the symmetric matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
-/* and a( 3, 1 ) respectively, and so on. */
-/* Unchanged on exit. */
+ /* AP - REAL array of DIMENSION at least */
+ /* ( ( n*( n + 1 ) )/2 ). */
+ /* Before entry with UPLO = 'U' or 'u', the array AP must */
+ /* contain the upper triangular part of the symmetric matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
+ /* and a( 2, 2 ) respectively, and so on. */
+ /* Before entry with UPLO = 'L' or 'l', the array AP must */
+ /* contain the lower triangular part of the symmetric matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
+ /* and a( 3, 1 ) respectively, and so on. */
+ /* Unchanged on exit. */
-/* X - REAL array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. */
-/* Unchanged on exit. */
+ /* X - REAL array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - REAL . */
-/* On entry, BETA specifies the scalar beta. When BETA is */
-/* supplied as zero then Y need not be set on input. */
-/* Unchanged on exit. */
+ /* BETA - REAL . */
+ /* On entry, BETA specifies the scalar beta. When BETA is */
+ /* supplied as zero then Y need not be set on input. */
+ /* Unchanged on exit. */
-/* Y - REAL array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the n */
-/* element vector y. On exit, Y is overwritten by the updated */
-/* vector y. */
+ /* Y - REAL array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the n */
+ /* element vector y. On exit, Y is overwritten by the updated */
+ /* vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- --y;
- --x;
- --ap;
+ /* Parameter adjustments */
+ --y;
+ --x;
+ --ap;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*incx == 0) {
- info = 6;
- } else if (*incy == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("SSPMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array AP */
-/* are accessed sequentially with one pass through AP. */
-
-/* First form y := beta*y. */
-
- if (*beta != 1.f) {
- if (*incy == 1) {
- if (*beta == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = 0.f;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[i__] = *beta * y[i__];
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (*beta == 0.f) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = 0.f;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- y[iy] = *beta * y[iy];
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (*alpha == 0.f) {
- return 0;
- }
- kk = 1;
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when AP contains the upper triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.f;
- k = kk;
- i__2 = j - 1;
- for (i__ = 1; i__ <= i__2; ++i__) {
- y[i__] += temp1 * ap[k];
- temp2 += ap[k] * x[i__];
- ++k;
-/* L50: */
- }
- y[j] = y[j] + temp1 * ap[kk + j - 1] + *alpha * temp2;
- kk += j;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.f;
- ix = kx;
- iy = ky;
- i__2 = kk + j - 2;
- for (k = kk; k <= i__2; ++k) {
- y[iy] += temp1 * ap[k];
- temp2 += ap[k] * x[ix];
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- y[jy] = y[jy] + temp1 * ap[kk + j - 1] + *alpha * temp2;
- jx += *incx;
- jy += *incy;
- kk += j;
-/* L80: */
- }
- }
- } else {
-
-/* Form y when AP contains the lower triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[j];
- temp2 = 0.f;
- y[j] += temp1 * ap[kk];
- k = kk + 1;
- i__2 = *n;
- for (i__ = j + 1; i__ <= i__2; ++i__) {
- y[i__] += temp1 * ap[k];
- temp2 += ap[k] * x[i__];
- ++k;
-/* L90: */
- }
- y[j] += *alpha * temp2;
- kk += *n - j + 1;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- temp1 = *alpha * x[jx];
- temp2 = 0.f;
- y[jy] += temp1 * ap[kk];
- ix = jx;
- iy = jy;
- i__2 = kk + *n - j;
- for (k = kk + 1; k <= i__2; ++k) {
- ix += *incx;
- iy += *incy;
- y[iy] += temp1 * ap[k];
- temp2 += ap[k] * x[ix];
-/* L110: */
- }
- y[jy] += *alpha * temp2;
- jx += *incx;
- jy += *incy;
- kk += *n - j + 1;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 6;
+ } else if (*incy == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("SSPMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of SSPMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array AP */
+ /* are accessed sequentially with one pass through AP. */
+
+ /* First form y := beta*y. */
+
+ if (*beta != 1.f) {
+ if (*incy == 1) {
+ if (*beta == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.f;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.f) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.f;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.f) {
+ return 0;
+ }
+ kk = 1;
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when AP contains the upper triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.f;
+ k = kk;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * ap[k];
+ temp2 += ap[k] * x[i__];
+ ++k;
+ /* L50: */
+ }
+ y[j] = y[j] + temp1 * ap[kk + j - 1] + *alpha * temp2;
+ kk += j;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.f;
+ ix = kx;
+ iy = ky;
+ i__2 = kk + j - 2;
+ for (k = kk; k <= i__2; ++k) {
+ y[iy] += temp1 * ap[k];
+ temp2 += ap[k] * x[ix];
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ y[jy] = y[jy] + temp1 * ap[kk + j - 1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ kk += j;
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when AP contains the lower triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.f;
+ y[j] += temp1 * ap[kk];
+ k = kk + 1;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * ap[k];
+ temp2 += ap[k] * x[i__];
+ ++k;
+ /* L90: */
+ }
+ y[j] += *alpha * temp2;
+ kk += *n - j + 1;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.f;
+ y[jy] += temp1 * ap[kk];
+ ix = jx;
+ iy = jy;
+ i__2 = kk + *n - j;
+ for (k = kk + 1; k <= i__2; ++k) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * ap[k];
+ temp2 += ap[k] * x[ix];
+ /* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+ kk += *n - j + 1;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of SSPMV . */
} /* sspmv_ */
-
diff --git a/blas/f2c/stbmv.c b/blas/f2c/stbmv.c
index b5a68b5..f31c5ba 100644
--- a/blas/f2c/stbmv.c
+++ b/blas/f2c/stbmv.c
@@ -1,428 +1,420 @@
/* stbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int stbmv_(char *uplo, char *trans, char *diag, integer *n,
- integer *k, real *a, integer *lda, real *x, integer *incx, ftnlen
- uplo_len, ftnlen trans_len, ftnlen diag_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+/* Subroutine */ int stbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, integer *lda, real *x,
+ integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
- /* Local variables */
- integer i__, j, l, ix, jx, kx, info;
- real temp;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
- logical nounit;
+ /* Local variables */
+ integer i__, j, l, ix, jx, kx, info;
+ real temp;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ logical nounit;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* STBMV performs one of the matrix-vector operations */
+ /* STBMV performs one of the matrix-vector operations */
-/* x := A*x, or x := A'*x, */
+ /* x := A*x, or x := A'*x, */
-/* where x is an n element vector and A is an n by n unit, or non-unit, */
-/* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
+ /* where x is an n element vector and A is an n by n unit, or non-unit, */
+ /* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the matrix is an upper or */
-/* lower triangular matrix as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the matrix is an upper or */
+ /* lower triangular matrix as follows: */
-/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+ /* UPLO = 'U' or 'u' A is an upper triangular matrix. */
-/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+ /* UPLO = 'L' or 'l' A is a lower triangular matrix. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* TRANS - CHARACTER*1. */
-/* On entry, TRANS specifies the operation to be performed as */
-/* follows: */
+ /* TRANS - CHARACTER*1. */
+ /* On entry, TRANS specifies the operation to be performed as */
+ /* follows: */
-/* TRANS = 'N' or 'n' x := A*x. */
+ /* TRANS = 'N' or 'n' x := A*x. */
-/* TRANS = 'T' or 't' x := A'*x. */
+ /* TRANS = 'T' or 't' x := A'*x. */
-/* TRANS = 'C' or 'c' x := A'*x. */
+ /* TRANS = 'C' or 'c' x := A'*x. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* DIAG - CHARACTER*1. */
-/* On entry, DIAG specifies whether or not A is unit */
-/* triangular as follows: */
+ /* DIAG - CHARACTER*1. */
+ /* On entry, DIAG specifies whether or not A is unit */
+ /* triangular as follows: */
-/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+ /* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
-/* DIAG = 'N' or 'n' A is not assumed to be unit */
-/* triangular. */
+ /* DIAG = 'N' or 'n' A is not assumed to be unit */
+ /* triangular. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry with UPLO = 'U' or 'u', K specifies the number of */
-/* super-diagonals of the matrix A. */
-/* On entry with UPLO = 'L' or 'l', K specifies the number of */
-/* sub-diagonals of the matrix A. */
-/* K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry with UPLO = 'U' or 'u', K specifies the number of */
+ /* super-diagonals of the matrix A. */
+ /* On entry with UPLO = 'L' or 'l', K specifies the number of */
+ /* sub-diagonals of the matrix A. */
+ /* K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* A - REAL array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer an upper */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* A - REAL array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer an upper */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer a lower */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer a lower */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that when DIAG = 'U' or 'u' the elements of the array A */
-/* corresponding to the diagonal elements of the matrix are not */
-/* referenced, but are assumed to be unity. */
-/* Unchanged on exit. */
+ /* Note that when DIAG = 'U' or 'u' the elements of the array A */
+ /* corresponding to the diagonal elements of the matrix are not */
+ /* referenced, but are assumed to be unity. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - REAL array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. On exit, X is overwritten with the */
-/* transformed vector x. */
+ /* X - REAL array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. On exit, X is overwritten with the */
+ /* transformed vector x. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans,
- "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (
- ftnlen)1)) {
- info = 2;
- } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag,
- "N", (ftnlen)1, (ftnlen)1)) {
- info = 3;
- } else if (*n < 0) {
- info = 4;
- } else if (*k < 0) {
- info = 5;
- } else if (*lda < *k + 1) {
- info = 7;
- } else if (*incx == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("STBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0) {
- return 0;
- }
-
- nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
-
-/* Set up the start point in X if the increment is not unity. This */
-/* will be ( N - 1 )*INCX too small for descending loops. */
-
- if (*incx <= 0) {
- kx = 1 - (*n - 1) * *incx;
- } else if (*incx != 1) {
- kx = 1;
- }
-
-/* Start the operations. In this version the elements of A are */
-/* accessed sequentially with one pass through A. */
-
- if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
-
-/* Form x := A*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- if (x[j] != 0.f) {
- temp = x[j];
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- x[i__] += temp * a[l + i__ + j * a_dim1];
-/* L10: */
- }
- if (nounit) {
- x[j] *= a[kplus1 + j * a_dim1];
- }
- }
-/* L20: */
- }
- } else {
- jx = kx;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- if (x[jx] != 0.f) {
- temp = x[jx];
- ix = kx;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- x[ix] += temp * a[l + i__ + j * a_dim1];
- ix += *incx;
-/* L30: */
- }
- if (nounit) {
- x[jx] *= a[kplus1 + j * a_dim1];
- }
- }
- jx += *incx;
- if (j > *k) {
- kx += *incx;
- }
-/* L40: */
- }
- }
- } else {
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- if (x[j] != 0.f) {
- temp = x[j];
- l = 1 - j;
-/* Computing MIN */
- i__1 = *n, i__3 = j + *k;
- i__4 = j + 1;
- for (i__ = min(i__1,i__3); i__ >= i__4; --i__) {
- x[i__] += temp * a[l + i__ + j * a_dim1];
-/* L50: */
- }
- if (nounit) {
- x[j] *= a[j * a_dim1 + 1];
- }
- }
-/* L60: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- if (x[jx] != 0.f) {
- temp = x[jx];
- ix = kx;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__1 = j + *k;
- i__3 = j + 1;
- for (i__ = min(i__4,i__1); i__ >= i__3; --i__) {
- x[ix] += temp * a[l + i__ + j * a_dim1];
- ix -= *incx;
-/* L70: */
- }
- if (nounit) {
- x[jx] *= a[j * a_dim1 + 1];
- }
- }
- jx -= *incx;
- if (*n - j >= *k) {
- kx -= *incx;
- }
-/* L80: */
- }
- }
- }
- } else {
-
-/* Form x := A'*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- temp = x[j];
- l = kplus1 - j;
- if (nounit) {
- temp *= a[kplus1 + j * a_dim1];
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- temp += a[l + i__ + j * a_dim1] * x[i__];
-/* L90: */
- }
- x[j] = temp;
-/* L100: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- temp = x[jx];
- kx -= *incx;
- ix = kx;
- l = kplus1 - j;
- if (nounit) {
- temp *= a[kplus1 + j * a_dim1];
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- temp += a[l + i__ + j * a_dim1] * x[ix];
- ix -= *incx;
-/* L110: */
- }
- x[jx] = temp;
- jx -= *incx;
-/* L120: */
- }
- }
- } else {
- if (*incx == 1) {
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- temp = x[j];
- l = 1 - j;
- if (nounit) {
- temp *= a[j * a_dim1 + 1];
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- temp += a[l + i__ + j * a_dim1] * x[i__];
-/* L130: */
- }
- x[j] = temp;
-/* L140: */
- }
- } else {
- jx = kx;
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- temp = x[jx];
- kx += *incx;
- ix = kx;
- l = 1 - j;
- if (nounit) {
- temp *= a[j * a_dim1 + 1];
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- temp += a[l + i__ + j * a_dim1] * x[ix];
- ix += *incx;
-/* L150: */
- }
- x[jx] = temp;
- jx += *incx;
-/* L160: */
- }
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
+ !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
+ info = 2;
+ } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < *k + 1) {
+ info = 7;
+ } else if (*incx == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("STBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of STBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
+
+ /* Set up the start point in X if the increment is not unity. This */
+ /* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+ /* Start the operations. In this version the elements of A are */
+ /* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
+ /* Form x := A*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.f) {
+ temp = x[j];
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ x[i__] += temp * a[l + i__ + j * a_dim1];
+ /* L10: */
+ }
+ if (nounit) {
+ x[j] *= a[kplus1 + j * a_dim1];
+ }
+ }
+ /* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.f) {
+ temp = x[jx];
+ ix = kx;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ x[ix] += temp * a[l + i__ + j * a_dim1];
+ ix += *incx;
+ /* L30: */
+ }
+ if (nounit) {
+ x[jx] *= a[kplus1 + j * a_dim1];
+ }
+ }
+ jx += *incx;
+ if (j > *k) {
+ kx += *incx;
+ }
+ /* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.f) {
+ temp = x[j];
+ l = 1 - j;
+ /* Computing MIN */
+ i__1 = *n, i__3 = j + *k;
+ i__4 = j + 1;
+ for (i__ = min(i__1, i__3); i__ >= i__4; --i__) {
+ x[i__] += temp * a[l + i__ + j * a_dim1];
+ /* L50: */
+ }
+ if (nounit) {
+ x[j] *= a[j * a_dim1 + 1];
+ }
+ }
+ /* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.f) {
+ temp = x[jx];
+ ix = kx;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__1 = j + *k;
+ i__3 = j + 1;
+ for (i__ = min(i__4, i__1); i__ >= i__3; --i__) {
+ x[ix] += temp * a[l + i__ + j * a_dim1];
+ ix -= *incx;
+ /* L70: */
+ }
+ if (nounit) {
+ x[jx] *= a[j * a_dim1 + 1];
+ }
+ }
+ jx -= *incx;
+ if (*n - j >= *k) {
+ kx -= *incx;
+ }
+ /* L80: */
+ }
+ }
+ }
+ } else {
+ /* Form x := A'*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ l = kplus1 - j;
+ if (nounit) {
+ temp *= a[kplus1 + j * a_dim1];
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ temp += a[l + i__ + j * a_dim1] * x[i__];
+ /* L90: */
+ }
+ x[j] = temp;
+ /* L100: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ kx -= *incx;
+ ix = kx;
+ l = kplus1 - j;
+ if (nounit) {
+ temp *= a[kplus1 + j * a_dim1];
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ temp += a[l + i__ + j * a_dim1] * x[ix];
+ ix -= *incx;
+ /* L110: */
+ }
+ x[jx] = temp;
+ jx -= *incx;
+ /* L120: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ temp = x[j];
+ l = 1 - j;
+ if (nounit) {
+ temp *= a[j * a_dim1 + 1];
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ temp += a[l + i__ + j * a_dim1] * x[i__];
+ /* L130: */
+ }
+ x[j] = temp;
+ /* L140: */
+ }
+ } else {
+ jx = kx;
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ temp = x[jx];
+ kx += *incx;
+ ix = kx;
+ l = 1 - j;
+ if (nounit) {
+ temp *= a[j * a_dim1 + 1];
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ temp += a[l + i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ /* L150: */
+ }
+ x[jx] = temp;
+ jx += *incx;
+ /* L160: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of STBMV . */
} /* stbmv_ */
-
diff --git a/blas/f2c/zhbmv.c b/blas/f2c/zhbmv.c
index 42da13d..9d6d5db 100644
--- a/blas/f2c/zhbmv.c
+++ b/blas/f2c/zhbmv.c
@@ -1,488 +1,457 @@
/* zhbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex
- *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer *
- incx, doublecomplex *beta, doublecomplex *y, integer *incy, ftnlen
- uplo_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
- doublereal d__1;
- doublecomplex z__1, z__2, z__3, z__4;
+/* Subroutine */ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
+ doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy,
+ ftnlen uplo_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
- /* Builtin functions */
- void d_cnjg(doublecomplex *, doublecomplex *);
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
- /* Local variables */
- integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
- doublecomplex temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
+ doublecomplex temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* ZHBMV performs the matrix-vector operation */
+ /* ZHBMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n hermitian band matrix, with k super-diagonals. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n hermitian band matrix, with k super-diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the band matrix A is being supplied as */
-/* follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the band matrix A is being supplied as */
+ /* follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* being supplied. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* being supplied. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* being supplied. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry, K specifies the number of super-diagonals of the */
-/* matrix A. K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry, K specifies the number of super-diagonals of the */
+ /* matrix A. K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* ALPHA - COMPLEX*16 . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - COMPLEX*16 . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the hermitian matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer the upper */
-/* triangular part of a hermitian band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the hermitian matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer the upper */
+ /* triangular part of a hermitian band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the hermitian matrix, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer the lower */
-/* triangular part of a hermitian band matrix from conventional */
-/* full matrix storage to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the hermitian matrix, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer the lower */
+ /* triangular part of a hermitian band matrix from conventional */
+ /* full matrix storage to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that the imaginary parts of the diagonal elements need */
-/* not be set and are assumed to be zero. */
-/* Unchanged on exit. */
+ /* Note that the imaginary parts of the diagonal elements need */
+ /* not be set and are assumed to be zero. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - COMPLEX*16 array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the */
-/* vector x. */
-/* Unchanged on exit. */
+ /* X - COMPLEX*16 array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the */
+ /* vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - COMPLEX*16 . */
-/* On entry, BETA specifies the scalar beta. */
-/* Unchanged on exit. */
+ /* BETA - COMPLEX*16 . */
+ /* On entry, BETA specifies the scalar beta. */
+ /* Unchanged on exit. */
-/* Y - COMPLEX*16 array of DIMENSION at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the */
-/* vector y. On exit, Y is overwritten by the updated vector y. */
+ /* Y - COMPLEX*16 array of DIMENSION at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the */
+ /* vector y. On exit, Y is overwritten by the updated vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
- --y;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*k < 0) {
- info = 3;
- } else if (*lda < *k + 1) {
- info = 6;
- } else if (*incx == 0) {
- info = 8;
- } else if (*incy == 0) {
- info = 11;
- }
- if (info != 0) {
- xerbla_("ZHBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. &&
- beta->i == 0.))) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array A */
-/* are accessed sequentially with one pass through A. */
-
-/* First form y := beta*y. */
-
- if (beta->r != 1. || beta->i != 0.) {
- if (*incy == 1) {
- if (beta->r == 0. && beta->i == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- y[i__2].r = 0., y[i__2].i = 0.;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- i__3 = i__;
- z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (beta->r == 0. && beta->i == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- y[i__2].r = 0., y[i__2].i = 0.;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- i__3 = iy;
- z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (alpha->r == 0. && alpha->i == 0.) {
- return 0;
- }
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when upper triangle of A is stored. */
-
- kplus1 = *k + 1;
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- i__2 = i__;
- i__3 = i__;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__2 = i__;
- z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i, z__2.i =
- z__3.r * x[i__2].i + z__3.i * x[i__2].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
-/* L50: */
- }
- i__4 = j;
- i__2 = j;
- i__3 = kplus1 + j * a_dim1;
- d__1 = a[i__3].r;
- z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
- z__2.r = y[i__2].r + z__3.r, z__2.i = y[i__2].i + z__3.i;
- z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
- y[i__4].r = z__1.r, y[i__4].i = z__1.i;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__4 = jx;
- z__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, z__1.i =
- alpha->r * x[i__4].i + alpha->i * x[i__4].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- ix = kx;
- iy = ky;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- i__4 = iy;
- i__2 = iy;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
- y[i__4].r = z__1.r, y[i__4].i = z__1.i;
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i =
- z__3.r * x[i__4].i + z__3.i * x[i__4].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- i__3 = jy;
- i__4 = jy;
- i__2 = kplus1 + j * a_dim1;
- d__1 = a[i__2].r;
- z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
- z__2.r = y[i__4].r + z__3.r, z__2.i = y[i__4].i + z__3.i;
- z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- jx += *incx;
- jy += *incy;
- if (j > *k) {
- kx += *incx;
- ky += *incy;
- }
-/* L80: */
- }
- }
- } else {
-
-/* Form y when lower triangle of A is stored. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__3 = j;
- z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i =
- alpha->r * x[i__3].i + alpha->i * x[i__3].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- i__3 = j;
- i__4 = j;
- i__2 = j * a_dim1 + 1;
- d__1 = a[i__2].r;
- z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- i__4 = i__;
- i__2 = i__;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
- y[i__4].r = z__1.r, y[i__4].i = z__1.i;
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__4 = i__;
- z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i =
- z__3.r * x[i__4].i + z__3.i * x[i__4].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
-/* L90: */
- }
- i__3 = j;
- i__4 = j;
- z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__3 = jx;
- z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i =
- alpha->r * x[i__3].i + alpha->i * x[i__3].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- i__3 = jy;
- i__4 = jy;
- i__2 = j * a_dim1 + 1;
- d__1 = a[i__2].r;
- z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- l = 1 - j;
- ix = jx;
- iy = jy;
-/* Computing MIN */
- i__4 = *n, i__2 = j + *k;
- i__3 = min(i__4,i__2);
- for (i__ = j + 1; i__ <= i__3; ++i__) {
- ix += *incx;
- iy += *incy;
- i__4 = iy;
- i__2 = iy;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
- z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
- .r;
- z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
- y[i__4].r = z__1.r, y[i__4].i = z__1.i;
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i =
- z__3.r * x[i__4].i + z__3.i * x[i__4].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
-/* L110: */
- }
- i__3 = jy;
- i__4 = jy;
- z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- jx += *incx;
- jy += *incy;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*k < 0) {
+ info = 3;
+ } else if (*lda < *k + 1) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZHBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of ZHBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array A */
+ /* are accessed sequentially with one pass through A. */
+
+ /* First form y := beta*y. */
+
+ if (beta->r != 1. || beta->i != 0.) {
+ if (*incy == 1) {
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, z__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, z__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (alpha->r == 0. && alpha->i == 0.) {
+ return 0;
+ }
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when upper triangle of A is stored. */
+
+ kplus1 = *k + 1;
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__2 = i__;
+ z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i, z__2.i = z__3.r * x[i__2].i + z__3.i * x[i__2].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ /* L50: */
+ }
+ i__4 = j;
+ i__2 = j;
+ i__3 = kplus1 + j * a_dim1;
+ d__1 = a[i__3].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__2].r + z__3.r, z__2.i = y[i__2].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__4].r = z__1.r, y[i__4].i = z__1.i;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__4 = jx;
+ z__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, z__1.i = alpha->r * x[i__4].i + alpha->i * x[i__4].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ ix = kx;
+ iy = ky;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ i__4 = iy;
+ i__2 = iy;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
+ y[i__4].r = z__1.r, y[i__4].i = z__1.i;
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i = z__3.r * x[i__4].i + z__3.i * x[i__4].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ i__3 = jy;
+ i__4 = jy;
+ i__2 = kplus1 + j * a_dim1;
+ d__1 = a[i__2].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__4].r + z__3.r, z__2.i = y[i__4].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+ if (j > *k) {
+ kx += *incx;
+ ky += *incy;
+ }
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when lower triangle of A is stored. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__3 = j;
+ z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i = alpha->r * x[i__3].i + alpha->i * x[i__3].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__3 = j;
+ i__4 = j;
+ i__2 = j * a_dim1 + 1;
+ d__1 = a[i__2].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ i__4 = i__;
+ i__2 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
+ y[i__4].r = z__1.r, y[i__4].i = z__1.i;
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__4 = i__;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i = z__3.r * x[i__4].i + z__3.i * x[i__4].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ /* L90: */
+ }
+ i__3 = j;
+ i__4 = j;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__3 = jx;
+ z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i = alpha->r * x[i__3].i + alpha->i * x[i__3].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__3 = jy;
+ i__4 = jy;
+ i__2 = j * a_dim1 + 1;
+ d__1 = a[i__2].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ l = 1 - j;
+ ix = jx;
+ iy = jy;
+ /* Computing MIN */
+ i__4 = *n, i__2 = j + *k;
+ i__3 = min(i__4, i__2);
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ i__4 = iy;
+ i__2 = iy;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5].r;
+ z__1.r = y[i__2].r + z__2.r, z__1.i = y[i__2].i + z__2.i;
+ y[i__4].r = z__1.r, y[i__4].i = z__1.i;
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i = z__3.r * x[i__4].i + z__3.i * x[i__4].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ /* L110: */
+ }
+ i__3 = jy;
+ i__4 = jy;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of ZHBMV . */
} /* zhbmv_ */
-
diff --git a/blas/f2c/zhpmv.c b/blas/f2c/zhpmv.c
index fbe2f42..3f93b97 100644
--- a/blas/f2c/zhpmv.c
+++ b/blas/f2c/zhpmv.c
@@ -1,438 +1,407 @@
/* zhpmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha,
- doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *
- beta, doublecomplex *y, integer *incy, ftnlen uplo_len)
-{
- /* System generated locals */
- integer i__1, i__2, i__3, i__4, i__5;
- doublereal d__1;
- doublecomplex z__1, z__2, z__3, z__4;
+/* Subroutine */ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doublecomplex *x,
+ integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy, ftnlen uplo_len) {
+ /* System generated locals */
+ integer i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
- /* Builtin functions */
- void d_cnjg(doublecomplex *, doublecomplex *);
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
- /* Local variables */
- integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
- doublecomplex temp1, temp2;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ /* Local variables */
+ integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
+ doublecomplex temp1, temp2;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* ZHPMV performs the matrix-vector operation */
+ /* ZHPMV performs the matrix-vector operation */
-/* y := alpha*A*x + beta*y, */
+ /* y := alpha*A*x + beta*y, */
-/* where alpha and beta are scalars, x and y are n element vectors and */
-/* A is an n by n hermitian matrix, supplied in packed form. */
+ /* where alpha and beta are scalars, x and y are n element vectors and */
+ /* A is an n by n hermitian matrix, supplied in packed form. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the upper or lower */
-/* triangular part of the matrix A is supplied in the packed */
-/* array AP as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the upper or lower */
+ /* triangular part of the matrix A is supplied in the packed */
+ /* array AP as follows: */
-/* UPLO = 'U' or 'u' The upper triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'U' or 'u' The upper triangular part of A is */
+ /* supplied in AP. */
-/* UPLO = 'L' or 'l' The lower triangular part of A is */
-/* supplied in AP. */
+ /* UPLO = 'L' or 'l' The lower triangular part of A is */
+ /* supplied in AP. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* ALPHA - COMPLEX*16 . */
-/* On entry, ALPHA specifies the scalar alpha. */
-/* Unchanged on exit. */
+ /* ALPHA - COMPLEX*16 . */
+ /* On entry, ALPHA specifies the scalar alpha. */
+ /* Unchanged on exit. */
-/* AP - COMPLEX*16 array of DIMENSION at least */
-/* ( ( n*( n + 1 ) )/2 ). */
-/* Before entry with UPLO = 'U' or 'u', the array AP must */
-/* contain the upper triangular part of the hermitian matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
-/* and a( 2, 2 ) respectively, and so on. */
-/* Before entry with UPLO = 'L' or 'l', the array AP must */
-/* contain the lower triangular part of the hermitian matrix */
-/* packed sequentially, column by column, so that AP( 1 ) */
-/* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
-/* and a( 3, 1 ) respectively, and so on. */
-/* Note that the imaginary parts of the diagonal elements need */
-/* not be set and are assumed to be zero. */
-/* Unchanged on exit. */
+ /* AP - COMPLEX*16 array of DIMENSION at least */
+ /* ( ( n*( n + 1 ) )/2 ). */
+ /* Before entry with UPLO = 'U' or 'u', the array AP must */
+ /* contain the upper triangular part of the hermitian matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) */
+ /* and a( 2, 2 ) respectively, and so on. */
+ /* Before entry with UPLO = 'L' or 'l', the array AP must */
+ /* contain the lower triangular part of the hermitian matrix */
+ /* packed sequentially, column by column, so that AP( 1 ) */
+ /* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) */
+ /* and a( 3, 1 ) respectively, and so on. */
+ /* Note that the imaginary parts of the diagonal elements need */
+ /* not be set and are assumed to be zero. */
+ /* Unchanged on exit. */
-/* X - COMPLEX*16 array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. */
-/* Unchanged on exit. */
+ /* X - COMPLEX*16 array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. */
+ /* Unchanged on exit. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* BETA - COMPLEX*16 . */
-/* On entry, BETA specifies the scalar beta. When BETA is */
-/* supplied as zero then Y need not be set on input. */
-/* Unchanged on exit. */
+ /* BETA - COMPLEX*16 . */
+ /* On entry, BETA specifies the scalar beta. When BETA is */
+ /* supplied as zero then Y need not be set on input. */
+ /* Unchanged on exit. */
-/* Y - COMPLEX*16 array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCY ) ). */
-/* Before entry, the incremented array Y must contain the n */
-/* element vector y. On exit, Y is overwritten by the updated */
-/* vector y. */
+ /* Y - COMPLEX*16 array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCY ) ). */
+ /* Before entry, the incremented array Y must contain the n */
+ /* element vector y. On exit, Y is overwritten by the updated */
+ /* vector y. */
-/* INCY - INTEGER. */
-/* On entry, INCY specifies the increment for the elements of */
-/* Y. INCY must not be zero. */
-/* Unchanged on exit. */
+ /* INCY - INTEGER. */
+ /* On entry, INCY specifies the increment for the elements of */
+ /* Y. INCY must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- --y;
- --x;
- --ap;
+ /* Parameter adjustments */
+ --y;
+ --x;
+ --ap;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (*n < 0) {
- info = 2;
- } else if (*incx == 0) {
- info = 6;
- } else if (*incy == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("ZHPMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. &&
- beta->i == 0.))) {
- return 0;
- }
-
-/* Set up the start points in X and Y. */
-
- if (*incx > 0) {
- kx = 1;
- } else {
- kx = 1 - (*n - 1) * *incx;
- }
- if (*incy > 0) {
- ky = 1;
- } else {
- ky = 1 - (*n - 1) * *incy;
- }
-
-/* Start the operations. In this version the elements of the array AP */
-/* are accessed sequentially with one pass through AP. */
-
-/* First form y := beta*y. */
-
- if (beta->r != 1. || beta->i != 0.) {
- if (*incy == 1) {
- if (beta->r == 0. && beta->i == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- y[i__2].r = 0., y[i__2].i = 0.;
-/* L10: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = i__;
- i__3 = i__;
- z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L20: */
- }
- }
- } else {
- iy = ky;
- if (beta->r == 0. && beta->i == 0.) {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- y[i__2].r = 0., y[i__2].i = 0.;
- iy += *incy;
-/* L30: */
- }
- } else {
- i__1 = *n;
- for (i__ = 1; i__ <= i__1; ++i__) {
- i__2 = iy;
- i__3 = iy;
- z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
- z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
- .r;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- iy += *incy;
-/* L40: */
- }
- }
- }
- }
- if (alpha->r == 0. && alpha->i == 0.) {
- return 0;
- }
- kk = 1;
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
-
-/* Form y when AP contains the upper triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- k = kk;
- i__2 = j - 1;
- for (i__ = 1; i__ <= i__2; ++i__) {
- i__3 = i__;
- i__4 = i__;
- i__5 = k;
- z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- d_cnjg(&z__3, &ap[k]);
- i__3 = i__;
- z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
- z__3.r * x[i__3].i + z__3.i * x[i__3].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
- ++k;
-/* L50: */
- }
- i__2 = j;
- i__3 = j;
- i__4 = kk + j - 1;
- d__1 = ap[i__4].r;
- z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
- z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
- z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- kk += j;
-/* L60: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = jx;
- z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- ix = kx;
- iy = ky;
- i__2 = kk + j - 2;
- for (k = kk; k <= i__2; ++k) {
- i__3 = iy;
- i__4 = iy;
- i__5 = k;
- z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- d_cnjg(&z__3, &ap[k]);
- i__3 = ix;
- z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
- z__3.r * x[i__3].i + z__3.i * x[i__3].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
- ix += *incx;
- iy += *incy;
-/* L70: */
- }
- i__2 = jy;
- i__3 = jy;
- i__4 = kk + j - 1;
- d__1 = ap[i__4].r;
- z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
- z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
- z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- jx += *incx;
- jy += *incy;
- kk += j;
-/* L80: */
- }
- }
- } else {
-
-/* Form y when AP contains the lower triangle. */
-
- if (*incx == 1 && *incy == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- i__2 = j;
- i__3 = j;
- i__4 = kk;
- d__1 = ap[i__4].r;
- z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
- z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- k = kk + 1;
- i__2 = *n;
- for (i__ = j + 1; i__ <= i__2; ++i__) {
- i__3 = i__;
- i__4 = i__;
- i__5 = k;
- z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- d_cnjg(&z__3, &ap[k]);
- i__3 = i__;
- z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
- z__3.r * x[i__3].i + z__3.i * x[i__3].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
- ++k;
-/* L90: */
- }
- i__2 = j;
- i__3 = j;
- z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- kk += *n - j + 1;
-/* L100: */
- }
- } else {
- jx = kx;
- jy = ky;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = jx;
- z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
- alpha->r * x[i__2].i + alpha->i * x[i__2].r;
- temp1.r = z__1.r, temp1.i = z__1.i;
- temp2.r = 0., temp2.i = 0.;
- i__2 = jy;
- i__3 = jy;
- i__4 = kk;
- d__1 = ap[i__4].r;
- z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
- z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- ix = jx;
- iy = jy;
- i__2 = kk + *n - j;
- for (k = kk + 1; k <= i__2; ++k) {
- ix += *incx;
- iy += *incy;
- i__3 = iy;
- i__4 = iy;
- i__5 = k;
- z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i,
- z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5]
- .r;
- z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
- y[i__3].r = z__1.r, y[i__3].i = z__1.i;
- d_cnjg(&z__3, &ap[k]);
- i__3 = ix;
- z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
- z__3.r * x[i__3].i + z__3.i * x[i__3].r;
- z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
- temp2.r = z__1.r, temp2.i = z__1.i;
-/* L110: */
- }
- i__2 = jy;
- i__3 = jy;
- z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
- alpha->r * temp2.i + alpha->i * temp2.r;
- z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
- y[i__2].r = z__1.r, y[i__2].i = z__1.i;
- jx += *incx;
- jy += *incy;
- kk += *n - j + 1;
-/* L120: */
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 6;
+ } else if (*incy == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZHPMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of ZHPMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
+ return 0;
+ }
+
+ /* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+ /* Start the operations. In this version the elements of the array AP */
+ /* are accessed sequentially with one pass through AP. */
+
+ /* First form y := beta*y. */
+
+ if (beta->r != 1. || beta->i != 0.) {
+ if (*incy == 1) {
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ /* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, z__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ /* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ iy += *incy;
+ /* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, z__1.i = beta->r * y[i__3].i + beta->i * y[i__3].r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ iy += *incy;
+ /* L40: */
+ }
+ }
+ }
+ }
+ if (alpha->r == 0. && alpha->i == 0.) {
+ return 0;
+ }
+ kk = 1;
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ /* Form y when AP contains the upper triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ k = kk;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = k;
+ z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &ap[k]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ++k;
+ /* L50: */
+ }
+ i__2 = j;
+ i__3 = j;
+ i__4 = kk + j - 1;
+ d__1 = ap[i__4].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ kk += j;
+ /* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ ix = kx;
+ iy = ky;
+ i__2 = kk + j - 2;
+ for (k = kk; k <= i__2; ++k) {
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = k;
+ z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &ap[k]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+ /* L70: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = kk + j - 1;
+ d__1 = ap[i__4].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+ kk += j;
+ /* L80: */
+ }
+ }
+ } else {
+ /* Form y when AP contains the lower triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__2 = j;
+ i__3 = j;
+ i__4 = kk;
+ d__1 = ap[i__4].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ k = kk + 1;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = k;
+ z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &ap[k]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ++k;
+ /* L90: */
+ }
+ i__2 = j;
+ i__3 = j;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ kk += *n - j + 1;
+ /* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = kk;
+ d__1 = ap[i__4].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ ix = jx;
+ iy = jy;
+ i__2 = kk + *n - j;
+ for (k = kk + 1; k <= i__2; ++k) {
+ ix += *incx;
+ iy += *incy;
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = k;
+ z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, z__2.i = temp1.r * ap[i__5].i + temp1.i * ap[i__5].r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &ap[k]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ /* L110: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+ kk += *n - j + 1;
+ /* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of ZHPMV . */
} /* zhpmv_ */
-
diff --git a/blas/f2c/ztbmv.c b/blas/f2c/ztbmv.c
index 3bf0beb..9a41370 100644
--- a/blas/f2c/ztbmv.c
+++ b/blas/f2c/ztbmv.c
@@ -1,647 +1,587 @@
/* ztbmv.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
+ http://www.netlib.org/f2c/libf2c.zip
*/
#include "datatypes.h"
-/* Subroutine */ int ztbmv_(char *uplo, char *trans, char *diag, integer *n,
- integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer
- *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
-{
- /* System generated locals */
- integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
- doublecomplex z__1, z__2, z__3;
+/* Subroutine */ int ztbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublecomplex *a, integer *lda,
+ doublecomplex *x, integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2, z__3;
- /* Builtin functions */
- void d_cnjg(doublecomplex *, doublecomplex *);
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
- /* Local variables */
- integer i__, j, l, ix, jx, kx, info;
- doublecomplex temp;
- extern logical lsame_(char *, char *, ftnlen, ftnlen);
- integer kplus1;
- extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
- logical noconj, nounit;
+ /* Local variables */
+ integer i__, j, l, ix, jx, kx, info;
+ doublecomplex temp;
+ extern logical lsame_(char *, char *, ftnlen, ftnlen);
+ integer kplus1;
+ extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
+ logical noconj, nounit;
-/* .. Scalar Arguments .. */
-/* .. */
-/* .. Array Arguments .. */
-/* .. */
+ /* .. Scalar Arguments .. */
+ /* .. */
+ /* .. Array Arguments .. */
+ /* .. */
-/* Purpose */
-/* ======= */
+ /* Purpose */
+ /* ======= */
-/* ZTBMV performs one of the matrix-vector operations */
+ /* ZTBMV performs one of the matrix-vector operations */
-/* x := A*x, or x := A'*x, or x := conjg( A' )*x, */
+ /* x := A*x, or x := A'*x, or x := conjg( A' )*x, */
-/* where x is an n element vector and A is an n by n unit, or non-unit, */
-/* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
+ /* where x is an n element vector and A is an n by n unit, or non-unit, */
+ /* upper or lower triangular band matrix, with ( k + 1 ) diagonals. */
-/* Arguments */
-/* ========== */
+ /* Arguments */
+ /* ========== */
-/* UPLO - CHARACTER*1. */
-/* On entry, UPLO specifies whether the matrix is an upper or */
-/* lower triangular matrix as follows: */
+ /* UPLO - CHARACTER*1. */
+ /* On entry, UPLO specifies whether the matrix is an upper or */
+ /* lower triangular matrix as follows: */
-/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+ /* UPLO = 'U' or 'u' A is an upper triangular matrix. */
-/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+ /* UPLO = 'L' or 'l' A is a lower triangular matrix. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* TRANS - CHARACTER*1. */
-/* On entry, TRANS specifies the operation to be performed as */
-/* follows: */
+ /* TRANS - CHARACTER*1. */
+ /* On entry, TRANS specifies the operation to be performed as */
+ /* follows: */
-/* TRANS = 'N' or 'n' x := A*x. */
+ /* TRANS = 'N' or 'n' x := A*x. */
-/* TRANS = 'T' or 't' x := A'*x. */
+ /* TRANS = 'T' or 't' x := A'*x. */
-/* TRANS = 'C' or 'c' x := conjg( A' )*x. */
+ /* TRANS = 'C' or 'c' x := conjg( A' )*x. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* DIAG - CHARACTER*1. */
-/* On entry, DIAG specifies whether or not A is unit */
-/* triangular as follows: */
+ /* DIAG - CHARACTER*1. */
+ /* On entry, DIAG specifies whether or not A is unit */
+ /* triangular as follows: */
-/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+ /* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
-/* DIAG = 'N' or 'n' A is not assumed to be unit */
-/* triangular. */
+ /* DIAG = 'N' or 'n' A is not assumed to be unit */
+ /* triangular. */
-/* Unchanged on exit. */
+ /* Unchanged on exit. */
-/* N - INTEGER. */
-/* On entry, N specifies the order of the matrix A. */
-/* N must be at least zero. */
-/* Unchanged on exit. */
+ /* N - INTEGER. */
+ /* On entry, N specifies the order of the matrix A. */
+ /* N must be at least zero. */
+ /* Unchanged on exit. */
-/* K - INTEGER. */
-/* On entry with UPLO = 'U' or 'u', K specifies the number of */
-/* super-diagonals of the matrix A. */
-/* On entry with UPLO = 'L' or 'l', K specifies the number of */
-/* sub-diagonals of the matrix A. */
-/* K must satisfy 0 .le. K. */
-/* Unchanged on exit. */
+ /* K - INTEGER. */
+ /* On entry with UPLO = 'U' or 'u', K specifies the number of */
+ /* super-diagonals of the matrix A. */
+ /* On entry with UPLO = 'L' or 'l', K specifies the number of */
+ /* sub-diagonals of the matrix A. */
+ /* K must satisfy 0 .le. K. */
+ /* Unchanged on exit. */
-/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
-/* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
-/* by n part of the array A must contain the upper triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row */
-/* ( k + 1 ) of the array, the first super-diagonal starting at */
-/* position 2 in row k, and so on. The top left k by k triangle */
-/* of the array A is not referenced. */
-/* The following program segment will transfer an upper */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+ /* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the upper triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row */
+ /* ( k + 1 ) of the array, the first super-diagonal starting at */
+ /* position 2 in row k, and so on. The top left k by k triangle */
+ /* of the array A is not referenced. */
+ /* The following program segment will transfer an upper */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = K + 1 - J */
-/* DO 10, I = MAX( 1, J - K ), J */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = K + 1 - J */
+ /* DO 10, I = MAX( 1, J - K ), J */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
-/* by n part of the array A must contain the lower triangular */
-/* band part of the matrix of coefficients, supplied column by */
-/* column, with the leading diagonal of the matrix in row 1 of */
-/* the array, the first sub-diagonal starting at position 1 in */
-/* row 2, and so on. The bottom right k by k triangle of the */
-/* array A is not referenced. */
-/* The following program segment will transfer a lower */
-/* triangular band matrix from conventional full matrix storage */
-/* to band storage: */
+ /* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) */
+ /* by n part of the array A must contain the lower triangular */
+ /* band part of the matrix of coefficients, supplied column by */
+ /* column, with the leading diagonal of the matrix in row 1 of */
+ /* the array, the first sub-diagonal starting at position 1 in */
+ /* row 2, and so on. The bottom right k by k triangle of the */
+ /* array A is not referenced. */
+ /* The following program segment will transfer a lower */
+ /* triangular band matrix from conventional full matrix storage */
+ /* to band storage: */
-/* DO 20, J = 1, N */
-/* M = 1 - J */
-/* DO 10, I = J, MIN( N, J + K ) */
-/* A( M + I, J ) = matrix( I, J ) */
-/* 10 CONTINUE */
-/* 20 CONTINUE */
+ /* DO 20, J = 1, N */
+ /* M = 1 - J */
+ /* DO 10, I = J, MIN( N, J + K ) */
+ /* A( M + I, J ) = matrix( I, J ) */
+ /* 10 CONTINUE */
+ /* 20 CONTINUE */
-/* Note that when DIAG = 'U' or 'u' the elements of the array A */
-/* corresponding to the diagonal elements of the matrix are not */
-/* referenced, but are assumed to be unity. */
-/* Unchanged on exit. */
+ /* Note that when DIAG = 'U' or 'u' the elements of the array A */
+ /* corresponding to the diagonal elements of the matrix are not */
+ /* referenced, but are assumed to be unity. */
+ /* Unchanged on exit. */
-/* LDA - INTEGER. */
-/* On entry, LDA specifies the first dimension of A as declared */
-/* in the calling (sub) program. LDA must be at least */
-/* ( k + 1 ). */
-/* Unchanged on exit. */
+ /* LDA - INTEGER. */
+ /* On entry, LDA specifies the first dimension of A as declared */
+ /* in the calling (sub) program. LDA must be at least */
+ /* ( k + 1 ). */
+ /* Unchanged on exit. */
-/* X - COMPLEX*16 array of dimension at least */
-/* ( 1 + ( n - 1 )*abs( INCX ) ). */
-/* Before entry, the incremented array X must contain the n */
-/* element vector x. On exit, X is overwritten with the */
-/* transformed vector x. */
+ /* X - COMPLEX*16 array of dimension at least */
+ /* ( 1 + ( n - 1 )*abs( INCX ) ). */
+ /* Before entry, the incremented array X must contain the n */
+ /* element vector x. On exit, X is overwritten with the */
+ /* transformed vector x. */
-/* INCX - INTEGER. */
-/* On entry, INCX specifies the increment for the elements of */
-/* X. INCX must not be zero. */
-/* Unchanged on exit. */
+ /* INCX - INTEGER. */
+ /* On entry, INCX specifies the increment for the elements of */
+ /* X. INCX must not be zero. */
+ /* Unchanged on exit. */
-/* Further Details */
-/* =============== */
+ /* Further Details */
+ /* =============== */
-/* Level 2 Blas routine. */
+ /* Level 2 Blas routine. */
-/* -- Written on 22-October-1986. */
-/* Jack Dongarra, Argonne National Lab. */
-/* Jeremy Du Croz, Nag Central Office. */
-/* Sven Hammarling, Nag Central Office. */
-/* Richard Hanson, Sandia National Labs. */
+ /* -- Written on 22-October-1986. */
+ /* Jack Dongarra, Argonne National Lab. */
+ /* Jeremy Du Croz, Nag Central Office. */
+ /* Sven Hammarling, Nag Central Office. */
+ /* Richard Hanson, Sandia National Labs. */
-/* ===================================================================== */
+ /* ===================================================================== */
-/* .. Parameters .. */
-/* .. */
-/* .. Local Scalars .. */
-/* .. */
-/* .. External Functions .. */
-/* .. */
-/* .. External Subroutines .. */
-/* .. */
-/* .. Intrinsic Functions .. */
-/* .. */
+ /* .. Parameters .. */
+ /* .. */
+ /* .. Local Scalars .. */
+ /* .. */
+ /* .. External Functions .. */
+ /* .. */
+ /* .. External Subroutines .. */
+ /* .. */
+ /* .. Intrinsic Functions .. */
+ /* .. */
-/* Test the input parameters. */
+ /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --x;
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
- /* Function Body */
- info = 0;
- if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", (
- ftnlen)1, (ftnlen)1)) {
- info = 1;
- } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans,
- "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (
- ftnlen)1)) {
- info = 2;
- } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag,
- "N", (ftnlen)1, (ftnlen)1)) {
- info = 3;
- } else if (*n < 0) {
- info = 4;
- } else if (*k < 0) {
- info = 5;
- } else if (*lda < *k + 1) {
- info = 7;
- } else if (*incx == 0) {
- info = 9;
- }
- if (info != 0) {
- xerbla_("ZTBMV ", &info, (ftnlen)6);
- return 0;
- }
-
-/* Quick return if possible. */
-
- if (*n == 0) {
- return 0;
- }
-
- noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
- nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
-
-/* Set up the start point in X if the increment is not unity. This */
-/* will be ( N - 1 )*INCX too small for descending loops. */
-
- if (*incx <= 0) {
- kx = 1 - (*n - 1) * *incx;
- } else if (*incx != 1) {
- kx = 1;
- }
-
-/* Start the operations. In this version the elements of A are */
-/* accessed sequentially with one pass through A. */
-
- if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
-
-/* Form x := A*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__2 = j;
- if (x[i__2].r != 0. || x[i__2].i != 0.) {
- i__2 = j;
- temp.r = x[i__2].r, temp.i = x[i__2].i;
- l = kplus1 - j;
-/* Computing MAX */
- i__2 = 1, i__3 = j - *k;
- i__4 = j - 1;
- for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
- i__2 = i__;
- i__3 = i__;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
- z__2.i = temp.r * a[i__5].i + temp.i * a[
- i__5].r;
- z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
- z__2.i;
- x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-/* L10: */
- }
- if (nounit) {
- i__4 = j;
- i__2 = j;
- i__3 = kplus1 + j * a_dim1;
- z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
- i__3].i, z__1.i = x[i__2].r * a[i__3].i +
- x[i__2].i * a[i__3].r;
- x[i__4].r = z__1.r, x[i__4].i = z__1.i;
- }
- }
-/* L20: */
- }
- } else {
- jx = kx;
- i__1 = *n;
- for (j = 1; j <= i__1; ++j) {
- i__4 = jx;
- if (x[i__4].r != 0. || x[i__4].i != 0.) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- ix = kx;
- l = kplus1 - j;
-/* Computing MAX */
- i__4 = 1, i__2 = j - *k;
- i__3 = j - 1;
- for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
- i__4 = ix;
- i__2 = ix;
- i__5 = l + i__ + j * a_dim1;
- z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
- z__2.i = temp.r * a[i__5].i + temp.i * a[
- i__5].r;
- z__1.r = x[i__2].r + z__2.r, z__1.i = x[i__2].i +
- z__2.i;
- x[i__4].r = z__1.r, x[i__4].i = z__1.i;
- ix += *incx;
-/* L30: */
- }
- if (nounit) {
- i__3 = jx;
- i__4 = jx;
- i__2 = kplus1 + j * a_dim1;
- z__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[
- i__2].i, z__1.i = x[i__4].r * a[i__2].i +
- x[i__4].i * a[i__2].r;
- x[i__3].r = z__1.r, x[i__3].i = z__1.i;
- }
- }
- jx += *incx;
- if (j > *k) {
- kx += *incx;
- }
-/* L40: */
- }
- }
- } else {
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- i__1 = j;
- if (x[i__1].r != 0. || x[i__1].i != 0.) {
- i__1 = j;
- temp.r = x[i__1].r, temp.i = x[i__1].i;
- l = 1 - j;
-/* Computing MIN */
- i__1 = *n, i__3 = j + *k;
- i__4 = j + 1;
- for (i__ = min(i__1,i__3); i__ >= i__4; --i__) {
- i__1 = i__;
- i__3 = i__;
- i__2 = l + i__ + j * a_dim1;
- z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
- z__2.i = temp.r * a[i__2].i + temp.i * a[
- i__2].r;
- z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
- z__2.i;
- x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-/* L50: */
- }
- if (nounit) {
- i__4 = j;
- i__1 = j;
- i__3 = j * a_dim1 + 1;
- z__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[
- i__3].i, z__1.i = x[i__1].r * a[i__3].i +
- x[i__1].i * a[i__3].r;
- x[i__4].r = z__1.r, x[i__4].i = z__1.i;
- }
- }
-/* L60: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- i__4 = jx;
- if (x[i__4].r != 0. || x[i__4].i != 0.) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- ix = kx;
- l = 1 - j;
-/* Computing MIN */
- i__4 = *n, i__1 = j + *k;
- i__3 = j + 1;
- for (i__ = min(i__4,i__1); i__ >= i__3; --i__) {
- i__4 = ix;
- i__1 = ix;
- i__2 = l + i__ + j * a_dim1;
- z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
- z__2.i = temp.r * a[i__2].i + temp.i * a[
- i__2].r;
- z__1.r = x[i__1].r + z__2.r, z__1.i = x[i__1].i +
- z__2.i;
- x[i__4].r = z__1.r, x[i__4].i = z__1.i;
- ix -= *incx;
-/* L70: */
- }
- if (nounit) {
- i__3 = jx;
- i__4 = jx;
- i__1 = j * a_dim1 + 1;
- z__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[
- i__1].i, z__1.i = x[i__4].r * a[i__1].i +
- x[i__4].i * a[i__1].r;
- x[i__3].r = z__1.r, x[i__3].i = z__1.i;
- }
- }
- jx -= *incx;
- if (*n - j >= *k) {
- kx -= *incx;
- }
-/* L80: */
- }
- }
- }
- } else {
-
-/* Form x := A'*x or x := conjg( A' )*x. */
-
- if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
- kplus1 = *k + 1;
- if (*incx == 1) {
- for (j = *n; j >= 1; --j) {
- i__3 = j;
- temp.r = x[i__3].r, temp.i = x[i__3].i;
- l = kplus1 - j;
- if (noconj) {
- if (nounit) {
- i__3 = kplus1 + j * a_dim1;
- z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
- z__1.i = temp.r * a[i__3].i + temp.i * a[
- i__3].r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- i__4 = l + i__ + j * a_dim1;
- i__1 = i__;
- z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
- i__1].i, z__2.i = a[i__4].r * x[i__1].i +
- a[i__4].i * x[i__1].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
-/* L90: */
- }
- } else {
- if (nounit) {
- d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
- z__1.r = temp.r * z__2.r - temp.i * z__2.i,
- z__1.i = temp.r * z__2.i + temp.i *
- z__2.r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__4 = i__;
- z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i,
- z__2.i = z__3.r * x[i__4].i + z__3.i * x[
- i__4].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
- }
- }
- i__3 = j;
- x[i__3].r = temp.r, x[i__3].i = temp.i;
-/* L110: */
- }
- } else {
- kx += (*n - 1) * *incx;
- jx = kx;
- for (j = *n; j >= 1; --j) {
- i__3 = jx;
- temp.r = x[i__3].r, temp.i = x[i__3].i;
- kx -= *incx;
- ix = kx;
- l = kplus1 - j;
- if (noconj) {
- if (nounit) {
- i__3 = kplus1 + j * a_dim1;
- z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
- z__1.i = temp.r * a[i__3].i + temp.i * a[
- i__3].r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- i__4 = l + i__ + j * a_dim1;
- i__1 = ix;
- z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[
- i__1].i, z__2.i = a[i__4].r * x[i__1].i +
- a[i__4].i * x[i__1].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
- ix -= *incx;
-/* L120: */
- }
- } else {
- if (nounit) {
- d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
- z__1.r = temp.r * z__2.r - temp.i * z__2.i,
- z__1.i = temp.r * z__2.i + temp.i *
- z__2.r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MAX */
- i__4 = 1, i__1 = j - *k;
- i__3 = max(i__4,i__1);
- for (i__ = j - 1; i__ >= i__3; --i__) {
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__4 = ix;
- z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i,
- z__2.i = z__3.r * x[i__4].i + z__3.i * x[
- i__4].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
- ix -= *incx;
-/* L130: */
- }
- }
- i__3 = jx;
- x[i__3].r = temp.r, x[i__3].i = temp.i;
- jx -= *incx;
-/* L140: */
- }
- }
- } else {
- if (*incx == 1) {
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- i__4 = j;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- l = 1 - j;
- if (noconj) {
- if (nounit) {
- i__4 = j * a_dim1 + 1;
- z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
- z__1.i = temp.r * a[i__4].i + temp.i * a[
- i__4].r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- i__1 = l + i__ + j * a_dim1;
- i__2 = i__;
- z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
- i__2].i, z__2.i = a[i__1].r * x[i__2].i +
- a[i__1].i * x[i__2].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
-/* L150: */
- }
- } else {
- if (nounit) {
- d_cnjg(&z__2, &a[j * a_dim1 + 1]);
- z__1.r = temp.r * z__2.r - temp.i * z__2.i,
- z__1.i = temp.r * z__2.i + temp.i *
- z__2.r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__1 = i__;
- z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
- z__2.i = z__3.r * x[i__1].i + z__3.i * x[
- i__1].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
-/* L160: */
- }
- }
- i__4 = j;
- x[i__4].r = temp.r, x[i__4].i = temp.i;
-/* L170: */
- }
- } else {
- jx = kx;
- i__3 = *n;
- for (j = 1; j <= i__3; ++j) {
- i__4 = jx;
- temp.r = x[i__4].r, temp.i = x[i__4].i;
- kx += *incx;
- ix = kx;
- l = 1 - j;
- if (noconj) {
- if (nounit) {
- i__4 = j * a_dim1 + 1;
- z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
- z__1.i = temp.r * a[i__4].i + temp.i * a[
- i__4].r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- i__1 = l + i__ + j * a_dim1;
- i__2 = ix;
- z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
- i__2].i, z__2.i = a[i__1].r * x[i__2].i +
- a[i__1].i * x[i__2].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
- ix += *incx;
-/* L180: */
- }
- } else {
- if (nounit) {
- d_cnjg(&z__2, &a[j * a_dim1 + 1]);
- z__1.r = temp.r * z__2.r - temp.i * z__2.i,
- z__1.i = temp.r * z__2.i + temp.i *
- z__2.r;
- temp.r = z__1.r, temp.i = z__1.i;
- }
-/* Computing MIN */
- i__1 = *n, i__2 = j + *k;
- i__4 = min(i__1,i__2);
- for (i__ = j + 1; i__ <= i__4; ++i__) {
- d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
- i__1 = ix;
- z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
- z__2.i = z__3.r * x[i__1].i + z__3.i * x[
- i__1].r;
- z__1.r = temp.r + z__2.r, z__1.i = temp.i +
- z__2.i;
- temp.r = z__1.r, temp.i = z__1.i;
- ix += *incx;
-/* L190: */
- }
- }
- i__4 = jx;
- x[i__4].r = temp.r, x[i__4].i = temp.i;
- jx += *incx;
-/* L200: */
- }
- }
- }
- }
-
+ /* Function Body */
+ info = 0;
+ if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
+ info = 1;
+ } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
+ !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
+ info = 2;
+ } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < *k + 1) {
+ info = 7;
+ } else if (*incx == 0) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZTBMV ", &info, (ftnlen)6);
return 0;
+ }
-/* End of ZTBMV . */
+ /* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
+ nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
+
+ /* Set up the start point in X if the increment is not unity. This */
+ /* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+ /* Start the operations. In this version the elements of A are */
+ /* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
+ /* Form x := A*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__2 = 1, i__3 = j - *k;
+ i__4 = j - 1;
+ for (i__ = max(i__2, i__3); i__ <= i__4; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, z__2.i = temp.r * a[i__5].i + temp.i * a[i__5].r;
+ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + z__2.i;
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ /* L10: */
+ }
+ if (nounit) {
+ i__4 = j;
+ i__2 = j;
+ i__3 = kplus1 + j * a_dim1;
+ z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[i__3].i,
+ z__1.i = x[i__2].r * a[i__3].i + x[i__2].i * a[i__3].r;
+ x[i__4].r = z__1.r, x[i__4].i = z__1.i;
+ }
+ }
+ /* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__4 = jx;
+ if (x[i__4].r != 0. || x[i__4].i != 0.) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ ix = kx;
+ l = kplus1 - j;
+ /* Computing MAX */
+ i__4 = 1, i__2 = j - *k;
+ i__3 = j - 1;
+ for (i__ = max(i__4, i__2); i__ <= i__3; ++i__) {
+ i__4 = ix;
+ i__2 = ix;
+ i__5 = l + i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, z__2.i = temp.r * a[i__5].i + temp.i * a[i__5].r;
+ z__1.r = x[i__2].r + z__2.r, z__1.i = x[i__2].i + z__2.i;
+ x[i__4].r = z__1.r, x[i__4].i = z__1.i;
+ ix += *incx;
+ /* L30: */
+ }
+ if (nounit) {
+ i__3 = jx;
+ i__4 = jx;
+ i__2 = kplus1 + j * a_dim1;
+ z__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[i__2].i,
+ z__1.i = x[i__4].r * a[i__2].i + x[i__4].i * a[i__2].r;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ }
+ }
+ jx += *incx;
+ if (j > *k) {
+ kx += *incx;
+ }
+ /* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ if (x[i__1].r != 0. || x[i__1].i != 0.) {
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ l = 1 - j;
+ /* Computing MIN */
+ i__1 = *n, i__3 = j + *k;
+ i__4 = j + 1;
+ for (i__ = min(i__1, i__3); i__ >= i__4; --i__) {
+ i__1 = i__;
+ i__3 = i__;
+ i__2 = l + i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, z__2.i = temp.r * a[i__2].i + temp.i * a[i__2].r;
+ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + z__2.i;
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+ /* L50: */
+ }
+ if (nounit) {
+ i__4 = j;
+ i__1 = j;
+ i__3 = j * a_dim1 + 1;
+ z__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[i__3].i,
+ z__1.i = x[i__1].r * a[i__3].i + x[i__1].i * a[i__3].r;
+ x[i__4].r = z__1.r, x[i__4].i = z__1.i;
+ }
+ }
+ /* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ i__4 = jx;
+ if (x[i__4].r != 0. || x[i__4].i != 0.) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ ix = kx;
+ l = 1 - j;
+ /* Computing MIN */
+ i__4 = *n, i__1 = j + *k;
+ i__3 = j + 1;
+ for (i__ = min(i__4, i__1); i__ >= i__3; --i__) {
+ i__4 = ix;
+ i__1 = ix;
+ i__2 = l + i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, z__2.i = temp.r * a[i__2].i + temp.i * a[i__2].r;
+ z__1.r = x[i__1].r + z__2.r, z__1.i = x[i__1].i + z__2.i;
+ x[i__4].r = z__1.r, x[i__4].i = z__1.i;
+ ix -= *incx;
+ /* L70: */
+ }
+ if (nounit) {
+ i__3 = jx;
+ i__4 = jx;
+ i__1 = j * a_dim1 + 1;
+ z__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[i__1].i,
+ z__1.i = x[i__4].r * a[i__1].i + x[i__4].i * a[i__1].r;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ }
+ }
+ jx -= *incx;
+ if (*n - j >= *k) {
+ kx -= *incx;
+ }
+ /* L80: */
+ }
+ }
+ }
+ } else {
+ /* Form x := A'*x or x := conjg( A' )*x. */
+
+ if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
+ kplus1 = *k + 1;
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__3 = j;
+ temp.r = x[i__3].r, temp.i = x[i__3].i;
+ l = kplus1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__3 = kplus1 + j * a_dim1;
+ z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, z__1.i = temp.r * a[i__3].i + temp.i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ i__4 = l + i__ + j * a_dim1;
+ i__1 = i__;
+ z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
+ z__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ /* L90: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i, z__1.i = temp.r * z__2.i + temp.i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__4 = i__;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i = z__3.r * x[i__4].i + z__3.i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ /* L100: */
+ }
+ }
+ i__3 = j;
+ x[i__3].r = temp.r, x[i__3].i = temp.i;
+ /* L110: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ i__3 = jx;
+ temp.r = x[i__3].r, temp.i = x[i__3].i;
+ kx -= *incx;
+ ix = kx;
+ l = kplus1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__3 = kplus1 + j * a_dim1;
+ z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, z__1.i = temp.r * a[i__3].i + temp.i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ i__4 = l + i__ + j * a_dim1;
+ i__1 = ix;
+ z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
+ z__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix -= *incx;
+ /* L120: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i, z__1.i = temp.r * z__2.i + temp.i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MAX */
+ i__4 = 1, i__1 = j - *k;
+ i__3 = max(i__4, i__1);
+ for (i__ = j - 1; i__ >= i__3; --i__) {
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__4 = ix;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.i = z__3.r * x[i__4].i + z__3.i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix -= *incx;
+ /* L130: */
+ }
+ }
+ i__3 = jx;
+ x[i__3].r = temp.r, x[i__3].i = temp.i;
+ jx -= *incx;
+ /* L140: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ i__4 = j;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ l = 1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__4 = j * a_dim1 + 1;
+ z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, z__1.i = temp.r * a[i__4].i + temp.i * a[i__4].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ i__1 = l + i__ + j * a_dim1;
+ i__2 = i__;
+ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
+ z__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ /* L150: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j * a_dim1 + 1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i, z__1.i = temp.r * z__2.i + temp.i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__1 = i__;
+ z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i, z__2.i = z__3.r * x[i__1].i + z__3.i * x[i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ /* L160: */
+ }
+ }
+ i__4 = j;
+ x[i__4].r = temp.r, x[i__4].i = temp.i;
+ /* L170: */
+ }
+ } else {
+ jx = kx;
+ i__3 = *n;
+ for (j = 1; j <= i__3; ++j) {
+ i__4 = jx;
+ temp.r = x[i__4].r, temp.i = x[i__4].i;
+ kx += *incx;
+ ix = kx;
+ l = 1 - j;
+ if (noconj) {
+ if (nounit) {
+ i__4 = j * a_dim1 + 1;
+ z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, z__1.i = temp.r * a[i__4].i + temp.i * a[i__4].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ i__1 = l + i__ + j * a_dim1;
+ i__2 = ix;
+ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
+ z__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+ /* L180: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j * a_dim1 + 1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i, z__1.i = temp.r * z__2.i + temp.i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ /* Computing MIN */
+ i__1 = *n, i__2 = j + *k;
+ i__4 = min(i__1, i__2);
+ for (i__ = j + 1; i__ <= i__4; ++i__) {
+ d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
+ i__1 = ix;
+ z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i, z__2.i = z__3.r * x[i__1].i + z__3.i * x[i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+ /* L190: */
+ }
+ }
+ i__4 = jx;
+ x[i__4].r = temp.r, x[i__4].i = temp.i;
+ jx += *incx;
+ /* L200: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+ /* End of ZTBMV . */
} /* ztbmv_ */
-
diff --git a/lapack/cholesky.inc b/lapack/cholesky.inc
index ea3bc12..d38a10d 100644
--- a/lapack/cholesky.inc
+++ b/lapack/cholesky.inc
@@ -11,59 +11,62 @@
#include <Eigen/Cholesky>
// POTRF computes the Cholesky factorization of a real symmetric positive definite matrix A.
-EIGEN_LAPACK_FUNC(potrf,(char* uplo, int *n, RealScalar *pa, int *lda, int *info))
-{
+EIGEN_LAPACK_FUNC(potrf, (char *uplo, int *n, RealScalar *pa, int *lda, int *info)) {
*info = 0;
- if(UPLO(*uplo)==INVALID) *info = -1;
- else if(*n<0) *info = -2;
- else if(*lda<std::max(1,*n)) *info = -4;
- if(*info!=0)
- {
+ if (UPLO(*uplo) == INVALID)
+ *info = -1;
+ else if (*n < 0)
+ *info = -2;
+ else if (*lda < std::max(1, *n))
+ *info = -4;
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"POTRF", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "POTRF", &e, 6);
}
- Scalar* a = reinterpret_cast<Scalar*>(pa);
- MatrixType A(a,*n,*n,*lda);
+ Scalar *a = reinterpret_cast<Scalar *>(pa);
+ MatrixType A(a, *n, *n, *lda);
int ret;
- if(UPLO(*uplo)==UP) ret = int(internal::llt_inplace<Scalar, Upper>::blocked(A));
- else ret = int(internal::llt_inplace<Scalar, Lower>::blocked(A));
+ if (UPLO(*uplo) == UP)
+ ret = int(internal::llt_inplace<Scalar, Upper>::blocked(A));
+ else
+ ret = int(internal::llt_inplace<Scalar, Lower>::blocked(A));
- if(ret>=0)
- *info = ret+1;
-
+ if (ret >= 0) *info = ret + 1;
+
return 0;
}
// POTRS solves a system of linear equations A*X = B with a symmetric
// positive definite matrix A using the Cholesky factorization
// A = U**T*U or A = L*L**T computed by DPOTRF.
-EIGEN_LAPACK_FUNC(potrs,(char* uplo, int *n, int *nrhs, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, int *info))
-{
+EIGEN_LAPACK_FUNC(potrs,
+ (char *uplo, int *n, int *nrhs, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, int *info)) {
*info = 0;
- if(UPLO(*uplo)==INVALID) *info = -1;
- else if(*n<0) *info = -2;
- else if(*nrhs<0) *info = -3;
- else if(*lda<std::max(1,*n)) *info = -5;
- else if(*ldb<std::max(1,*n)) *info = -7;
- if(*info!=0)
- {
+ if (UPLO(*uplo) == INVALID)
+ *info = -1;
+ else if (*n < 0)
+ *info = -2;
+ else if (*nrhs < 0)
+ *info = -3;
+ else if (*lda < std::max(1, *n))
+ *info = -5;
+ else if (*ldb < std::max(1, *n))
+ *info = -7;
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"POTRS", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "POTRS", &e, 6);
}
- Scalar* a = reinterpret_cast<Scalar*>(pa);
- Scalar* b = reinterpret_cast<Scalar*>(pb);
- MatrixType A(a,*n,*n,*lda);
- MatrixType B(b,*n,*nrhs,*ldb);
+ Scalar *a = reinterpret_cast<Scalar *>(pa);
+ Scalar *b = reinterpret_cast<Scalar *>(pb);
+ MatrixType A(a, *n, *n, *lda);
+ MatrixType B(b, *n, *nrhs, *ldb);
- if(UPLO(*uplo)==UP)
- {
+ if (UPLO(*uplo) == UP) {
A.triangularView<Upper>().adjoint().solveInPlace(B);
A.triangularView<Upper>().solveInPlace(B);
- }
- else
- {
+ } else {
A.triangularView<Lower>().solveInPlace(B);
A.triangularView<Lower>().adjoint().solveInPlace(B);
}
diff --git a/lapack/eigenvalues.inc b/lapack/eigenvalues.inc
index 921c515..62192f4 100644
--- a/lapack/eigenvalues.inc
+++ b/lapack/eigenvalues.inc
@@ -11,52 +11,53 @@
#include <Eigen/Eigenvalues>
// computes eigen values and vectors of a general N-by-N matrix A
-EIGEN_LAPACK_FUNC(syev,(char *jobz, char *uplo, int* n, Scalar* a, int *lda, Scalar* w, Scalar* /*work*/, int* lwork, int *info))
-{
+EIGEN_LAPACK_FUNC(syev, (char* jobz, char* uplo, int* n, Scalar* a, int* lda, Scalar* w, Scalar* /*work*/, int* lwork,
+ int* info)) {
// TODO exploit the work buffer
- bool query_size = *lwork==-1;
-
+ bool query_size = *lwork == -1;
+
*info = 0;
- if(*jobz!='N' && *jobz!='V') *info = -1;
- else if(UPLO(*uplo)==INVALID) *info = -2;
- else if(*n<0) *info = -3;
- else if(*lda<std::max(1,*n)) *info = -5;
- else if((!query_size) && *lwork<std::max(1,3**n-1)) *info = -8;
-
- if(*info!=0)
- {
+ if (*jobz != 'N' && *jobz != 'V')
+ *info = -1;
+ else if (UPLO(*uplo) == INVALID)
+ *info = -2;
+ else if (*n < 0)
+ *info = -3;
+ else if (*lda < std::max(1, *n))
+ *info = -5;
+ else if ((!query_size) && *lwork < std::max(1, 3 * *n - 1))
+ *info = -8;
+
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"SYEV ", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "SYEV ", &e, 6);
}
-
- if(query_size)
- {
+
+ if (query_size) {
*lwork = 0;
return 0;
}
-
- if(*n==0)
- return 0;
-
- PlainMatrixType mat(*n,*n);
- if(UPLO(*uplo)==UP) mat = matrix(a,*n,*n,*lda).adjoint();
- else mat = matrix(a,*n,*n,*lda);
-
- bool computeVectors = *jobz=='V' || *jobz=='v';
- SelfAdjointEigenSolver<PlainMatrixType> eig(mat,computeVectors?ComputeEigenvectors:EigenvaluesOnly);
-
- if(eig.info()==NoConvergence)
- {
- make_vector(w,*n).setZero();
- if(computeVectors)
- matrix(a,*n,*n,*lda).setIdentity();
+
+ if (*n == 0) return 0;
+
+ PlainMatrixType mat(*n, *n);
+ if (UPLO(*uplo) == UP)
+ mat = matrix(a, *n, *n, *lda).adjoint();
+ else
+ mat = matrix(a, *n, *n, *lda);
+
+ bool computeVectors = *jobz == 'V' || *jobz == 'v';
+ SelfAdjointEigenSolver<PlainMatrixType> eig(mat, computeVectors ? ComputeEigenvectors : EigenvaluesOnly);
+
+ if (eig.info() == NoConvergence) {
+ make_vector(w, *n).setZero();
+ if (computeVectors) matrix(a, *n, *n, *lda).setIdentity();
//*info = 1;
return 0;
}
-
- make_vector(w,*n) = eig.eigenvalues();
- if(computeVectors)
- matrix(a,*n,*n,*lda) = eig.eigenvectors();
-
+
+ make_vector(w, *n) = eig.eigenvalues();
+ if (computeVectors) matrix(a, *n, *n, *lda) = eig.eigenvectors();
+
return 0;
}
diff --git a/lapack/lu.inc b/lapack/lu.inc
index 90cebe0..ca64d90 100644
--- a/lapack/lu.inc
+++ b/lapack/lu.inc
@@ -11,79 +11,74 @@
#include <Eigen/LU>
// computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges
-EIGEN_LAPACK_FUNC(getrf,(int *m, int *n, RealScalar *pa, int *lda, int *ipiv, int *info))
-{
+EIGEN_LAPACK_FUNC(getrf, (int *m, int *n, RealScalar *pa, int *lda, int *ipiv, int *info)) {
*info = 0;
- if(*m<0) *info = -1;
- else if(*n<0) *info = -2;
- else if(*lda<std::max(1,*m)) *info = -4;
- if(*info!=0)
- {
+ if (*m < 0)
+ *info = -1;
+ else if (*n < 0)
+ *info = -2;
+ else if (*lda < std::max(1, *m))
+ *info = -4;
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"GETRF", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "GETRF", &e, 6);
}
- if(*m==0 || *n==0)
- return 0;
+ if (*m == 0 || *n == 0) return 0;
- Scalar* a = reinterpret_cast<Scalar*>(pa);
+ Scalar *a = reinterpret_cast<Scalar *>(pa);
int nb_transpositions;
- int ret = int(Eigen::internal::partial_lu_impl<Scalar,ColMajor,int>
- ::blocked_lu(*m, *n, a, *lda, ipiv, nb_transpositions));
+ int ret = int(
+ Eigen::internal::partial_lu_impl<Scalar, ColMajor, int>::blocked_lu(*m, *n, a, *lda, ipiv, nb_transpositions));
- for(int i=0; i<std::min(*m,*n); ++i)
- ipiv[i]++;
+ for (int i = 0; i < std::min(*m, *n); ++i) ipiv[i]++;
- if(ret>=0)
- *info = ret+1;
+ if (ret >= 0) *info = ret + 1;
return 0;
}
-//GETRS solves a system of linear equations
-// A * X = B or A' * X = B
-// with a general N-by-N matrix A using the LU factorization computed by GETRF
-EIGEN_LAPACK_FUNC(getrs,(char *trans, int *n, int *nrhs, RealScalar *pa, int *lda, int *ipiv, RealScalar *pb, int *ldb, int *info))
-{
+// GETRS solves a system of linear equations
+// A * X = B or A' * X = B
+// with a general N-by-N matrix A using the LU factorization computed by GETRF
+EIGEN_LAPACK_FUNC(getrs, (char *trans, int *n, int *nrhs, RealScalar *pa, int *lda, int *ipiv, RealScalar *pb, int *ldb,
+ int *info)) {
*info = 0;
- if(OP(*trans)==INVALID) *info = -1;
- else if(*n<0) *info = -2;
- else if(*nrhs<0) *info = -3;
- else if(*lda<std::max(1,*n)) *info = -5;
- else if(*ldb<std::max(1,*n)) *info = -8;
- if(*info!=0)
- {
+ if (OP(*trans) == INVALID)
+ *info = -1;
+ else if (*n < 0)
+ *info = -2;
+ else if (*nrhs < 0)
+ *info = -3;
+ else if (*lda < std::max(1, *n))
+ *info = -5;
+ else if (*ldb < std::max(1, *n))
+ *info = -8;
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"GETRS", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "GETRS", &e, 6);
}
- Scalar* a = reinterpret_cast<Scalar*>(pa);
- Scalar* b = reinterpret_cast<Scalar*>(pb);
- MatrixType lu(a,*n,*n,*lda);
- MatrixType B(b,*n,*nrhs,*ldb);
+ Scalar *a = reinterpret_cast<Scalar *>(pa);
+ Scalar *b = reinterpret_cast<Scalar *>(pb);
+ MatrixType lu(a, *n, *n, *lda);
+ MatrixType B(b, *n, *nrhs, *ldb);
- for(int i=0; i<*n; ++i)
- ipiv[i]--;
- if(OP(*trans)==NOTR)
- {
- B = PivotsType(ipiv,*n) * B;
+ for (int i = 0; i < *n; ++i) ipiv[i]--;
+ if (OP(*trans) == NOTR) {
+ B = PivotsType(ipiv, *n) * B;
lu.triangularView<UnitLower>().solveInPlace(B);
lu.triangularView<Upper>().solveInPlace(B);
- }
- else if(OP(*trans)==TR)
- {
+ } else if (OP(*trans) == TR) {
lu.triangularView<Upper>().transpose().solveInPlace(B);
lu.triangularView<UnitLower>().transpose().solveInPlace(B);
- B = PivotsType(ipiv,*n).transpose() * B;
- }
- else if(OP(*trans)==ADJ)
- {
+ B = PivotsType(ipiv, *n).transpose() * B;
+ } else if (OP(*trans) == ADJ) {
lu.triangularView<Upper>().adjoint().solveInPlace(B);
lu.triangularView<UnitLower>().adjoint().solveInPlace(B);
- B = PivotsType(ipiv,*n).transpose() * B;
+ B = PivotsType(ipiv, *n).transpose() * B;
}
- for(int i=0; i<*n; ++i)
- ipiv[i]++;
+ for (int i = 0; i < *n; ++i) ipiv[i]++;
return 0;
}
diff --git a/lapack/svd.inc b/lapack/svd.inc
index 83544cf..a278cf0 100644
--- a/lapack/svd.inc
+++ b/lapack/svd.inc
@@ -11,128 +11,135 @@
#include <Eigen/SVD>
// computes the singular values/vectors a general M-by-N matrix A using divide-and-conquer
-EIGEN_LAPACK_FUNC(gesdd,(char *jobz, int *m, int* n, Scalar* a, int *lda, RealScalar *s, Scalar *u, int *ldu, Scalar *vt, int *ldvt, Scalar* /*work*/, int* lwork,
- EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int * /*iwork*/, int *info))
-{
+EIGEN_LAPACK_FUNC(gesdd, (char *jobz, int *m, int *n, Scalar *a, int *lda, RealScalar *s, Scalar *u, int *ldu,
+ Scalar *vt, int *ldvt, Scalar * /*work*/, int *lwork,
+ EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar * /*rwork*/) int * /*iwork*/, int *info)) {
// TODO exploit the work buffer
- bool query_size = *lwork==-1;
- int diag_size = (std::min)(*m,*n);
-
+ bool query_size = *lwork == -1;
+ int diag_size = (std::min)(*m, *n);
+
*info = 0;
- if(*jobz!='A' && *jobz!='S' && *jobz!='O' && *jobz!='N') *info = -1;
- else if(*m<0) *info = -2;
- else if(*n<0) *info = -3;
- else if(*lda<std::max(1,*m)) *info = -5;
- else if(*lda<std::max(1,*m)) *info = -8;
- else if(*ldu <1 || (*jobz=='A' && *ldu <*m)
- || (*jobz=='O' && *m<*n && *ldu<*m)) *info = -8;
- else if(*ldvt<1 || (*jobz=='A' && *ldvt<*n)
- || (*jobz=='S' && *ldvt<diag_size)
- || (*jobz=='O' && *m>=*n && *ldvt<*n)) *info = -10;
-
- if(*info!=0)
- {
+ if (*jobz != 'A' && *jobz != 'S' && *jobz != 'O' && *jobz != 'N')
+ *info = -1;
+ else if (*m < 0)
+ *info = -2;
+ else if (*n < 0)
+ *info = -3;
+ else if (*lda < std::max(1, *m))
+ *info = -5;
+ else if (*lda < std::max(1, *m))
+ *info = -8;
+ else if (*ldu < 1 || (*jobz == 'A' && *ldu < *m) || (*jobz == 'O' && *m < *n && *ldu < *m))
+ *info = -8;
+ else if (*ldvt < 1 || (*jobz == 'A' && *ldvt < *n) || (*jobz == 'S' && *ldvt < diag_size) ||
+ (*jobz == 'O' && *m >= *n && *ldvt < *n))
+ *info = -10;
+
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"GESDD ", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "GESDD ", &e, 6);
}
-
- if(query_size)
- {
+
+ if (query_size) {
*lwork = 0;
return 0;
}
-
- if(*n==0 || *m==0)
- return 0;
-
- PlainMatrixType mat(*m,*n);
- mat = matrix(a,*m,*n,*lda);
-
- int option = *jobz=='A' ? ComputeFullU|ComputeFullV
- : *jobz=='S' ? ComputeThinU|ComputeThinV
- : *jobz=='O' ? ComputeThinU|ComputeThinV
- : 0;
- BDCSVD<PlainMatrixType> svd(mat,option);
-
- make_vector(s,diag_size) = svd.singularValues().head(diag_size);
+ if (*n == 0 || *m == 0) return 0;
- if(*jobz=='A')
- {
- matrix(u,*m,*m,*ldu) = svd.matrixU();
- matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
+ PlainMatrixType mat(*m, *n);
+ mat = matrix(a, *m, *n, *lda);
+
+ int option = *jobz == 'A' ? ComputeFullU | ComputeFullV
+ : *jobz == 'S' ? ComputeThinU | ComputeThinV
+ : *jobz == 'O' ? ComputeThinU | ComputeThinV
+ : 0;
+
+ BDCSVD<PlainMatrixType> svd(mat, option);
+
+ make_vector(s, diag_size) = svd.singularValues().head(diag_size);
+
+ if (*jobz == 'A') {
+ matrix(u, *m, *m, *ldu) = svd.matrixU();
+ matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
+ } else if (*jobz == 'S') {
+ matrix(u, *m, diag_size, *ldu) = svd.matrixU();
+ matrix(vt, diag_size, *n, *ldvt) = svd.matrixV().adjoint();
+ } else if (*jobz == 'O' && *m >= *n) {
+ matrix(a, *m, *n, *lda) = svd.matrixU();
+ matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
+ } else if (*jobz == 'O') {
+ matrix(u, *m, *m, *ldu) = svd.matrixU();
+ matrix(a, diag_size, *n, *lda) = svd.matrixV().adjoint();
}
- else if(*jobz=='S')
- {
- matrix(u,*m,diag_size,*ldu) = svd.matrixU();
- matrix(vt,diag_size,*n,*ldvt) = svd.matrixV().adjoint();
- }
- else if(*jobz=='O' && *m>=*n)
- {
- matrix(a,*m,*n,*lda) = svd.matrixU();
- matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
- }
- else if(*jobz=='O')
- {
- matrix(u,*m,*m,*ldu) = svd.matrixU();
- matrix(a,diag_size,*n,*lda) = svd.matrixV().adjoint();
- }
-
+
return 0;
}
// computes the singular values/vectors a general M-by-N matrix A using two sided jacobi algorithm
-EIGEN_LAPACK_FUNC(gesvd,(char *jobu, char *jobv, int *m, int* n, Scalar* a, int *lda, RealScalar *s, Scalar *u, int *ldu, Scalar *vt, int *ldvt, Scalar* /*work*/, int* lwork,
- EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int *info))
-{
+EIGEN_LAPACK_FUNC(gesvd, (char *jobu, char *jobv, int *m, int *n, Scalar *a, int *lda, RealScalar *s, Scalar *u,
+ int *ldu, Scalar *vt, int *ldvt, Scalar * /*work*/, int *lwork,
+ EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar * /*rwork*/) int *info)) {
// TODO exploit the work buffer
- bool query_size = *lwork==-1;
- int diag_size = (std::min)(*m,*n);
-
+ bool query_size = *lwork == -1;
+ int diag_size = (std::min)(*m, *n);
+
*info = 0;
- if( *jobu!='A' && *jobu!='S' && *jobu!='O' && *jobu!='N') *info = -1;
- else if((*jobv!='A' && *jobv!='S' && *jobv!='O' && *jobv!='N')
- || (*jobu=='O' && *jobv=='O')) *info = -2;
- else if(*m<0) *info = -3;
- else if(*n<0) *info = -4;
- else if(*lda<std::max(1,*m)) *info = -6;
- else if(*ldu <1 || ((*jobu=='A' || *jobu=='S') && *ldu<*m)) *info = -9;
- else if(*ldvt<1 || (*jobv=='A' && *ldvt<*n)
- || (*jobv=='S' && *ldvt<diag_size)) *info = -11;
-
- if(*info!=0)
- {
+ if (*jobu != 'A' && *jobu != 'S' && *jobu != 'O' && *jobu != 'N')
+ *info = -1;
+ else if ((*jobv != 'A' && *jobv != 'S' && *jobv != 'O' && *jobv != 'N') || (*jobu == 'O' && *jobv == 'O'))
+ *info = -2;
+ else if (*m < 0)
+ *info = -3;
+ else if (*n < 0)
+ *info = -4;
+ else if (*lda < std::max(1, *m))
+ *info = -6;
+ else if (*ldu < 1 || ((*jobu == 'A' || *jobu == 'S') && *ldu < *m))
+ *info = -9;
+ else if (*ldvt < 1 || (*jobv == 'A' && *ldvt < *n) || (*jobv == 'S' && *ldvt < diag_size))
+ *info = -11;
+
+ if (*info != 0) {
int e = -*info;
- return xerbla_(SCALAR_SUFFIX_UP"GESVD ", &e, 6);
+ return xerbla_(SCALAR_SUFFIX_UP "GESVD ", &e, 6);
}
-
- if(query_size)
- {
+
+ if (query_size) {
*lwork = 0;
return 0;
}
-
- if(*n==0 || *m==0)
- return 0;
-
- PlainMatrixType mat(*m,*n);
- mat = matrix(a,*m,*n,*lda);
-
- int option = (*jobu=='A' ? ComputeFullU : *jobu=='S' || *jobu=='O' ? ComputeThinU : 0)
- | (*jobv=='A' ? ComputeFullV : *jobv=='S' || *jobv=='O' ? ComputeThinV : 0);
-
- JacobiSVD<PlainMatrixType> svd(mat,option);
-
- make_vector(s,diag_size) = svd.singularValues().head(diag_size);
+
+ if (*n == 0 || *m == 0) return 0;
+
+ PlainMatrixType mat(*m, *n);
+ mat = matrix(a, *m, *n, *lda);
+
+ int option = (*jobu == 'A' ? ComputeFullU
+ : *jobu == 'S' || *jobu == 'O' ? ComputeThinU
+ : 0) |
+ (*jobv == 'A' ? ComputeFullV
+ : *jobv == 'S' || *jobv == 'O' ? ComputeThinV
+ : 0);
+
+ JacobiSVD<PlainMatrixType> svd(mat, option);
+
+ make_vector(s, diag_size) = svd.singularValues().head(diag_size);
{
- if(*jobu=='A') matrix(u,*m,*m,*ldu) = svd.matrixU();
- else if(*jobu=='S') matrix(u,*m,diag_size,*ldu) = svd.matrixU();
- else if(*jobu=='O') matrix(a,*m,diag_size,*lda) = svd.matrixU();
+ if (*jobu == 'A')
+ matrix(u, *m, *m, *ldu) = svd.matrixU();
+ else if (*jobu == 'S')
+ matrix(u, *m, diag_size, *ldu) = svd.matrixU();
+ else if (*jobu == 'O')
+ matrix(a, *m, diag_size, *lda) = svd.matrixU();
}
{
- if(*jobv=='A') matrix(vt,*n,*n,*ldvt) = svd.matrixV().adjoint();
- else if(*jobv=='S') matrix(vt,diag_size,*n,*ldvt) = svd.matrixV().adjoint();
- else if(*jobv=='O') matrix(a,diag_size,*n,*lda) = svd.matrixV().adjoint();
+ if (*jobv == 'A')
+ matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
+ else if (*jobv == 'S')
+ matrix(vt, diag_size, *n, *ldvt) = svd.matrixV().adjoint();
+ else if (*jobv == 'O')
+ matrix(a, diag_size, *n, *lda) = svd.matrixV().adjoint();
}
return 0;
}
\ No newline at end of file
