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

75
blas/f2c/chpmv.c
View File

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

31
blas/f2c/complexdots.c
View File

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

160
blas/f2c/ctbmv.c
View File

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

6
blas/f2c/drotm.c
View File

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

18
blas/f2c/drotmg.c
View File

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

17
blas/f2c/dsbmv.c
View File

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

12
blas/f2c/dspmv.c
View File

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

20
blas/f2c/dtbmv.c
View File

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

14
blas/f2c/lsame.c
View File

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

6
blas/f2c/srotm.c
View File

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

20
blas/f2c/srotmg.c
View File

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

15
blas/f2c/ssbmv.c
View File

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

12
blas/f2c/sspmv.c
View File

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

20
blas/f2c/stbmv.c
View File

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

77
blas/f2c/zhbmv.c
View File

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

75
blas/f2c/zhpmv.c
View File

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

160
blas/f2c/ztbmv.c
View File

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

53
lapack/cholesky.inc
View File

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

43
lapack/eigenvalues.inc
View File

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

67
lapack/lu.inc
View File

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

119
lapack/svd.inc
View File

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