Remove return int types from BLAS/LAPACK functions.

This commit is contained in:
Antonio Sánchez
2024-02-14 19:51:36 +00:00
parent 7e655c9a5d
commit 5361dea833
38 changed files with 888 additions and 1010 deletions

View File

@@ -17,8 +17,8 @@ static inline void r_cnjg(complex *r, complex *z) {
r->i = -(z->i);
}
/* 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 */ void chbmv_(char *uplo, integer *n, integer *k, complex *alpha, complex *a, integer *lda, complex *x,
integer *incx, complex *beta, complex *y, integer *incy) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
real r__1;
@@ -27,9 +27,9 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Local variables */
integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
complex temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -183,7 +183,7 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -197,14 +197,14 @@ static inline void r_cnjg(complex *r, complex *z) {
info = 11;
}
if (info != 0) {
xerbla_("CHBMV ", &info, (ftnlen)6);
return 0;
xerbla_("CHBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -268,9 +268,9 @@ static inline void r_cnjg(complex *r, complex *z) {
}
}
if (alpha->r == 0.f && alpha->i == 0.f) {
return 0;
return;
}
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when upper triangle of A is stored. */
kplus1 = *k + 1;
@@ -451,8 +451,6 @@ static inline void r_cnjg(complex *r, complex *z) {
}
}
return 0;
/* End of CHBMV . */
} /* chbmv_ */

View File

@@ -17,8 +17,8 @@ static inline void r_cnjg(complex *r, complex *z) {
r->i = -(z->i);
}
/* 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 */ void chpmv_(char *uplo, integer *n, complex *alpha, complex *ap, complex *x, integer *incx,
complex *beta, complex *y, integer *incy) {
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
real r__1;
@@ -27,8 +27,8 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Local variables */
integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
complex temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern logical lsame_(char *, char *);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -146,7 +146,7 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -156,14 +156,14 @@ static inline void r_cnjg(complex *r, complex *z) {
info = 9;
}
if (info != 0) {
xerbla_("CHPMV ", &info, (ftnlen)6);
return 0;
xerbla_("CHPMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && beta->i == 0.f))) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -227,10 +227,10 @@ static inline void r_cnjg(complex *r, complex *z) {
}
}
if (alpha->r == 0.f && alpha->i == 0.f) {
return 0;
return;
}
kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) {
@@ -402,8 +402,6 @@ static inline void r_cnjg(complex *r, complex *z) {
}
}
return 0;
/* End of CHPMV . */
} /* chpmv_ */

View File

