GitHub-Proxy/eigen
1
0
Fork 0
mirror of https://gitlab.com/libeigen/eigen.git synced 2025-07-23 05:14:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

Apply clang-format to lapack/blas directories

Browse Source
This commit is contained in:
Antonio Sanchez 2024-02-09 10:32:56 -08:00 committed by Antonio Sánchez
parent 4eac211e96
commit 186f8205db
24 changed files with 5720 additions and 6027 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
blas/f2c/chbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int chbmv_(char *uplo, integer *n, integer *k, complex * /* Subroutine */ int chbmv_(char *uplo, integer *n, integer *k, complex *alpha, complex *a, integer *lda, complex *x,
alpha, complex *a, integer *lda, complex *x, integer *incx, complex * integer *incx, complex *beta, complex *y, integer *incy, ftnlen uplo_len) {
beta, complex *y, integer *incy, ftnlen uplo_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
real r__1; real r__1;
@ -183,8 +181,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -204,8 +201,7 @@
/* Quick return if possible. */ /* Quick return if possible. */
if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
beta->i == 0.f))) {
return 0; return 0;
} }
@ -241,9 +237,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
q__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
/* L20: */ /* L20: */
} }
@ -263,9 +257,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = iy; i__2 = iy;
i__3 = iy; i__3 = iy;
q__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
iy += *incy; iy += *incy;
/* L40: */ /* L40: */
@ -277,7 +269,6 @@
return 0; return 0;
} }
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when upper triangle of A is stored. */ /* Form y when upper triangle of A is stored. */
kplus1 = *k + 1; kplus1 = *k + 1;
@ -285,8 +276,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
l = kplus1 - j; l = kplus1 - j;
@ -297,15 +287,12 @@
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__2 = i__; i__2 = i__;
q__2.r = q__3.r * x[i__2].r - q__3.i * x[i__2].i, q__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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
/* L50: */ /* L50: */
@ -316,8 +303,7 @@
r__1 = a[i__3].r; r__1 = a[i__3].r;
q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i; 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__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 = q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__4].r = q__1.r, y[i__4].i = q__1.i;
/* L60: */ /* L60: */
@ -328,8 +314,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__4 = jx; i__4 = jx;
q__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, q__1.i = 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;
alpha->r * x[i__4].i + alpha->i * x[i__4].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
ix = kx; ix = kx;
@ -342,15 +327,12 @@
i__4 = iy; i__4 = iy;
i__2 = iy; i__2 = iy;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = q__1.r, y[i__4].i = q__1.i;
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
ix += *incx; ix += *incx;
@ -363,8 +345,7 @@
r__1 = a[i__2].r; r__1 = a[i__2].r;
q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i; 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__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 = q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
jx += *incx; jx += *incx;
@ -377,15 +358,13 @@
} }
} }
} else { } else {
/* Form y when lower triangle of A is stored. */ /* Form y when lower triangle of A is stored. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__3 = j; i__3 = j;
q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i = 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;
alpha->r * x[i__3].i + alpha->i * x[i__3].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
i__3 = j; i__3 = j;
@ -403,23 +382,19 @@
i__4 = i__; i__4 = i__;
i__2 = i__; i__2 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = q__1.r, y[i__4].i = q__1.i;
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__4 = i__; i__4 = i__;
q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
/* L90: */ /* L90: */
} }
i__3 = j; i__3 = j;
i__4 = j; i__4 = j;
q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
/* L100: */ /* L100: */
@ -430,8 +405,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__3 = jx; i__3 = jx;
q__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, q__1.i = 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;
alpha->r * x[i__3].i + alpha->i * x[i__3].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
i__3 = jy; i__3 = jy;
@ -453,23 +427,19 @@
i__4 = iy; i__4 = iy;
i__2 = iy; i__2 = iy;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = q__1.r, y[i__4].i = q__1.i;
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
q__2.r = q__3.r * x[i__4].r - q__3.i * x[i__4].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
/* L110: */ /* L110: */
} }
i__3 = jy; i__3 = jy;
i__4 = jy; i__4 = jy;
q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
jx += *incx; jx += *incx;
@ -484,4 +454,3 @@
/* End of CHBMV . */ /* End of CHBMV . */
} /* chbmv_ */ } /* chbmv_ */

75
blas/f2c/chpmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int chpmv_(char *uplo, integer *n, complex *alpha, complex * /* Subroutine */ int chpmv_(char *uplo, integer *n, complex *alpha, complex *ap, complex *x, integer *incx,
ap, complex *x, integer *incx, complex *beta, complex *y, integer * complex *beta, complex *y, integer *incy, ftnlen uplo_len) {
incy, ftnlen uplo_len)
{
/* System generated locals */ /* System generated locals */
integer i__1, i__2, i__3, i__4, i__5; integer i__1, i__2, i__3, i__4, i__5;
real r__1; real r__1;
@ -146,8 +144,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -163,8 +160,7 @@
/* Quick return if possible. */ /* Quick return if possible. */
if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
beta->i == 0.f))) {
return 0; return 0;
} }
@ -200,9 +196,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
q__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
/* L20: */ /* L20: */
} }
@ -222,9 +216,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = iy; i__2 = iy;
i__3 = iy; i__3 = iy;
q__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
iy += *incy; iy += *incy;
/* L40: */ /* L40: */
@ -237,15 +229,13 @@
} }
kk = 1; kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when AP contains the upper triangle. */ /* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
k = kk; k = kk;
@ -254,15 +244,12 @@
i__3 = i__; i__3 = i__;
i__4 = i__; i__4 = i__;
i__5 = k; i__5 = k;
q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
r_cnjg(&q__3, &ap[k]); r_cnjg(&q__3, &ap[k]);
i__3 = i__; i__3 = i__;
q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
++k; ++k;
@ -274,8 +261,7 @@
r__1 = ap[i__4].r; r__1 = ap[i__4].r;
q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i; 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__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 = q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
kk += j; kk += j;
@ -287,8 +273,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = jx; i__2 = jx;
q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
ix = kx; ix = kx;
@ -298,15 +283,12 @@
i__3 = iy; i__3 = iy;
i__4 = iy; i__4 = iy;
i__5 = k; i__5 = k;
q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
r_cnjg(&q__3, &ap[k]); r_cnjg(&q__3, &ap[k]);
i__3 = ix; i__3 = ix;
q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
ix += *incx; ix += *incx;
@ -319,8 +301,7 @@
r__1 = ap[i__4].r; r__1 = ap[i__4].r;
q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i; 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__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 = q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
jx += *incx; jx += *incx;
@ -330,15 +311,13 @@
} }
} }
} else { } else {
/* Form y when AP contains the lower triangle. */ /* Form y when AP contains the lower triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
i__2 = j; i__2 = j;
@ -354,15 +333,12 @@
i__3 = i__; i__3 = i__;
i__4 = i__; i__4 = i__;
i__5 = k; i__5 = k;
q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
r_cnjg(&q__3, &ap[k]); r_cnjg(&q__3, &ap[k]);
i__3 = i__; i__3 = i__;
q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
++k; ++k;
@ -370,8 +346,7 @@
} }
i__2 = j; i__2 = j;
i__3 = j; i__3 = j;
q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
kk += *n - j + 1; kk += *n - j + 1;
@ -383,8 +358,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = jx; i__2 = jx;
q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = q__1.r, temp1.i = q__1.i; temp1.r = q__1.r, temp1.i = q__1.i;
temp2.r = 0.f, temp2.i = 0.f; temp2.r = 0.f, temp2.i = 0.f;
i__2 = jy; i__2 = jy;
@ -403,23 +377,19 @@
i__3 = iy; i__3 = iy;
i__4 = iy; i__4 = iy;
i__5 = k; i__5 = k;
q__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = q__1.r, y[i__3].i = q__1.i;
r_cnjg(&q__3, &ap[k]); r_cnjg(&q__3, &ap[k]);
i__3 = ix; i__3 = ix;
q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.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__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; 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; temp2.r = q__1.r, temp2.i = q__1.i;
/* L110: */ /* L110: */
} }
i__2 = jy; i__2 = jy;
i__3 = jy; i__3 = jy;
q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = q__1.r, y[i__2].i = q__1.i;
jx += *incx; jx += *incx;
@ -435,4 +405,3 @@
/* End of CHPMV . */ /* End of CHPMV . */
} /* chpmv_ */ } /* chpmv_ */

31
blas/f2c/complexdots.c
View File

@ -18,12 +18,9 @@
#include "datatypes.h" #include "datatypes.h"
complex cdotc_(integer *n, complex *cx, integer complex cdotc_(integer *n, complex *cx, integer *incx, complex *cy, integer *incy) {
*incx, complex *cy, integer *incy)
{
complex res; complex res;
extern /* Subroutine */ int cdotcw_(integer *, complex *, integer *, extern /* Subroutine */ int cdotcw_(integer *, complex *, integer *, complex *, integer *, complex *);
complex *, integer *, complex *);
/* Parameter adjustments */ /* Parameter adjustments */
--cy; --cy;
@ -34,12 +31,9 @@ complex cdotc_(integer *n, complex *cx, integer
return res; return res;
} /* cdotc_ */ } /* cdotc_ */
complex cdotu_(integer *n, complex *cx, integer complex cdotu_(integer *n, complex *cx, integer *incx, complex *cy, integer *incy) {
*incx, complex *cy, integer *incy)
{
complex res; complex res;
extern /* Subroutine */ int cdotuw_(integer *, complex *, integer *, extern /* Subroutine */ int cdotuw_(integer *, complex *, integer *, complex *, integer *, complex *);
complex *, integer *, complex *);
/* Parameter adjustments */ /* Parameter adjustments */
--cy; --cy;
@ -50,12 +44,10 @@ complex cdotu_(integer *n, complex *cx, integer
return res; return res;
} /* cdotu_ */ } /* cdotu_ */
doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx, doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy) {
doublecomplex *cy, integer *incy)
{
doublecomplex res; doublecomplex res;
extern /* Subroutine */ int zdotcw_(integer *, doublecomplex *, integer *, extern /* Subroutine */ int zdotcw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *); doublecomplex *);
/* Parameter adjustments */ /* Parameter adjustments */
--cy; --cy;
@ -66,12 +58,10 @@ doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx,
return res; return res;
} /* zdotc_ */ } /* zdotc_ */
doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx, doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy) {
doublecomplex *cy, integer *incy)
{
doublecomplex res; doublecomplex res;
extern /* Subroutine */ int zdotuw_(integer *, doublecomplex *, integer *, extern /* Subroutine */ int zdotuw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *); doublecomplex *);
/* Parameter adjustments */ /* Parameter adjustments */
--cy; --cy;
@ -81,4 +71,3 @@ doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx,
zdotuw_(n, &cx[1], incx, &cy[1], incy, &res); zdotuw_(n, &cx[1], incx, &cy[1], incy, &res);
return res; return res;
} /* zdotu_ */ } /* zdotu_ */

160
blas/f2c/ctbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int ctbmv_(char *uplo, char *trans, char *diag, integer *n, /* Subroutine */ int ctbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex *a, integer *lda,
integer *k, complex *a, integer *lda, complex *x, integer *incx, complex *x, integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
complex q__1, q__2, q__3; complex q__1, q__2, q__3;
@ -188,15 +186,12 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
"T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
ftnlen)1)) {
info = 2; info = 2;
} else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
"N", (ftnlen)1, (ftnlen)1)) {
info = 3; info = 3;
} else if (*n < 0) { } else if (*n < 0) {
info = 4; info = 4;
@ -234,7 +229,6 @@
/* accessed sequentially with one pass through A. */ /* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
/* Form x := A*x. */ /* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -254,11 +248,8 @@
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 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__2.i = temp.r * a[i__5].i + temp.i * a[ q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i + q__2.i;
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; x[i__2].r = q__1.r, x[i__2].i = q__1.i;
/* L10: */ /* L10: */
} }
@ -266,9 +257,8 @@
i__4 = j; i__4 = j;
i__2 = j; i__2 = j;
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[ q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[i__3].i,
i__3].i, q__1.i = x[i__2].r * 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__2].i * a[i__3].r;
x[i__4].r = q__1.r, x[i__4].i = q__1.i; x[i__4].r = q__1.r, x[i__4].i = q__1.i;
} }
} }
@ -291,11 +281,8 @@
i__4 = ix; i__4 = ix;
i__2 = ix; i__2 = ix;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 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__2.i = temp.r * a[i__5].i + temp.i * a[ q__1.r = x[i__2].r + q__2.r, q__1.i = x[i__2].i + q__2.i;
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; x[i__4].r = q__1.r, x[i__4].i = q__1.i;
ix += *incx; ix += *incx;
/* L30: */ /* L30: */
@ -304,9 +291,8 @@
i__3 = jx; i__3 = jx;
i__4 = jx; i__4 = jx;
i__2 = kplus1 + j * a_dim1; i__2 = kplus1 + j * a_dim1;
q__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[ q__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[i__2].i,
i__2].i, q__1.i = x[i__4].r * 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__4].i * a[i__2].r;
x[i__3].r = q__1.r, x[i__3].i = q__1.i; x[i__3].r = q__1.r, x[i__3].i = q__1.i;
} }
} }
@ -332,11 +318,8 @@
i__1 = i__; i__1 = i__;
i__3 = i__; i__3 = i__;
i__2 = l + i__ + j * a_dim1; i__2 = l + i__ + j * a_dim1;
q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 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__2.i = temp.r * a[i__2].i + temp.i * a[ q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i + q__2.i;
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; x[i__1].r = q__1.r, x[i__1].i = q__1.i;
/* L50: */ /* L50: */
} }
@ -344,9 +327,8 @@
i__4 = j; i__4 = j;
i__1 = j; i__1 = j;
i__3 = j * a_dim1 + 1; i__3 = j * a_dim1 + 1;
q__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[ q__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[i__3].i,
i__3].i, q__1.i = x[i__1].r * 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__1].i * a[i__3].r;
x[i__4].r = q__1.r, x[i__4].i = q__1.i; x[i__4].r = q__1.r, x[i__4].i = q__1.i;
} }
} }
@ -369,11 +351,8 @@
i__4 = ix; i__4 = ix;
i__1 = ix; i__1 = ix;
i__2 = l + i__ + j * a_dim1; i__2 = l + i__ + j * a_dim1;
q__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 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__2.i = temp.r * a[i__2].i + temp.i * a[ q__1.r = x[i__1].r + q__2.r, q__1.i = x[i__1].i + q__2.i;
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; x[i__4].r = q__1.r, x[i__4].i = q__1.i;
ix -= *incx; ix -= *incx;
/* L70: */ /* L70: */
@ -382,9 +361,8 @@
i__3 = jx; i__3 = jx;
i__4 = jx; i__4 = jx;
i__1 = j * a_dim1 + 1; i__1 = j * a_dim1 + 1;
q__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[ q__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[i__1].i,
i__1].i, q__1.i = x[i__4].r * 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__4].i * a[i__1].r;
x[i__3].r = q__1.r, x[i__3].i = q__1.i; x[i__3].r = q__1.r, x[i__3].i = q__1.i;
} }
} }
@ -397,7 +375,6 @@
} }
} }
} else { } else {
/* Form x := A'*x or x := conjg( A' )*x. */ /* Form x := A'*x or x := conjg( A' )*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -410,9 +387,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 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;
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; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -421,20 +396,16 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
i__4 = l + i__ + j * a_dim1; i__4 = l + i__ + j * a_dim1;
i__1 = i__; i__1 = i__;
q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[ q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
i__1].i, q__2.i = a[i__4].r * x[i__1].i + q__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
a[i__4].i * x[i__1].r; q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
/* L90: */ /* L90: */
} }
} else { } else {
if (nounit) { if (nounit) {
r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
q__1.r = temp.r * q__2.r - temp.i * q__2.i, 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;
q__1.i = temp.r * q__2.i + temp.i *
q__2.r;
temp.r = q__1.r, temp.i = q__1.i; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -443,11 +414,8 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__4 = i__; i__4 = i__;
q__2.r = q__3.r * x[i__4].r - q__3.i * x[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__2.i = q__3.r * x[i__4].i + q__3.i * x[ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
/* L100: */ /* L100: */
} }
@ -468,9 +436,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
q__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 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;
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; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -479,11 +445,9 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
i__4 = l + i__ + j * a_dim1; i__4 = l + i__ + j * a_dim1;
i__1 = ix; i__1 = ix;
q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[ q__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
i__1].i, q__2.i = a[i__4].r * x[i__1].i + q__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
a[i__4].i * x[i__1].r; q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
ix -= *incx; ix -= *incx;
/* L120: */ /* L120: */
@ -491,9 +455,7 @@
} else { } else {
if (nounit) { if (nounit) {
r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); r_cnjg(&q__2, &a[kplus1 + j * a_dim1]);
q__1.r = temp.r * q__2.r - temp.i * q__2.i, 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;
q__1.i = temp.r * q__2.i + temp.i *
q__2.r;
temp.r = q__1.r, temp.i = q__1.i; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -502,11 +464,8 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
q__2.r = q__3.r * x[i__4].r - q__3.i * x[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__2.i = q__3.r * x[i__4].i + q__3.i * x[ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
ix -= *incx; ix -= *incx;
/* L130: */ /* L130: */
@ -528,9 +487,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__4 = j * a_dim1 + 1; i__4 = j * a_dim1 + 1;
q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 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;
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; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -539,20 +496,16 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
i__1 = l + i__ + j * a_dim1; i__1 = l + i__ + j * a_dim1;
i__2 = i__; i__2 = i__;
q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[ q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
i__2].i, q__2.i = a[i__1].r * x[i__2].i + q__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
a[i__1].i * x[i__2].r; q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
/* L150: */ /* L150: */
} }
} else { } else {
if (nounit) { if (nounit) {
r_cnjg(&q__2, &a[j * a_dim1 + 1]); r_cnjg(&q__2, &a[j * a_dim1 + 1]);
q__1.r = temp.r * q__2.r - temp.i * q__2.i, 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;
q__1.i = temp.r * q__2.i + temp.i *
q__2.r;
temp.r = q__1.r, temp.i = q__1.i; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -561,11 +514,8 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__1 = i__; i__1 = i__;
q__2.r = q__3.r * x[i__1].r - q__3.i * x[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__2.i = q__3.r * x[i__1].i + q__3.i * x[ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
/* L160: */ /* L160: */
} }
@ -586,9 +536,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__4 = j * a_dim1 + 1; i__4 = j * a_dim1 + 1;
q__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 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;
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; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -597,11 +545,9 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
i__1 = l + i__ + j * a_dim1; i__1 = l + i__ + j * a_dim1;
i__2 = ix; i__2 = ix;
q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[ q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
i__2].i, q__2.i = a[i__1].r * x[i__2].i + q__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
a[i__1].i * x[i__2].r; q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
ix += *incx; ix += *incx;
/* L180: */ /* L180: */
@ -609,9 +555,7 @@
} else { } else {
if (nounit) { if (nounit) {
r_cnjg(&q__2, &a[j * a_dim1 + 1]); r_cnjg(&q__2, &a[j * a_dim1 + 1]);
q__1.r = temp.r * q__2.r - temp.i * q__2.i, 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;
q__1.i = temp.r * q__2.i + temp.i *
q__2.r;
temp.r = q__1.r, temp.i = q__1.i; temp.r = q__1.r, temp.i = q__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -620,11 +564,8 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); r_cnjg(&q__3, &a[l + i__ + j * a_dim1]);
i__1 = ix; i__1 = ix;
q__2.r = q__3.r * x[i__1].r - q__3.i * x[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__2.i = q__3.r * x[i__1].i + q__3.i * x[ q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
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; temp.r = q__1.r, temp.i = q__1.i;
ix += *incx; ix += *incx;
/* L190: */ /* L190: */
@ -644,4 +585,3 @@
/* End of CTBMV . */ /* End of CTBMV . */
} /* ctbmv_ */ } /* ctbmv_ */

6
blas/f2c/drotm.c
View File

@ -12,9 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx, /* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy,
doublereal *dy, integer *incy, doublereal *dparam) doublereal *dparam) {
{
/* Initialized data */ /* Initialized data */
static doublereal zero = 0.; static doublereal zero = 0.;
@ -212,4 +211,3 @@ L120:
L140: L140:
return 0; return 0;
} /* drotm_ */ } /* drotm_ */

18
blas/f2c/drotmg.c
View File

@ -12,9 +12,7 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal * /* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam) {
dx1, doublereal *dy1, doublereal *dparam)
{
/* Initialized data */ /* Initialized data */
static doublereal zero = 0.; static doublereal zero = 0.;
@ -67,7 +65,6 @@
/* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */ /* 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. */ /* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
/* Arguments */ /* Arguments */
/* ========= */ /* ========= */
@ -187,10 +184,14 @@ L80:
dflag = -one; dflag = -one;
L90: L90:
switch (igo) { switch (igo) {
case 0: goto L120; case 0:
case 1: goto L150; goto L120;
case 2: goto L180; case 1:
case 3: goto L210; goto L150;
case 2:
goto L180;
case 3:
goto L210;
} }
/* PROCEDURE..SCALE-CHECK */ /* PROCEDURE..SCALE-CHECK */
L100: L100:
@ -290,4 +291,3 @@ L260:
dparam[1] = dflag; dparam[1] = dflag;
return 0; return 0;
} /* drotmg_ */ } /* drotmg_ */

17
blas/f2c/dsbmv.c
View File

@ -12,10 +12,9 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int dsbmv_(char *uplo, integer *n, integer *k, doublereal * /* Subroutine */ int dsbmv_(char *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy,
doublereal *beta, doublereal *y, integer *incy, ftnlen uplo_len) ftnlen uplo_len) {
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4; integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
@ -141,7 +140,6 @@
/* Y. INCY must not be zero. */ /* Y. INCY must not be zero. */
/* Unchanged on exit. */ /* Unchanged on exit. */
/* Level 2 Blas routine. */ /* Level 2 Blas routine. */
/* -- Written on 22-October-1986. */ /* -- Written on 22-October-1986. */
@ -174,8 +172,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -255,7 +252,6 @@
return 0; return 0;
} }
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when upper triangle of A is stored. */ /* Form y when upper triangle of A is stored. */
kplus1 = *k + 1; kplus1 = *k + 1;
@ -296,8 +292,7 @@
iy += *incy; iy += *incy;
/* L70: */ /* L70: */
} }
y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
temp2;
jx += *incx; jx += *incx;
jy += *incy; jy += *incy;
if (j > *k) { if (j > *k) {
@ -308,7 +303,6 @@
} }
} }
} else { } else {
/* Form y when lower triangle of A is stored. */ /* Form y when lower triangle of A is stored. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -363,4 +357,3 @@
/* End of DSBMV . */ /* End of DSBMV . */
} /* dsbmv_ */ } /* dsbmv_ */