@@ -20,7 +20,7 @@
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 */ void cdotcw_(integer *, complex *, integer *, complex *, integer *, complex *);
/* Parameter adjustments */
--cy;
@@ -33,7 +33,7 @@ complex cdotc_(integer *n, complex *cx, integer *incx, complex *cy, integer *inc
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 */ void cdotuw_(integer *, complex *, integer *, complex *, integer *, complex *);
/* Parameter adjustments */
--cy;
@@ -46,8 +46,8 @@ complex cdotu_(integer *n, complex *cx, integer *incx, complex *cy, integer *inc
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 */ void zdotcw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *);
/* Parameter adjustments */
--cy;
@@ -60,8 +60,8 @@ doublecomplex zdotc_(integer *n, doublecomplex *cx, integer *incx, doublecomplex
doublecomplex zdotu_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy) {
doublecomplex res;
extern /* Subroutine */ int zdotuw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *);
extern /* Subroutine */ void zdotuw_(integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *);
/* Parameter adjustments */
--cy;

View File

@@ -17,8 +17,8 @@ static inline void r_cnjg(complex *r, complex *z) {
r->i = -(z->i);
}
/* 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 */ void ctbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex *a, integer *lda,
complex *x, integer *incx) {
/* 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;
@@ -26,9 +26,9 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Local variables */
integer i__, j, l, ix, jx, kx, info;
complex temp;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
logical noconj, nounit;
/* .. Scalar Arguments .. */
@@ -188,12 +188,11 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
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") && !lsame_(trans, "T") && !lsame_(trans, "C")) {
info = 2;
} else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
} else if (!lsame_(diag, "U") && !lsame_(diag, "N")) {
info = 3;
} else if (*n < 0) {
info = 4;
@@ -205,18 +204,18 @@ static inline void r_cnjg(complex *r, complex *z) {
info = 9;
}
if (info != 0) {
xerbla_("CTBMV ", &info, (ftnlen)6);
return 0;
xerbla_("CTBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0) {
return 0;
return;
}
noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
noconj = lsame_(trans, "T");
nounit = lsame_(diag, "N");
/* Set up the start point in X if the increment is not unity. This */
/* will be ( N - 1 )*INCX too small for descending loops. */
@@ -230,10 +229,10 @@ static inline void r_cnjg(complex *r, complex *z) {
/* Start the operations. In this version the elements of A are */
/* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
if (lsame_(trans, "N")) {
/* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
i__1 = *n;
@@ -379,7 +378,7 @@ static inline void r_cnjg(complex *r, complex *z) {
} else {
/* Form x := A'*x or x := conjg( A' )*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
for (j = *n; j >= 1; --j) {
@@ -582,8 +581,6 @@ static inline void r_cnjg(complex *r, complex *z) {
}
}
return 0;
/* End of CTBMV . */
} /* ctbmv_ */

View File

@@ -15,7 +15,6 @@ typedef struct {
typedef struct {
doublereal r, i;
} doublecomplex;
typedef int ftnlen;
typedef int logical;
#define abs(x) ((x) >= 0 ? (x) : -(x))

View File

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

View File

@@ -12,7 +12,7 @@
#include "datatypes.h"
/* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam) {
/* Subroutine */ void drotmg_(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam) {
/* Initialized data */
static doublereal zero = 0.;
@@ -38,6 +38,7 @@
/* Assigned format variables */
static char *igo_fmt;
(void)igo_fmt;
/* .. Scalar Arguments .. */
/* .. */
@@ -289,5 +290,4 @@ L250:
dparam[5] = dh22;
L260:
dparam[1] = dflag;
return 0;
} /* drotmg_ */

View File

@@ -12,18 +12,17 @@
#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 */ void dsbmv_(char *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
doublereal temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -172,7 +171,7 @@
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -186,14 +185,14 @@
info = 11;
}
if (info != 0) {
xerbla_("DSBMV ", &info, (ftnlen)6);
return 0;
xerbla_("DSBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -249,9 +248,9 @@
}
}
if (*alpha == 0.) {
return 0;
return;
}
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when upper triangle of A is stored. */
kplus1 = *k + 1;
@@ -352,8 +351,6 @@
}
}
return 0;
/* End of DSBMV . */
} /* dsbmv_ */

View File

@@ -12,16 +12,16 @@
#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 */ void dspmv_(char *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal *x, integer *incx,
doublereal *beta, doublereal *y, integer *incy) {
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
doublereal temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern logical lsame_(char *, char *);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -135,7 +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") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -145,14 +145,14 @@
info = 9;
}
if (info != 0) {
xerbla_("DSPMV ", &info, (ftnlen)6);
return 0;
xerbla_("DSPMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -208,10 +208,10 @@
}
}
if (*alpha == 0.) {
return 0;
return;
}
kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) {
@@ -303,8 +303,6 @@
}
}
return 0;
/* End of DSPMV . */
} /* dspmv_ */

View File

@@ -12,17 +12,17 @@
#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 */ void dtbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublereal *a, integer *lda,
doublereal *x, integer *incx) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, j, l, ix, jx, kx, info;
doublereal temp;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
logical nounit;
/* .. Scalar Arguments .. */
@@ -182,12 +182,11 @@
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
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") && !lsame_(trans, "T") && !lsame_(trans, "C")) {
info = 2;
} else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
} else if (!lsame_(diag, "U") && !lsame_(diag, "N")) {
info = 3;
} else if (*n < 0) {
info = 4;
@@ -199,17 +198,17 @@
info = 9;
}
if (info != 0) {
xerbla_("DTBMV ", &info, (ftnlen)6);
return 0;
xerbla_("DTBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0) {
return 0;
return;
}
nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
nounit = lsame_(diag, "N");
/* Set up the start point in X if the increment is not unity. This */
/* will be ( N - 1 )*INCX too small for descending loops. */
@@ -223,10 +222,10 @@
/* Start the operations. In this version the elements of A are */
/* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
if (lsame_(trans, "N")) {
/* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
i__1 = *n;
@@ -324,7 +323,7 @@
} else {
/* Form x := A'*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
for (j = *n; j >= 1; --j) {
@@ -413,8 +412,6 @@
}
}
return 0;
/* End of DTBMV . */
} /* dtbmv_ */