12
blas/f2c/dspmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int dspmv_(char *uplo, integer *n, doublereal *alpha, /* Subroutine */ int dspmv_(char *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal *x, integer *incx,
doublereal *ap, doublereal *x, integer *incx, doublereal *beta, doublereal *beta, doublereal *y, integer *incy, ftnlen uplo_len) {
doublereal *y, integer *incy, ftnlen uplo_len)
{
/* System generated locals */ /* System generated locals */
integer i__1, i__2; integer i__1, i__2;
@ -137,8 +135,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -215,7 +212,6 @@
} }
kk = 1; kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when AP contains the upper triangle. */ /* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -260,7 +256,6 @@
} }
} }
} else { } else {
/* Form y when AP contains the lower triangle. */ /* Form y when AP contains the lower triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -313,4 +308,3 @@
/* End of DSPMV . */ /* End of DSPMV . */
} /* dspmv_ */ } /* dspmv_ */

20
blas/f2c/dtbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int dtbmv_(char *uplo, char *trans, char *diag, integer *n, /* Subroutine */ int dtbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublereal *a, integer *lda,
integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *x, integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4; integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
@ -184,15 +182,12 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
"T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
ftnlen)1)) {
info = 2; info = 2;
} else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
"N", (ftnlen)1, (ftnlen)1)) {
info = 3; info = 3;
} else if (*n < 0) { } else if (*n < 0) {
info = 4; info = 4;
@ -229,7 +224,6 @@
/* accessed sequentially with one pass through A. */ /* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
/* Form x := A*x. */ /* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -328,7 +322,6 @@
} }
} }
} else { } else {
/* Form x := A'*x. */ /* Form x := A'*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -425,4 +418,3 @@
/* End of DTBMV . */ /* End of DTBMV . */
} /* dtbmv_ */ } /* dtbmv_ */

14
blas/f2c/lsame.c
View File

@ -12,15 +12,13 @@
#include "datatypes.h" #include "datatypes.h"
logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len) logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len) {
{
/* System generated locals */ /* System generated locals */
logical ret_val; logical ret_val;
/* Local variables */ /* Local variables */
integer inta, intb, zcode; integer inta, intb, zcode;
/* -- LAPACK auxiliary routine (version 3.1) -- */ /* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */ /* November 2006 */
@ -69,7 +67,6 @@ logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
intb = *(unsigned char *)cb; intb = *(unsigned char *)cb;
if (zcode == 90 || zcode == 122) { if (zcode == 90 || zcode == 122) {
/* ASCII is assumed - ZCODE is the ASCII code of either lower or */ /* ASCII is assumed - ZCODE is the ASCII code of either lower or */
/* upper case 'Z'. */ /* upper case 'Z'. */
@ -81,21 +78,17 @@ logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
} }
} else if (zcode == 233 || zcode == 169) { } else if (zcode == 233 || zcode == 169) {
/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */ /* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
/* upper case 'Z'. */ /* upper case 'Z'. */
if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta >= 162 && inta <= 169)) {
(inta >= 162 && inta <= 169)) {
inta += 64; inta += 64;
} }
if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb >= 162 && intb <= 169)) {
(intb >= 162 && intb <= 169)) {
intb += 64; intb += 64;
} }
} else if (zcode == 218 || zcode == 250) { } else if (zcode == 218 || zcode == 250) {
/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */ /* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
/* plus 128 of either lower or upper case 'Z'. */ /* plus 128 of either lower or upper case 'Z'. */
@ -114,4 +107,3 @@ logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
return ret_val; return ret_val;
} /* lsame_ */ } /* lsame_ */

6
blas/f2c/srotm.c
View File

@ -12,9 +12,7 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy, /* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam) {
integer *incy, real *sparam)
{
/* Initialized data */ /* Initialized data */
static real zero = 0.f; static real zero = 0.f;
@ -54,7 +52,6 @@
/* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */ /* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). */
/* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */ /* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */
/* Arguments */ /* Arguments */
/* ========= */ /* ========= */
@ -213,4 +210,3 @@ L120:
L140: L140:
return 0; return 0;
} /* srotm_ */ } /* srotm_ */

20
blas/f2c/srotmg.c
View File

@ -12,9 +12,7 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real /* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam) {
*sparam)
{
/* Initialized data */ /* Initialized data */
static real zero = 0.f; static real zero = 0.f;
@ -67,11 +65,9 @@
/* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */ /* 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. */ /* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
/* Arguments */ /* Arguments */
/* ========= */ /* ========= */
/* SD1 (input/output) REAL */ /* SD1 (input/output) REAL */
/* SD2 (input/output) REAL */ /* SD2 (input/output) REAL */
@ -80,7 +76,6 @@
/* SY1 (input) REAL */ /* SY1 (input) REAL */
/* SPARAM (input/output) REAL array, dimension 5 */ /* SPARAM (input/output) REAL array, dimension 5 */
/* SPARAM(1)=SFLAG */ /* SPARAM(1)=SFLAG */
/* SPARAM(2)=SH11 */ /* SPARAM(2)=SH11 */
@ -189,10 +184,14 @@ L80:
sflag = -one; sflag = -one;
L90: L90:
switch (igo) { switch (igo) {
case 0: goto L120; case 0:
case 1: goto L150; goto L120;
case 2: goto L180; case 1:
case 3: goto L210; goto L150;
case 2:
goto L180;
case 3:
goto L210;
} }
/* PROCEDURE..SCALE-CHECK */ /* PROCEDURE..SCALE-CHECK */
L100: L100:
@ -292,4 +291,3 @@ L260:
sparam[1] = sflag; sparam[1] = sflag;
return 0; return 0;
} /* srotmg_ */ } /* srotmg_ */

15
blas/f2c/ssbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha, /* Subroutine */ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x,
real *a, integer *lda, real *x, integer *incx, real *beta, real *y, integer *incx, real *beta, real *y, integer *incy, ftnlen uplo_len) {
integer *incy, ftnlen uplo_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4; integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
@ -176,8 +174,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -257,7 +254,6 @@
return 0; return 0;
} }
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when upper triangle of A is stored. */ /* Form y when upper triangle of A is stored. */
kplus1 = *k + 1; kplus1 = *k + 1;
@ -298,8 +294,7 @@
iy += *incy; iy += *incy;
/* L70: */ /* L70: */
} }
y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * y[jy] = y[jy] + temp1 * a[kplus1 + j * a_dim1] + *alpha * temp2;
temp2;
jx += *incx; jx += *incx;
jy += *incy; jy += *incy;
if (j > *k) { if (j > *k) {
@ -310,7 +305,6 @@
} }
} }
} else { } else {
/* Form y when lower triangle of A is stored. */ /* Form y when lower triangle of A is stored. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -365,4 +359,3 @@
/* End of SSBMV . */ /* End of SSBMV . */
} /* ssbmv_ */ } /* ssbmv_ */

12
blas/f2c/sspmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int sspmv_(char *uplo, integer *n, real *alpha, real *ap, /* Subroutine */ int sspmv_(char *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx, real *beta, real *y,
real *x, integer *incx, real *beta, real *y, integer *incy, ftnlen integer *incy, ftnlen uplo_len) {
uplo_len)
{
/* System generated locals */ /* System generated locals */
integer i__1, i__2; integer i__1, i__2;
@ -137,8 +135,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -215,7 +212,6 @@
} }
kk = 1; kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when AP contains the upper triangle. */ /* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -260,7 +256,6 @@
} }
} }
} else { } else {
/* Form y when AP contains the lower triangle. */ /* Form y when AP contains the lower triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
@ -313,4 +308,3 @@
/* End of SSPMV . */ /* End of SSPMV . */
} /* sspmv_ */ } /* sspmv_ */

20
blas/f2c/stbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int stbmv_(char *uplo, char *trans, char *diag, integer *n, /* Subroutine */ int stbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, integer *lda, real *x,
integer *k, real *a, integer *lda, real *x, integer *incx, ftnlen integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
uplo_len, ftnlen trans_len, ftnlen diag_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4; integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
@ -184,15 +182,12 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
"T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
ftnlen)1)) {
info = 2; info = 2;
} else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
"N", (ftnlen)1, (ftnlen)1)) {
info = 3; info = 3;
} else if (*n < 0) { } else if (*n < 0) {
info = 4; info = 4;
@ -229,7 +224,6 @@
/* accessed sequentially with one pass through A. */ /* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
/* Form x := A*x. */ /* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -328,7 +322,6 @@
} }
} }
} else { } else {
/* Form x := A'*x. */ /* Form x := A'*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -425,4 +418,3 @@
/* End of STBMV . */ /* End of STBMV . */
} /* stbmv_ */ } /* stbmv_ */

77
blas/f2c/zhbmv.c
View File

@ -12,11 +12,9 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex /* Subroutine */ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
*alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer * doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy,
incx, doublecomplex *beta, doublecomplex *y, integer *incy, ftnlen ftnlen uplo_len) {
uplo_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1; doublereal d__1;
@ -184,8 +182,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -205,8 +202,7 @@
/* Quick return if possible. */ /* Quick return if possible. */
if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
beta->i == 0.))) {
return 0; return 0;
} }
@ -242,9 +238,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
z__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
/* L20: */ /* L20: */
} }
@ -264,9 +258,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = iy; i__2 = iy;
i__3 = iy; i__3 = iy;
z__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
iy += *incy; iy += *incy;
/* L40: */ /* L40: */
@ -278,7 +270,6 @@
return 0; return 0;
} }
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when upper triangle of A is stored. */ /* Form y when upper triangle of A is stored. */
kplus1 = *k + 1; kplus1 = *k + 1;
@ -286,8 +277,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
l = kplus1 - j; l = kplus1 - j;
@ -298,15 +288,12 @@
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__2 = i__; i__2 = i__;
z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i, z__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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
/* L50: */ /* L50: */
@ -317,8 +304,7 @@
d__1 = a[i__3].r; d__1 = a[i__3].r;
z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i; 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__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 = z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__4].r = z__1.r, y[i__4].i = z__1.i;
/* L60: */ /* L60: */
@ -329,8 +315,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__4 = jx; i__4 = jx;
z__1.r = alpha->r * x[i__4].r - alpha->i * x[i__4].i, z__1.i = 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;
alpha->r * x[i__4].i + alpha->i * x[i__4].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
ix = kx; ix = kx;
@ -343,15 +328,12 @@
i__4 = iy; i__4 = iy;
i__2 = iy; i__2 = iy;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = z__1.r, y[i__4].i = z__1.i;
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
ix += *incx; ix += *incx;
@ -364,8 +346,7 @@
d__1 = a[i__2].r; d__1 = a[i__2].r;
z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i; 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__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 = z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
jx += *incx; jx += *incx;
@ -378,15 +359,13 @@
} }
} }
} else { } else {
/* Form y when lower triangle of A is stored. */ /* Form y when lower triangle of A is stored. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__3 = j; i__3 = j;
z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i = 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;
alpha->r * x[i__3].i + alpha->i * x[i__3].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
i__3 = j; i__3 = j;
@ -404,23 +383,19 @@
i__4 = i__; i__4 = i__;
i__2 = i__; i__2 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = z__1.r, y[i__4].i = z__1.i;
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__4 = i__; i__4 = i__;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
/* L90: */ /* L90: */
} }
i__3 = j; i__3 = j;
i__4 = j; i__4 = j;
z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
/* L100: */ /* L100: */
@ -431,8 +406,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__3 = jx; i__3 = jx;
z__1.r = alpha->r * x[i__3].r - alpha->i * x[i__3].i, z__1.i = 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;
alpha->r * x[i__3].i + alpha->i * x[i__3].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
i__3 = jy; i__3 = jy;
@ -454,23 +428,19 @@
i__4 = iy; i__4 = iy;
i__2 = iy; i__2 = iy;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 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__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; 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; y[i__4].r = z__1.r, y[i__4].i = z__1.i;
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
/* L110: */ /* L110: */
} }
i__3 = jy; i__3 = jy;
i__4 = jy; i__4 = jy;
z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
jx += *incx; jx += *incx;
@ -485,4 +455,3 @@
/* End of ZHBMV . */ /* End of ZHBMV . */
} /* zhbmv_ */ } /* zhbmv_ */