View File

@@ -12,7 +12,7 @@
#include "datatypes.h"
logical lsame_(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len) {
logical lsame_(char *ca, char *cb) {
/* System generated locals */
logical ret_val;

View File

@@ -12,7 +12,7 @@
#include "datatypes.h"
/* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam) {
/* Subroutine */ void srotm_(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam) {
/* Initialized data */
static real zero = 0.f;
@@ -208,5 +208,5 @@ L120:
/* L130: */
}
L140:
return 0;
return;
} /* srotm_ */

View File

@@ -12,7 +12,7 @@
#include "datatypes.h"
/* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam) {
/* Subroutine */ void srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam) {
/* Initialized data */
static real zero = 0.f;
@@ -38,6 +38,7 @@
/* Assigned format variables */
static char *igo_fmt;
(void)igo_fmt;
/* .. Scalar Arguments .. */
/* .. */
@@ -289,5 +290,4 @@ L250:
sparam[5] = sh22;
L260:
sparam[1] = sflag;
return 0;
} /* srotmg_ */

View File

@@ -12,17 +12,17 @@
#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 */ void ssbmv_(char *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x,
integer *incx, real *beta, real *y, integer *incy) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
real temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -174,7 +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") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -188,14 +188,14 @@
info = 11;
}
if (info != 0) {
xerbla_("SSBMV ", &info, (ftnlen)6);
return 0;
xerbla_("SSBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -251,9 +251,9 @@
}
}
if (*alpha == 0.f) {
return 0;
return;
}
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when upper triangle of A is stored. */
kplus1 = *k + 1;
@@ -354,8 +354,6 @@
}
}
return 0;
/* End of SSBMV . */
} /* ssbmv_ */

View File

@@ -12,16 +12,16 @@
#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 */ void sspmv_(char *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx, real *beta, real *y,
integer *incy) {
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
real temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern logical lsame_(char *, char *);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -135,7 +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") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -145,14 +145,14 @@
info = 9;
}
if (info != 0) {
xerbla_("SSPMV ", &info, (ftnlen)6);
return 0;
xerbla_("SSPMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (*alpha == 0.f && *beta == 1.f)) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -208,10 +208,10 @@
}
}
if (*alpha == 0.f) {
return 0;
return;
}
kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) {
@@ -303,8 +303,6 @@
}
}
return 0;
/* End of SSPMV . */
} /* sspmv_ */

View File

@@ -12,17 +12,17 @@
#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 */ void stbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, integer *lda,
real *x, integer *incx) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, j, l, ix, jx, kx, info;
real temp;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
logical nounit;
/* .. Scalar Arguments .. */
@@ -182,12 +182,11 @@
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
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") && !lsame_(trans, "T") && !lsame_(trans, "C")) {
info = 2;
} else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
} else if (!lsame_(diag, "U") && !lsame_(diag, "N")) {
info = 3;
} else if (*n < 0) {
info = 4;
@@ -199,17 +198,17 @@
info = 9;
}
if (info != 0) {
xerbla_("STBMV ", &info, (ftnlen)6);
return 0;
xerbla_("STBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0) {
return 0;
return;
}
nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
nounit = lsame_(diag, "N");
/* Set up the start point in X if the increment is not unity. This */
/* will be ( N - 1 )*INCX too small for descending loops. */
@@ -223,10 +222,10 @@
/* Start the operations. In this version the elements of A are */
/* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
if (lsame_(trans, "N")) {
/* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
i__1 = *n;
@@ -324,7 +323,7 @@
} else {
/* Form x := A'*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
for (j = *n; j >= 1; --j) {
@@ -413,8 +412,6 @@
}
}
return 0;
/* End of STBMV . */
} /* stbmv_ */

View File