75
blas/f2c/zhpmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha, /* Subroutine */ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doublecomplex *x,
doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex * integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy, ftnlen uplo_len) {
beta, doublecomplex *y, integer *incy, ftnlen uplo_len)
{
/* System generated locals */ /* System generated locals */
integer i__1, i__2, i__3, i__4, i__5; integer i__1, i__2, i__3, i__4, i__5;
doublereal d__1; doublereal d__1;
@ -146,8 +144,7 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (*n < 0) { } else if (*n < 0) {
info = 2; info = 2;
@ -163,8 +160,7 @@
/* Quick return if possible. */ /* Quick return if possible. */
if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
beta->i == 0.))) {
return 0; return 0;
} }
@ -200,9 +196,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
z__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
/* L20: */ /* L20: */
} }
@ -222,9 +216,7 @@
for (i__ = 1; i__ <= i__1; ++i__) { for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = iy; i__2 = iy;
i__3 = iy; i__3 = iy;
z__1.r = beta->r * y[i__3].r - beta->i * y[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;
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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
iy += *incy; iy += *incy;
/* L40: */ /* L40: */
@ -237,15 +229,13 @@
} }
kk = 1; kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
/* Form y when AP contains the upper triangle. */ /* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
k = kk; k = kk;
@ -254,15 +244,12 @@
i__3 = i__; i__3 = i__;
i__4 = i__; i__4 = i__;
i__5 = k; i__5 = k;
z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
d_cnjg(&z__3, &ap[k]); d_cnjg(&z__3, &ap[k]);
i__3 = i__; i__3 = i__;
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
++k; ++k;
@ -274,8 +261,7 @@
d__1 = ap[i__4].r; d__1 = ap[i__4].r;
z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i; 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__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 = z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
kk += j; kk += j;
@ -287,8 +273,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = jx; i__2 = jx;
z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
ix = kx; ix = kx;
@ -298,15 +283,12 @@
i__3 = iy; i__3 = iy;
i__4 = iy; i__4 = iy;
i__5 = k; i__5 = k;
z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
d_cnjg(&z__3, &ap[k]); d_cnjg(&z__3, &ap[k]);
i__3 = ix; i__3 = ix;
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
ix += *incx; ix += *incx;
@ -319,8 +301,7 @@
d__1 = ap[i__4].r; d__1 = ap[i__4].r;
z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i; 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__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 = z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
jx += *incx; jx += *incx;
@ -330,15 +311,13 @@
} }
} }
} else { } else {
/* Form y when AP contains the lower triangle. */ /* Form y when AP contains the lower triangle. */
if (*incx == 1 && *incy == 1) { if (*incx == 1 && *incy == 1) {
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = j; i__2 = j;
z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
i__2 = j; i__2 = j;
@ -354,15 +333,12 @@
i__3 = i__; i__3 = i__;
i__4 = i__; i__4 = i__;
i__5 = k; i__5 = k;
z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
d_cnjg(&z__3, &ap[k]); d_cnjg(&z__3, &ap[k]);
i__3 = i__; i__3 = i__;
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
++k; ++k;
@ -370,8 +346,7 @@
} }
i__2 = j; i__2 = j;
i__3 = j; i__3 = j;
z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
kk += *n - j + 1; kk += *n - j + 1;
@ -383,8 +358,7 @@
i__1 = *n; i__1 = *n;
for (j = 1; j <= i__1; ++j) { for (j = 1; j <= i__1; ++j) {
i__2 = jx; i__2 = jx;
z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i = 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;
alpha->r * x[i__2].i + alpha->i * x[i__2].r;
temp1.r = z__1.r, temp1.i = z__1.i; temp1.r = z__1.r, temp1.i = z__1.i;
temp2.r = 0., temp2.i = 0.; temp2.r = 0., temp2.i = 0.;
i__2 = jy; i__2 = jy;
@ -403,23 +377,19 @@
i__3 = iy; i__3 = iy;
i__4 = iy; i__4 = iy;
i__5 = k; i__5 = k;
z__2.r = temp1.r * ap[i__5].r - temp1.i * ap[i__5].i, 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__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; 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; y[i__3].r = z__1.r, y[i__3].i = z__1.i;
d_cnjg(&z__3, &ap[k]); d_cnjg(&z__3, &ap[k]);
i__3 = ix; i__3 = ix;
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.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__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; 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; temp2.r = z__1.r, temp2.i = z__1.i;
/* L110: */ /* L110: */
} }
i__2 = jy; i__2 = jy;
i__3 = jy; i__3 = jy;
z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = alpha->r * temp2.i + alpha->i * temp2.r;
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; 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; y[i__2].r = z__1.r, y[i__2].i = z__1.i;
jx += *incx; jx += *incx;
@ -435,4 +405,3 @@
/* End of ZHPMV . */ /* End of ZHPMV . */
} /* zhpmv_ */ } /* zhpmv_ */

160
blas/f2c/ztbmv.c
View File