@@ -17,9 +17,8 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
r->i = -(z->i);
}
/* 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 */ void zhbmv_(char *uplo, integer *n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy) {
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1;
@@ -28,9 +27,9 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Local variables */
integer i__, j, l, ix, iy, jx, jy, kx, ky, info;
doublecomplex temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -184,7 +183,7 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -198,14 +197,14 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
info = 11;
}
if (info != 0) {
xerbla_("ZHBMV ", &info, (ftnlen)6);
return 0;
xerbla_("ZHBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -269,9 +268,9 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
}
}
if (alpha->r == 0. && alpha->i == 0.) {
return 0;
return;
}
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when upper triangle of A is stored. */
kplus1 = *k + 1;
@@ -452,8 +451,6 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
}
}
return 0;
/* End of ZHBMV . */
} /* zhbmv_ */

View File

@@ -17,8 +17,8 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
r->i = -(z->i);
}
/* 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 */ void zhpmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doublecomplex *x,
integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy) {
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
doublereal d__1;
@@ -27,8 +27,8 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Local variables */
integer i__, j, k, kk, ix, iy, jx, jy, kx, ky, info;
doublecomplex temp1, temp2;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern logical lsame_(char *, char *);
extern /* Subroutine */ void xerbla_(const char *, integer *);
/* .. Scalar Arguments .. */
/* .. */
@@ -146,7 +146,7 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
info = 1;
} else if (*n < 0) {
info = 2;
@@ -156,14 +156,14 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
info = 9;
}
if (info != 0) {
xerbla_("ZHPMV ", &info, (ftnlen)6);
return 0;
xerbla_("ZHPMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0 || (alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && beta->i == 0.))) {
return 0;
return;
}
/* Set up the start points in X and Y. */
@@ -227,10 +227,10 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
}
}
if (alpha->r == 0. && alpha->i == 0.) {
return 0;
return;
}
kk = 1;
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
/* Form y when AP contains the upper triangle. */
if (*incx == 1 && *incy == 1) {
@@ -402,8 +402,6 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
}
}
return 0;
/* End of ZHPMV . */
} /* zhpmv_ */

View File

@@ -17,8 +17,8 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
r->i = -(z->i);
}
/* 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 */ void ztbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublecomplex *a,
integer *lda, doublecomplex *x, integer *incx) {
/* 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;
@@ -26,9 +26,9 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Local variables */
integer i__, j, l, ix, jx, kx, info;
doublecomplex temp;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern logical lsame_(char *, char *);
integer kplus1;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern /* Subroutine */ void xerbla_(const char *, integer *);
logical noconj, nounit;
/* .. Scalar Arguments .. */
@@ -188,12 +188,11 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Function Body */
info = 0;
if (!lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, "L", (ftnlen)1, (ftnlen)1)) {
if (!lsame_(uplo, "U") && !lsame_(uplo, "L")) {
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") && !lsame_(trans, "T") && !lsame_(trans, "C")) {
info = 2;
} else if (!lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && !lsame_(diag, "N", (ftnlen)1, (ftnlen)1)) {
} else if (!lsame_(diag, "U") && !lsame_(diag, "N")) {
info = 3;
} else if (*n < 0) {
info = 4;
@@ -205,18 +204,18 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
info = 9;
}
if (info != 0) {
xerbla_("ZTBMV ", &info, (ftnlen)6);
return 0;
xerbla_("ZTBMV ", &info);
return;
}
/* Quick return if possible. */
if (*n == 0) {
return 0;
return;
}
noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1);
nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1);
noconj = lsame_(trans, "T");
nounit = lsame_(diag, "N");
/* Set up the start point in X if the increment is not unity. This */
/* will be ( N - 1 )*INCX too small for descending loops. */
@@ -230,10 +229,10 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
/* Start the operations. In this version the elements of A are */
/* accessed sequentially with one pass through A. */
if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) {
if (lsame_(trans, "N")) {
/* Form x := A*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
i__1 = *n;
@@ -379,7 +378,7 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
} else {
/* Form x := A'*x or x := conjg( A' )*x. */
if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) {
if (lsame_(uplo, "U")) {
kplus1 = *k + 1;
if (*incx == 1) {
for (j = *n; j >= 1; --j) {
@@ -582,8 +581,6 @@ static inline void d_cnjg(doublecomplex *r, doublecomplex *z) {
}
}
return 0;
/* End of ZTBMV . */
} /* ztbmv_ */