@ -12,10 +12,8 @@
#include "datatypes.h" #include "datatypes.h"
/* Subroutine */ int ztbmv_(char *uplo, char *trans, char *diag, integer *n, /* Subroutine */ int ztbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublecomplex *a, integer *lda,
integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer doublecomplex *x, integer *incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len) {
*incx, ftnlen uplo_len, ftnlen trans_len, ftnlen diag_len)
{
/* System generated locals */ /* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
doublecomplex z__1, z__2, z__3; doublecomplex z__1, z__2, z__3;
@ -188,15 +186,12 @@
/* Function Body */ /* Function Body */
info = 0; info = 0;
if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
ftnlen)1, (ftnlen)1)) {
info = 1; info = 1;
} else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, } else if (!lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && !lsame_(trans, "T", (ftnlen)1, (ftnlen)1) &&
"T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( !lsame_(trans, "C", (ftnlen)1, (ftnlen)1)) {
ftnlen)1)) {
info = 2; info = 2;
} else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, } else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
"N", (ftnlen)1, (ftnlen)1)) {
info = 3; info = 3;
} else if (*n < 0) { } else if (*n < 0) {
info = 4; info = 4;
@ -234,7 +229,6 @@
/* accessed sequentially with one pass through A. */ /* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
/* Form x := A*x. */ /* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -254,11 +248,8 @@
i__2 = i__; i__2 = i__;
i__3 = i__; i__3 = i__;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 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__2.i = temp.r * a[i__5].i + temp.i * a[ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + z__2.i;
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; x[i__2].r = z__1.r, x[i__2].i = z__1.i;
/* L10: */ /* L10: */
} }
@ -266,9 +257,8 @@
i__4 = j; i__4 = j;
i__2 = j; i__2 = j;
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[ z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[i__3].i,
i__3].i, z__1.i = x[i__2].r * 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__2].i * a[i__3].r;
x[i__4].r = z__1.r, x[i__4].i = z__1.i; x[i__4].r = z__1.r, x[i__4].i = z__1.i;
} }
} }
@ -291,11 +281,8 @@
i__4 = ix; i__4 = ix;
i__2 = ix; i__2 = ix;
i__5 = l + i__ + j * a_dim1; i__5 = l + i__ + j * a_dim1;
z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 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__2.i = temp.r * a[i__5].i + temp.i * a[ z__1.r = x[i__2].r + z__2.r, z__1.i = x[i__2].i + z__2.i;
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; x[i__4].r = z__1.r, x[i__4].i = z__1.i;
ix += *incx; ix += *incx;
/* L30: */ /* L30: */
@ -304,9 +291,8 @@
i__3 = jx; i__3 = jx;
i__4 = jx; i__4 = jx;
i__2 = kplus1 + j * a_dim1; i__2 = kplus1 + j * a_dim1;
z__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[ z__1.r = x[i__4].r * a[i__2].r - x[i__4].i * a[i__2].i,
i__2].i, z__1.i = x[i__4].r * 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__4].i * a[i__2].r;
x[i__3].r = z__1.r, x[i__3].i = z__1.i; x[i__3].r = z__1.r, x[i__3].i = z__1.i;
} }
} }
@ -332,11 +318,8 @@
i__1 = i__; i__1 = i__;
i__3 = i__; i__3 = i__;
i__2 = l + i__ + j * a_dim1; i__2 = l + i__ + j * a_dim1;
z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 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__2.i = temp.r * a[i__2].i + temp.i * a[ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + z__2.i;
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; x[i__1].r = z__1.r, x[i__1].i = z__1.i;
/* L50: */ /* L50: */
} }
@ -344,9 +327,8 @@
i__4 = j; i__4 = j;
i__1 = j; i__1 = j;
i__3 = j * a_dim1 + 1; i__3 = j * a_dim1 + 1;
z__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[ z__1.r = x[i__1].r * a[i__3].r - x[i__1].i * a[i__3].i,
i__3].i, z__1.i = x[i__1].r * 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__1].i * a[i__3].r;
x[i__4].r = z__1.r, x[i__4].i = z__1.i; x[i__4].r = z__1.r, x[i__4].i = z__1.i;
} }
} }
@ -369,11 +351,8 @@
i__4 = ix; i__4 = ix;
i__1 = ix; i__1 = ix;
i__2 = l + i__ + j * a_dim1; i__2 = l + i__ + j * a_dim1;
z__2.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 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__2.i = temp.r * a[i__2].i + temp.i * a[ z__1.r = x[i__1].r + z__2.r, z__1.i = x[i__1].i + z__2.i;
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; x[i__4].r = z__1.r, x[i__4].i = z__1.i;
ix -= *incx; ix -= *incx;
/* L70: */ /* L70: */
@ -382,9 +361,8 @@
i__3 = jx; i__3 = jx;
i__4 = jx; i__4 = jx;
i__1 = j * a_dim1 + 1; i__1 = j * a_dim1 + 1;
z__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[ z__1.r = x[i__4].r * a[i__1].r - x[i__4].i * a[i__1].i,
i__1].i, z__1.i = x[i__4].r * 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__4].i * a[i__1].r;
x[i__3].r = z__1.r, x[i__3].i = z__1.i; x[i__3].r = z__1.r, x[i__3].i = z__1.i;
} }
} }
@ -397,7 +375,6 @@
} }
} }
} else { } else {
/* Form x := A'*x or x := conjg( A' )*x. */ /* Form x := A'*x or x := conjg( A' )*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
@ -410,9 +387,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 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;
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; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -421,20 +396,16 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
i__4 = l + i__ + j * a_dim1; i__4 = l + i__ + j * a_dim1;
i__1 = i__; i__1 = i__;
z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[ z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
i__1].i, z__2.i = a[i__4].r * x[i__1].i + z__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
a[i__4].i * x[i__1].r; z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
/* L90: */ /* L90: */
} }
} else { } else {
if (nounit) { if (nounit) {
d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
z__1.r = temp.r * z__2.r - temp.i * z__2.i, 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;
z__1.i = temp.r * z__2.i + temp.i *
z__2.r;
temp.r = z__1.r, temp.i = z__1.i; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -443,11 +414,8 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__4 = i__; i__4 = i__;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[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__2.i = z__3.r * x[i__4].i + z__3.i * x[ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
/* L100: */ /* L100: */
} }
@ -468,9 +436,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__3 = kplus1 + j * a_dim1; i__3 = kplus1 + j * a_dim1;
z__1.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 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;
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; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -479,11 +445,9 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
i__4 = l + i__ + j * a_dim1; i__4 = l + i__ + j * a_dim1;
i__1 = ix; i__1 = ix;
z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[ z__2.r = a[i__4].r * x[i__1].r - a[i__4].i * x[i__1].i,
i__1].i, z__2.i = a[i__4].r * x[i__1].i + z__2.i = a[i__4].r * x[i__1].i + a[i__4].i * x[i__1].r;
a[i__4].i * x[i__1].r; z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
ix -= *incx; ix -= *incx;
/* L120: */ /* L120: */
@ -491,9 +455,7 @@
} else { } else {
if (nounit) { if (nounit) {
d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); d_cnjg(&z__2, &a[kplus1 + j * a_dim1]);
z__1.r = temp.r * z__2.r - temp.i * z__2.i, 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;
z__1.i = temp.r * z__2.i + temp.i *
z__2.r;
temp.r = z__1.r, temp.i = z__1.i; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MAX */ /* Computing MAX */
@ -502,11 +464,8 @@
for (i__ = j - 1; i__ >= i__3; --i__) { for (i__ = j - 1; i__ >= i__3; --i__) {
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__4 = ix; i__4 = ix;
z__2.r = z__3.r * x[i__4].r - z__3.i * x[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__2.i = z__3.r * x[i__4].i + z__3.i * x[ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
ix -= *incx; ix -= *incx;
/* L130: */ /* L130: */
@ -528,9 +487,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__4 = j * a_dim1 + 1; i__4 = j * a_dim1 + 1;
z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 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;
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; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -539,20 +496,16 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
i__1 = l + i__ + j * a_dim1; i__1 = l + i__ + j * a_dim1;
i__2 = i__; i__2 = i__;
z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
i__2].i, z__2.i = a[i__1].r * x[i__2].i + z__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
a[i__1].i * x[i__2].r; z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
/* L150: */ /* L150: */
} }
} else { } else {
if (nounit) { if (nounit) {
d_cnjg(&z__2, &a[j * a_dim1 + 1]); d_cnjg(&z__2, &a[j * a_dim1 + 1]);
z__1.r = temp.r * z__2.r - temp.i * z__2.i, 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;
z__1.i = temp.r * z__2.i + temp.i *
z__2.r;
temp.r = z__1.r, temp.i = z__1.i; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -561,11 +514,8 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__1 = i__; i__1 = i__;
z__2.r = z__3.r * x[i__1].r - z__3.i * x[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__2.i = z__3.r * x[i__1].i + z__3.i * x[ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
/* L160: */ /* L160: */
} }
@ -586,9 +536,7 @@
if (noconj) { if (noconj) {
if (nounit) { if (nounit) {
i__4 = j * a_dim1 + 1; i__4 = j * a_dim1 + 1;
z__1.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 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;
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; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -597,11 +545,9 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
i__1 = l + i__ + j * a_dim1; i__1 = l + i__ + j * a_dim1;
i__2 = ix; i__2 = ix;
z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[i__2].i,
i__2].i, z__2.i = a[i__1].r * x[i__2].i + z__2.i = a[i__1].r * x[i__2].i + a[i__1].i * x[i__2].r;
a[i__1].i * x[i__2].r; z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
ix += *incx; ix += *incx;
/* L180: */ /* L180: */
@ -609,9 +555,7 @@
} else { } else {
if (nounit) { if (nounit) {
d_cnjg(&z__2, &a[j * a_dim1 + 1]); d_cnjg(&z__2, &a[j * a_dim1 + 1]);
z__1.r = temp.r * z__2.r - temp.i * z__2.i, 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;
z__1.i = temp.r * z__2.i + temp.i *
z__2.r;
temp.r = z__1.r, temp.i = z__1.i; temp.r = z__1.r, temp.i = z__1.i;
} }
/* Computing MIN */ /* Computing MIN */
@ -620,11 +564,8 @@
for (i__ = j + 1; i__ <= i__4; ++i__) { for (i__ = j + 1; i__ <= i__4; ++i__) {
d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); d_cnjg(&z__3, &a[l + i__ + j * a_dim1]);
i__1 = ix; i__1 = ix;
z__2.r = z__3.r * x[i__1].r - z__3.i * x[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__2.i = z__3.r * x[i__1].i + z__3.i * x[ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
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; temp.r = z__1.r, temp.i = z__1.i;
ix += *incx; ix += *incx;
/* L190: */ /* L190: */
@ -644,4 +585,3 @@
/* End of ZTBMV . */ /* End of ZTBMV . */
} /* ztbmv_ */ } /* ztbmv_ */

53
lapack/cholesky.inc
View File

@ -11,14 +11,15 @@
#include <Eigen/Cholesky> #include <Eigen/Cholesky>
// POTRF computes the Cholesky factorization of a real symmetric positive definite matrix A. // 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; *info = 0;
if(UPLO(*uplo)==INVALID) *info = -1; if (UPLO(*uplo) == INVALID)
else if(*n<0) *info = -2; *info = -1;
else if(*lda<std::max(1,*n)) *info = -4; else if (*n < 0)
if(*info!=0) *info = -2;
{ else if (*lda < std::max(1, *n))
*info = -4;
if (*info != 0) {
int e = -*info; int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "POTRF", &e, 6); return xerbla_(SCALAR_SUFFIX_UP "POTRF", &e, 6);
} }
@ -26,11 +27,12 @@ EIGEN_LAPACK_FUNC(potrf,(char* uplo, int *n, RealScalar *pa, int *lda, int *info
Scalar *a = reinterpret_cast<Scalar *>(pa); Scalar *a = reinterpret_cast<Scalar *>(pa);
MatrixType A(a, *n, *n, *lda); MatrixType A(a, *n, *n, *lda);
int ret; int ret;
if(UPLO(*uplo)==UP) ret = int(internal::llt_inplace<Scalar, Upper>::blocked(A)); if (UPLO(*uplo) == UP)
else ret = int(internal::llt_inplace<Scalar, Lower>::blocked(A)); ret = int(internal::llt_inplace<Scalar, Upper>::blocked(A));
else
ret = int(internal::llt_inplace<Scalar, Lower>::blocked(A));
if(ret>=0) if (ret >= 0) *info = ret + 1;
*info = ret+1;
return 0; return 0;
} }
@ -38,16 +40,20 @@ EIGEN_LAPACK_FUNC(potrf,(char* uplo, int *n, RealScalar *pa, int *lda, int *info
// POTRS solves a system of linear equations A*X = B with a symmetric // POTRS solves a system of linear equations A*X = B with a symmetric
// positive definite matrix A using the Cholesky factorization // positive definite matrix A using the Cholesky factorization
// A = U**T*U or A = L*L**T computed by DPOTRF. // 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; *info = 0;
if(UPLO(*uplo)==INVALID) *info = -1; if (UPLO(*uplo) == INVALID)
else if(*n<0) *info = -2; *info = -1;
else if(*nrhs<0) *info = -3; else if (*n < 0)
else if(*lda<std::max(1,*n)) *info = -5; *info = -2;
else if(*ldb<std::max(1,*n)) *info = -7; else if (*nrhs < 0)
if(*info!=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; int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "POTRS", &e, 6); return xerbla_(SCALAR_SUFFIX_UP "POTRS", &e, 6);
} }
@ -57,13 +63,10 @@ EIGEN_LAPACK_FUNC(potrs,(char* uplo, int *n, int *nrhs, RealScalar *pa, int *lda
MatrixType A(a, *n, *n, *lda); MatrixType A(a, *n, *n, *lda);
MatrixType B(b, *n, *nrhs, *ldb); MatrixType B(b, *n, *nrhs, *ldb);
if(UPLO(*uplo)==UP) if (UPLO(*uplo) == UP) {
{
A.triangularView<Upper>().adjoint().solveInPlace(B); A.triangularView<Upper>().adjoint().solveInPlace(B);
A.triangularView<Upper>().solveInPlace(B); A.triangularView<Upper>().solveInPlace(B);
} } else {
else
{
A.triangularView<Lower>().solveInPlace(B); A.triangularView<Lower>().solveInPlace(B);
A.triangularView<Lower>().adjoint().solveInPlace(B); A.triangularView<Lower>().adjoint().solveInPlace(B);
} }

43
lapack/eigenvalues.inc
View File

@ -11,52 +11,53 @@
#include <Eigen/Eigenvalues> #include <Eigen/Eigenvalues>
// computes eigen values and vectors of a general N-by-N matrix A // 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 // TODO exploit the work buffer
bool query_size = *lwork == -1; bool query_size = *lwork == -1;
*info = 0; *info = 0;
if(*jobz!='N' && *jobz!='V') *info = -1; if (*jobz != 'N' && *jobz != 'V')
else if(UPLO(*uplo)==INVALID) *info = -2; *info = -1;
else if(*n<0) *info = -3; else if (UPLO(*uplo) == INVALID)
else if(*lda<std::max(1,*n)) *info = -5; *info = -2;
else if((!query_size) && *lwork<std::max(1,3**n-1)) *info = -8; 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 (*info != 0) {
{
int e = -*info; 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; *lwork = 0;
return 0; return 0;
} }
if(*n==0) if (*n == 0) return 0;
return 0;
PlainMatrixType mat(*n, *n); PlainMatrixType mat(*n, *n);
if(UPLO(*uplo)==UP) mat = matrix(a,*n,*n,*lda).adjoint(); if (UPLO(*uplo) == UP)
else mat = matrix(a,*n,*n,*lda); mat = matrix(a, *n, *n, *lda).adjoint();
else
mat = matrix(a, *n, *n, *lda);
bool computeVectors = *jobz == 'V' || *jobz == 'v'; bool computeVectors = *jobz == 'V' || *jobz == 'v';
SelfAdjointEigenSolver<PlainMatrixType> eig(mat, computeVectors ? ComputeEigenvectors : EigenvaluesOnly); SelfAdjointEigenSolver<PlainMatrixType> eig(mat, computeVectors ? ComputeEigenvectors : EigenvaluesOnly);
if(eig.info()==NoConvergence) if (eig.info() == NoConvergence) {
{
make_vector(w, *n).setZero(); make_vector(w, *n).setZero();
if(computeVectors) if (computeVectors) matrix(a, *n, *n, *lda).setIdentity();
matrix(a,*n,*n,*lda).setIdentity();
//*info = 1; //*info = 1;
return 0; return 0;
} }
make_vector(w, *n) = eig.eigenvalues(); make_vector(w, *n) = eig.eigenvalues();
if(computeVectors) if (computeVectors) matrix(a, *n, *n, *lda) = eig.eigenvectors();
matrix(a,*n,*n,*lda) = eig.eigenvectors();
return 0; return 0;
} }

67
lapack/lu.inc
View File

@ -11,31 +11,29 @@
#include <Eigen/LU> #include <Eigen/LU>
// computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges // 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; *info = 0;
if(*m<0) *info = -1; if (*m < 0)
else if(*n<0) *info = -2; *info = -1;
else if(*lda<std::max(1,*m)) *info = -4; else if (*n < 0)
if(*info!=0) *info = -2;
{ else if (*lda < std::max(1, *m))
*info = -4;
if (*info != 0) {
int e = -*info; int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GETRF", &e, 6); return xerbla_(SCALAR_SUFFIX_UP "GETRF", &e, 6);
} }
if(*m==0 || *n==0) if (*m == 0 || *n == 0) return 0;
return 0;
Scalar *a = reinterpret_cast<Scalar *>(pa); Scalar *a = reinterpret_cast<Scalar *>(pa);
int nb_transpositions; int nb_transpositions;
int ret = int(Eigen::internal::partial_lu_impl<Scalar,ColMajor,int> int ret = int(
::blocked_lu(*m, *n, a, *lda, ipiv, nb_transpositions)); 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) for (int i = 0; i < std::min(*m, *n); ++i) ipiv[i]++;
ipiv[i]++;
if(ret>=0) if (ret >= 0) *info = ret + 1;
*info = ret+1;
return 0; return 0;
} }
@ -43,16 +41,20 @@ EIGEN_LAPACK_FUNC(getrf,(int *m, int *n, RealScalar *pa, int *lda, int *ipiv, in
// GETRS solves a system of linear equations // GETRS solves a system of linear equations
// A * X = B or A' * X = B // A * X = B or A' * X = B
// with a general N-by-N matrix A using the LU factorization computed by GETRF // 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)) EIGEN_LAPACK_FUNC(getrs, (char *trans, int *n, int *nrhs, RealScalar *pa, int *lda, int *ipiv, RealScalar *pb, int *ldb,
{ int *info)) {
*info = 0; *info = 0;
if(OP(*trans)==INVALID) *info = -1; if (OP(*trans) == INVALID)
else if(*n<0) *info = -2; *info = -1;
else if(*nrhs<0) *info = -3; else if (*n < 0)
else if(*lda<std::max(1,*n)) *info = -5; *info = -2;
else if(*ldb<std::max(1,*n)) *info = -8; else if (*nrhs < 0)
if(*info!=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; int e = -*info;
return xerbla_(SCALAR_SUFFIX_UP "GETRS", &e, 6); return xerbla_(SCALAR_SUFFIX_UP "GETRS", &e, 6);
} }
@ -62,28 +64,21 @@ EIGEN_LAPACK_FUNC(getrs,(char *trans, int *n, int *nrhs, RealScalar *pa, int *ld
MatrixType lu(a, *n, *n, *lda); MatrixType lu(a, *n, *n, *lda);
MatrixType B(b, *n, *nrhs, *ldb); MatrixType B(b, *n, *nrhs, *ldb);
for(int i=0; i<*n; ++i) for (int i = 0; i < *n; ++i) ipiv[i]--;
ipiv[i]--; if (OP(*trans) == NOTR) {
if(OP(*trans)==NOTR)
{
B = PivotsType(ipiv, *n) * B; B = PivotsType(ipiv, *n) * B;
lu.triangularView<UnitLower>().solveInPlace(B); lu.triangularView<UnitLower>().solveInPlace(B);
lu.triangularView<Upper>().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<Upper>().transpose().solveInPlace(B);
lu.triangularView<UnitLower>().transpose().solveInPlace(B); lu.triangularView<UnitLower>().transpose().solveInPlace(B);
B = PivotsType(ipiv, *n).transpose() * B; B = PivotsType(ipiv, *n).transpose() * B;
} } else if (OP(*trans) == ADJ) {
else if(OP(*trans)==ADJ)
{
lu.triangularView<Upper>().adjoint().solveInPlace(B); lu.triangularView<Upper>().adjoint().solveInPlace(B);
lu.triangularView<UnitLower>().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) for (int i = 0; i < *n; ++i) ipiv[i]++;
ipiv[i]++;
return 0; return 0;
} }

119
lapack/svd.inc
View File

@ -11,39 +11,41 @@
#include <Eigen/SVD> #include <Eigen/SVD>
// computes the singular values/vectors a general M-by-N matrix A using divide-and-conquer // 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_FUNC(gesdd, (char *jobz, int *m, int *n, Scalar *a, int *lda, RealScalar *s, Scalar *u, int *ldu,
EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int * /*iwork*/, int *info)) Scalar *vt, int *ldvt, Scalar * /*work*/, int *lwork,
{ EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar * /*rwork*/) int * /*iwork*/, int *info)) {
// TODO exploit the work buffer // TODO exploit the work buffer
bool query_size = *lwork == -1; bool query_size = *lwork == -1;
int diag_size = (std::min)(*m, *n); int diag_size = (std::min)(*m, *n);
*info = 0; *info = 0;
if(*jobz!='A' && *jobz!='S' && *jobz!='O' && *jobz!='N') *info = -1; if (*jobz != 'A' && *jobz != 'S' && *jobz != 'O' && *jobz != 'N')
else if(*m<0) *info = -2; *info = -1;
else if(*n<0) *info = -3; else if (*m < 0)
else if(*lda<std::max(1,*m)) *info = -5; *info = -2;
else if(*lda<std::max(1,*m)) *info = -8; else if (*n < 0)
else if(*ldu <1 || (*jobz=='A' && *ldu <*m) *info = -3;
|| (*jobz=='O' && *m<*n && *ldu<*m)) *info = -8; else if (*lda < std::max(1, *m))
else if(*ldvt<1 || (*jobz=='A' && *ldvt<*n) *info = -5;
|| (*jobz=='S' && *ldvt<diag_size) else if (*lda < std::max(1, *m))
|| (*jobz=='O' && *m>=*n && *ldvt<*n)) *info = -10; *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 (*info != 0) {
{
int e = -*info; 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; *lwork = 0;
return 0; return 0;
} }
if(*n==0 || *m==0) if (*n == 0 || *m == 0) return 0;
return 0;
PlainMatrixType mat(*m, *n); PlainMatrixType mat(*m, *n);
mat = matrix(a, *m, *n, *lda); mat = matrix(a, *m, *n, *lda);
@ -57,23 +59,16 @@ EIGEN_LAPACK_FUNC(gesdd,(char *jobz, int *m, int* n, Scalar* a, int *lda, RealSc
make_vector(s, diag_size) = svd.singularValues().head(diag_size); make_vector(s, diag_size) = svd.singularValues().head(diag_size);
if(*jobz=='A') if (*jobz == 'A') {
{
matrix(u, *m, *m, *ldu) = svd.matrixU(); matrix(u, *m, *m, *ldu) = svd.matrixU();
matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint(); matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
} } else if (*jobz == 'S') {
else if(*jobz=='S')
{
matrix(u, *m, diag_size, *ldu) = svd.matrixU(); matrix(u, *m, diag_size, *ldu) = svd.matrixU();
matrix(vt, diag_size, *n, *ldvt) = svd.matrixV().adjoint(); matrix(vt, diag_size, *n, *ldvt) = svd.matrixV().adjoint();
} } else if (*jobz == 'O' && *m >= *n) {
else if(*jobz=='O' && *m>=*n)
{
matrix(a, *m, *n, *lda) = svd.matrixU(); matrix(a, *m, *n, *lda) = svd.matrixU();
matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint(); matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
} } else if (*jobz == 'O') {
else if(*jobz=='O')
{
matrix(u, *m, *m, *ldu) = svd.matrixU(); matrix(u, *m, *m, *ldu) = svd.matrixU();
matrix(a, diag_size, *n, *lda) = svd.matrixV().adjoint(); matrix(a, diag_size, *n, *lda) = svd.matrixV().adjoint();
} }
@ -82,57 +77,69 @@ EIGEN_LAPACK_FUNC(gesdd,(char *jobz, int *m, int* n, Scalar* a, int *lda, RealSc
} }
// computes the singular values/vectors a general M-by-N matrix A using two sided jacobi algorithm // 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_FUNC(gesvd, (char *jobu, char *jobv, int *m, int *n, Scalar *a, int *lda, RealScalar *s, Scalar *u,
EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar */*rwork*/) int *info)) int *ldu, Scalar *vt, int *ldvt, Scalar * /*work*/, int *lwork,
{ EIGEN_LAPACK_ARG_IF_COMPLEX(RealScalar * /*rwork*/) int *info)) {
// TODO exploit the work buffer // TODO exploit the work buffer
bool query_size = *lwork == -1; bool query_size = *lwork == -1;
int diag_size = (std::min)(*m, *n); int diag_size = (std::min)(*m, *n);
*info = 0; *info = 0;
if( *jobu!='A' && *jobu!='S' && *jobu!='O' && *jobu!='N') *info = -1; if (*jobu != 'A' && *jobu != 'S' && *jobu != 'O' && *jobu != 'N')
else if((*jobv!='A' && *jobv!='S' && *jobv!='O' && *jobv!='N') *info = -1;
|| (*jobu=='O' && *jobv=='O')) *info = -2; else if ((*jobv != 'A' && *jobv != 'S' && *jobv != 'O' && *jobv != 'N') || (*jobu == 'O' && *jobv == 'O'))
else if(*m<0) *info = -3; *info = -2;
else if(*n<0) *info = -4; else if (*m < 0)
else if(*lda<std::max(1,*m)) *info = -6; *info = -3;
else if(*ldu <1 || ((*jobu=='A' || *jobu=='S') && *ldu<*m)) *info = -9; else if (*n < 0)
else if(*ldvt<1 || (*jobv=='A' && *ldvt<*n) *info = -4;
|| (*jobv=='S' && *ldvt<diag_size)) *info = -11; 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 (*info != 0) {
{
int e = -*info; 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; *lwork = 0;
return 0; return 0;
} }
if(*n==0 || *m==0) if (*n == 0 || *m == 0) return 0;
return 0;
PlainMatrixType mat(*m, *n); PlainMatrixType mat(*m, *n);
mat = matrix(a, *m, *n, *lda); mat = matrix(a, *m, *n, *lda);
int option = (*jobu=='A' ? ComputeFullU : *jobu=='S' || *jobu=='O' ? ComputeThinU : 0) int option = (*jobu == 'A' ? ComputeFullU
| (*jobv=='A' ? ComputeFullV : *jobv=='S' || *jobv=='O' ? ComputeThinV : 0); : *jobu == 'S' || *jobu == 'O' ? ComputeThinU
: 0) |
(*jobv == 'A' ? ComputeFullV
: *jobv == 'S' || *jobv == 'O' ? ComputeThinV
: 0);
JacobiSVD<PlainMatrixType> svd(mat, option); JacobiSVD<PlainMatrixType> svd(mat, option);
make_vector(s, diag_size) = svd.singularValues().head(diag_size); make_vector(s, diag_size) = svd.singularValues().head(diag_size);
{ {
if(*jobu=='A') matrix(u,*m,*m,*ldu) = svd.matrixU(); if (*jobu == 'A')
else if(*jobu=='S') matrix(u,*m,diag_size,*ldu) = svd.matrixU(); matrix(u, *m, *m, *ldu) = svd.matrixU();
else if(*jobu=='O') matrix(a,*m,diag_size,*lda) = 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(); if (*jobv == 'A')
else if(*jobv=='S') matrix(vt,diag_size,*n,*ldvt) = svd.matrixV().adjoint(); matrix(vt, *n, *n, *ldvt) = svd.matrixV().adjoint();
else if(*jobv=='O') matrix(a,diag_size,*n,*lda) = 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; return 0;
} }