complete function prototypes and remove unused functions
This commit is contained in:
Martin Kroeker
GitHub
parent
974cd11834
commit
b626544ca3
|
|
@ -242,251 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
#if 0
|
||||
static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i]) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i]) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
||||
|
|
@ -503,16 +258,16 @@ static integer c__1 = 1;
|
|||
static integer c__5 = 5;
|
||||
static real c_b43 = (float)1.;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static real sfac = (float)9.765625e-4;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ int check1_(), check2_();
|
||||
extern /* Subroutine */ int check1_(real*), check2_(real*);
|
||||
static integer ic;
|
||||
extern /* Subroutine */ int header_();
|
||||
extern /* Subroutine */ int header_(void);
|
||||
|
||||
/* Test program for the COMPLEX Level 1 CBLAS. */
|
||||
/* Based upon the original CBLAS test routine together with: */
|
||||
|
|
@ -553,7 +308,7 @@ static real c_b43 = (float)1.;
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int header_()
|
||||
/* Subroutine */ int header_(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -564,7 +319,7 @@ static real c_b43 = (float)1.;
|
|||
/* Format strings */
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
integer s_wsfe(void), do_fio(void), e_wsfe(void);
|
||||
|
||||
/* .. Parameters .. */
|
||||
/* .. Scalars in Common .. */
|
||||
|
|
@ -577,8 +332,7 @@ static real c_b43 = (float)1.;
|
|||
|
||||
} /* header_ */
|
||||
|
||||
/* Subroutine */ int check1_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check1_(real* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -683,15 +437,15 @@ real *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern /* Subroutine */ int ctest_();
|
||||
extern /* Subroutine */ int ctest_(int*, complex*, complex*, complex*, real*);
|
||||
static complex mwpcs[5], mwpct[5];
|
||||
extern /* Subroutine */ int itest1_(), stest1_();
|
||||
extern /* Subroutine */ int itest1_(int*, int*), stest1_(real*,real*,real*,real*);
|
||||
static complex cx[8];
|
||||
extern real scnrm2test_();
|
||||
extern real scnrm2test_(int*, complex*, int*);
|
||||
static integer np1;
|
||||
extern integer icamaxtest_();
|
||||
extern /* Subroutine */ int csscaltest_();
|
||||
extern real scasumtest_();
|
||||
extern integer icamaxtest_(int*, complex*, int*);
|
||||
extern /* Subroutine */ int csscaltest_(int*, real*, complex*, int*);
|
||||
extern real scasumtest_(int*, complex*, int*);
|
||||
static integer len;
|
||||
|
||||
/* .. Parameters .. */
|
||||
|
|
@ -808,8 +562,7 @@ real *sfac;
|
|||
return 0;
|
||||
} /* check1_ */
|
||||
|
||||
/* Subroutine */ int check2_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check2_(real* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -981,10 +734,10 @@ real *sfac;
|
|||
static complex cdot[1];
|
||||
static integer lenx, leny, i__;
|
||||
static complex ctemp;
|
||||
extern /* Subroutine */ int ctest_();
|
||||
extern /* Subroutine */ int ctest_(int*, complex*, complex*, complex*, real*);
|
||||
static integer ksize;
|
||||
extern /* Subroutine */ int cdotctest_(), ccopytest_(), cdotutest_(),
|
||||
cswaptest_(), caxpytest_();
|
||||
extern /* Subroutine */ int cdotctest_(int*, complex*, int*, complex*, int*,complex*), ccopytest_(int*, complex*, int*, complex*, int*), cdotutest_(int*, complex*, int*, complex*, int*, complex*),
|
||||
cswaptest_(int*, complex*, int*, complex*, int*), caxpytest_(int*, complex*, complex*, int*, complex*, int*);
|
||||
static integer ki, kn;
|
||||
static complex cx[7], cy[7];
|
||||
static integer mx, my;
|
||||
|
|
@ -1067,9 +820,7 @@ real *sfac;
|
|||
return 0;
|
||||
} /* check2_ */
|
||||
|
||||
/* Subroutine */ int stest_(len, scomp, strue, ssize, sfac)
|
||||
integer *len;
|
||||
real *scomp, *strue, *ssize, *sfac;
|
||||
/* Subroutine */ int stest_(integer* len, real* scomp, real* strue, real* ssize,real* sfac)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -1077,7 +828,7 @@ real *scomp, *strue, *ssize, *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(real*, real*);
|
||||
static real sd;
|
||||
|
||||
/* ********************************* STEST ************************** */
|
||||
|
|
@ -1133,11 +884,10 @@ L40:
|
|||
|
||||
} /* stest_ */
|
||||
|
||||
/* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac)
|
||||
real *scomp1, *strue1, *ssize, *sfac;
|
||||
/* Subroutine */ int stest1_(real* scomp1, real* strue1, real* ssize, real* sfac)
|
||||
{
|
||||
static real scomp[1], strue[1];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(int*, real*, real*, real*, real*);
|
||||
|
||||
/* ************************* STEST1 ***************************** */
|
||||
|
||||
|
|
@ -1164,8 +914,7 @@ real *scomp1, *strue1, *ssize, *sfac;
|
|||
return 0;
|
||||
} /* stest1_ */
|
||||
|
||||
doublereal sdiff_(sa, sb)
|
||||
real *sa, *sb;
|
||||
doublereal sdiff_(real* sa, real* sb)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
@ -1179,10 +928,7 @@ real *sa, *sb;
|
|||
return ret_val;
|
||||
} /* sdiff_ */
|
||||
|
||||
/* Subroutine */ int ctest_(len, ccomp, ctrue, csize, sfac)
|
||||
integer *len;
|
||||
complex *ccomp, *ctrue, *csize;
|
||||
real *sfac;
|
||||
/* Subroutine */ int ctest_(integer* len, complex* ccomp, complex* ctrue, complex* csize, real* sfac)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1, i__2;
|
||||
|
|
@ -1193,7 +939,7 @@ real *sfac;
|
|||
/* Local variables */
|
||||
static integer i__;
|
||||
static real scomp[20], ssize[20], strue[20];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(int*, real*,real*,real*,real*);
|
||||
|
||||
/* **************************** CTEST ***************************** */
|
||||
|
||||
|
|
@ -1231,8 +977,7 @@ real *sfac;
|
|||
return 0;
|
||||
} /* ctest_ */
|
||||
|
||||
/* Subroutine */ int itest1_(icomp, itrue)
|
||||
integer *icomp, *itrue;
|
||||
/* Subroutine */ int itest1_(integer* icomp, integer* itrue)
|
||||
{
|
||||
/* Local variables */
|
||||
static integer id;
|
||||
|
|
|
|||
|
|
@ -242,129 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -396,7 +273,7 @@ static integer c_n1 = -1;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -414,17 +291,21 @@ static logical c_false = FALSE_;
|
|||
static logical same;
|
||||
static integer ninc, nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int cchk1_(), cchk2_(), cchk3_(), cchk4_(),
|
||||
cchk5_(), cchk6_();
|
||||
extern /* Subroutine */ int cchk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int cchk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int cchk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int cchk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int cchk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int cchk6_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen);
|
||||
static complex a[4225] /* was [65][65] */;
|
||||
static real g[65];
|
||||
static integer i__, j, n;
|
||||
static logical fatal;
|
||||
static complex x[65], y[65], z__[130];
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(real*, real*);
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static char snaps[32], trans[1];
|
||||
static integer isnum;
|
||||
static logical ltest[17];
|
||||
|
|
@ -438,11 +319,11 @@ static logical c_false = FALSE_;
|
|||
static char snamet[12];
|
||||
static real thresh;
|
||||
static logical rorder;
|
||||
extern /* Subroutine */ int cc2chke_();
|
||||
extern /* Subroutine */ void cc2chke_(char*, ftnlen);
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
static complex alf[7];
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static integer inc[7], nkb;
|
||||
static complex bet[7];
|
||||
static real eps, err;
|
||||
|
|
@ -983,22 +864,7 @@ L240:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int cchk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
complex *alf;
|
||||
integer *nbet;
|
||||
complex *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
real *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, complex* alf, integer* nbet, complex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1015,10 +881,10 @@ ftnlen sname_len;
|
|||
static integer incx, incy;
|
||||
static logical full, tran, null;
|
||||
static integer i__, m, n;
|
||||
extern /* Subroutine */ int cmake_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
static complex alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys;
|
||||
|
|
@ -1026,14 +892,15 @@ ftnlen sname_len;
|
|||
static integer ia, ib, ic;
|
||||
static logical banded;
|
||||
static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns;
|
||||
extern /* Subroutine */ int ccgbmv_(), ccgemv_();
|
||||
extern logical lceres_();
|
||||
extern /* Subroutine */ int ccgbmv_(integer*, char*, integer*, integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void ccgemv_(integer*, char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen);
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
static char ctrans[14];
|
||||
static real errmax;
|
||||
static complex transl;
|
||||
static char transs[1];
|
||||
static integer laa, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static complex als, bls;
|
||||
static real err;
|
||||
static integer iku, kls, kus;
|
||||
|
|
@ -1448,22 +1315,7 @@ L140:
|
|||
|
||||
} /* cchk1_ */
|
||||
|
||||
/* Subroutine */ int cchk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
complex *alf;
|
||||
integer *nbet;
|
||||
complex *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
real *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, complex* alf, integer* nbet, complex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1481,10 +1333,10 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, k, n;
|
||||
extern /* Subroutine */ int cmake_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
static complex alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
|
|
@ -1495,13 +1347,14 @@ ftnlen sname_len;
|
|||
static integer nc, ik, in;
|
||||
static logical packed;
|
||||
static integer nk, ks, ix, iy, ns, lx, ly;
|
||||
extern /* Subroutine */ int cchbmv_(), cchemv_();
|
||||
extern logical lceres_();
|
||||
extern /* Subroutine */ int cchpmv_();
|
||||
extern /* Subroutine */ void cchbmv_(integer*, char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void cchemv_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen);
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cchpmv_(integer*, char*, integer*, complex*, complex*, complex*, integer*, complex*, complex*, integer*, ftnlen);
|
||||
static real errmax;
|
||||
static complex transl;
|
||||
static integer laa, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static complex als, bls;
|
||||
static real err;
|
||||
|
||||
|
|
@ -1906,19 +1759,7 @@ L130:
|
|||
|
||||
} /* cchk2_ */
|
||||
|
||||
/* Subroutine */ int cchk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, xt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *xt;
|
||||
real *g;
|
||||
complex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* xt, real* g, complex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1937,10 +1778,10 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1], cdiag[14];
|
||||
static integer i__, k, n;
|
||||
extern /* Subroutine */ int cmake_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
static char diags[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
|
|
@ -1950,17 +1791,19 @@ ftnlen sname_len;
|
|||
static integer nc, ik, in;
|
||||
static logical packed;
|
||||
static integer nk, ks, ix, ns, lx;
|
||||
extern logical lceres_();
|
||||
extern /* Subroutine */ int cctbmv_(), cctbsv_();
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cctbmv_(integer*, char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cctbsv_(integer*, char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char ctrans[14];
|
||||
extern /* Subroutine */ int cctpmv_();
|
||||
extern /* Subroutine */ void cctpmv_(integer*, char*, char*, char*, integer*, complex*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static real errmax;
|
||||
extern /* Subroutine */ int cctrmv_(), cctpsv_();
|
||||
extern /* Subroutine */ void cctrmv_(integer*, char*, char*, char*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cctpsv_(integer*, char*, char*, char*, integer*, complex*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static complex transl;
|
||||
extern /* Subroutine */ int cctrsv_();
|
||||
extern /* Subroutine */ void cctrsv_(integer*, char*, char*, char*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
static integer laa, icd, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static integer ict, icu;
|
||||
static real err;
|
||||
|
||||
|
|
@ -2418,21 +2261,7 @@ L130:
|
|||
|
||||
} /* cchk3_ */
|
||||
|
||||
/* Subroutine */ int cchk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
complex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
real *g;
|
||||
complex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
|
||||
|
|
@ -2444,21 +2273,21 @@ ftnlen sname_len;
|
|||
static integer incx, incy;
|
||||
static logical null;
|
||||
static integer i__, j, m, n;
|
||||
extern /* Subroutine */ int cmake_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
static complex alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys, ia, nc, nd, im, in;
|
||||
extern /* Subroutine */ int ccgerc_();
|
||||
extern /* Subroutine */ void ccgerc_(integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*);
|
||||
static integer ms, ix, iy, ns, lx, ly;
|
||||
extern /* Subroutine */ int ccgeru_();
|
||||
extern logical lceres_();
|
||||
extern /* Subroutine */ void ccgeru_(integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*);
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
static real errmax;
|
||||
static complex transl;
|
||||
static integer laa, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static complex als;
|
||||
static real err;
|
||||
|
||||
|
|
@ -2786,21 +2615,7 @@ L150:
|
|||
|
||||
} /* cchk4_ */
|
||||
|
||||
/* Subroutine */ int cchk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
complex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
real *g;
|
||||
complex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2818,10 +2633,12 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, n;
|
||||
extern /* Subroutine */ int cmake_(), ccher_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void ccher_(integer*, char*, integer*, real*, complex*, integer*, complex*, integer*, ftnlen);
|
||||
static complex alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cchpr_(), cmvch_();
|
||||
extern /* Subroutine */ void cchpr_(integer*, char*, integer*, real*, complex*, integer*, complex*, ftnlen);
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
|
|
@ -2832,11 +2649,11 @@ ftnlen sname_len;
|
|||
static logical packed;
|
||||
static integer ix, ns, lx;
|
||||
static real ralpha;
|
||||
extern logical lceres_();
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
static real errmax;
|
||||
static complex transl;
|
||||
static integer laa, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests CHER and CHPR. */
|
||||
|
|
@ -3160,21 +2977,7 @@ L130:
|
|||
|
||||
} /* cchk5_ */
|
||||
|
||||
/* Subroutine */ int cchk6_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
complex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
real *g;
|
||||
complex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int cchk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -3192,25 +2995,26 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, n;
|
||||
extern /* Subroutine */ int cmake_();
|
||||
extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen);
|
||||
static complex alpha, w[2];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int cmvch_();
|
||||
extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ int ccher2_(), cchpr2_();
|
||||
extern /* Subroutine */ void ccher2_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void cchpr2_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, ftnlen);
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
static logical packed;
|
||||
static integer ix, iy, ns, lx, ly;
|
||||
extern logical lceres_();
|
||||
extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen);
|
||||
static real errmax;
|
||||
static complex transl;
|
||||
static integer laa, lda;
|
||||
extern logical lce_();
|
||||
extern logical lce_(complex*, complex*, integer*);
|
||||
static complex als;
|
||||
static real err;
|
||||
|
||||
|
|
@ -3597,24 +3401,7 @@ L170:
|
|||
|
||||
} /* cchk6_ */
|
||||
|
||||
/* Subroutine */ int cmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y,
|
||||
incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len)
|
||||
char *trans;
|
||||
integer *m, *n;
|
||||
complex *alpha, *a;
|
||||
integer *nmax;
|
||||
complex *x;
|
||||
integer *incx;
|
||||
complex *beta, *y;
|
||||
integer *incy;
|
||||
complex *yt;
|
||||
real *g;
|
||||
complex *yy;
|
||||
real *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen trans_len;
|
||||
/* Subroutine */ int cmvch_(char* trans, integer* m, integer* n, complex* alpha, complex* a, integer* nmax, complex* x, integer* incx, complex* beta, complex* y, integer* incy, complex* yt, real* g, complex* yy, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len)
|
||||
{
|
||||
|
||||
/* System generated locals */
|
||||
|
|
@ -3812,9 +3599,7 @@ L80:
|
|||
|
||||
} /* cmvch_ */
|
||||
|
||||
logical lce_(ri, rj, lr)
|
||||
complex *ri, *rj;
|
||||
integer *lr;
|
||||
logical lce_(complex* ri, complex* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1, i__2, i__3;
|
||||
|
|
@ -3861,13 +3646,7 @@ L30:
|
|||
|
||||
} /* lce_ */
|
||||
|
||||
logical lceres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
complex *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lceres_(char* type__, char* uplo, integer* m, integer* n, complex* aa, complex* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -3960,9 +3739,7 @@ L80:
|
|||
|
||||
} /* lceres_ */
|
||||
|
||||
/* Complex */ VOID cbeg_( ret_val, reset)
|
||||
complex * ret_val;
|
||||
logical *reset;
|
||||
/* Complex */ VOID cbeg_(complex* ret_val, logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
real r__1, r__2;
|
||||
|
|
@ -4023,8 +3800,7 @@ L10:
|
|||
|
||||
} /* cbeg_ */
|
||||
|
||||
doublereal sdiff_(x, y)
|
||||
real *x, *y;
|
||||
doublereal sdiff_(real* x, real* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
@ -4044,19 +3820,7 @@ real *x, *y;
|
|||
|
||||
} /* sdiff_ */
|
||||
|
||||
/* Subroutine */ int cmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl,
|
||||
ku, reset, transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
complex *a;
|
||||
integer *nmax;
|
||||
complex *aa;
|
||||
integer *lda, *kl, *ku;
|
||||
logical *reset;
|
||||
complex *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int cmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, complex* a, integer* nmax, complex* aa, integer* lda, integer* kl, integer* ku, logical* reset, complex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -4064,7 +3828,7 @@ ftnlen diag_len;
|
|||
complex q__1, q__2;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Complex */ VOID cbeg_();
|
||||
extern /* Complex */ VOID cbeg_(complex*, logical*);
|
||||
static integer ibeg, iend, ioff;
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
|
|
|
|||
|
|
@ -242,130 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
|
|||
|
|
@ -21,19 +21,6 @@ typedef float real;
|
|||
typedef double doublereal;
|
||||
typedef struct { real r, i; } complex;
|
||||
typedef struct { doublereal r, i; } doublecomplex;
|
||||
#ifdef _MSC_VER
|
||||
static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;}
|
||||
static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;}
|
||||
static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;}
|
||||
static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;}
|
||||
#else
|
||||
static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
|
||||
static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
|
||||
#endif
|
||||
#define pCf(z) (*_pCf(z))
|
||||
#define pCd(z) (*_pCd(z))
|
||||
typedef int logical;
|
||||
typedef short int shortlogical;
|
||||
typedef char logical1;
|
||||
|
|
@ -242,124 +229,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
||||
|
|
@ -375,16 +244,16 @@ struct {
|
|||
static integer c__1 = 1;
|
||||
static doublereal c_b34 = 1.;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static doublereal sfac = 9.765625e-4;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ int check0_(), check1_(), check2_(), check3_();
|
||||
extern /* Subroutine */ int check0_(doublereal*), check1_(doublereal*), check2_(doublereal*), check3_(doublereal*);
|
||||
static integer ic;
|
||||
extern /* Subroutine */ int header_();
|
||||
extern /* Subroutine */ int header_(void);
|
||||
|
||||
/* Test program for the DOUBLE PRECISION Level 1 CBLAS. */
|
||||
/* Based upon the original CBLAS test routine together with: */
|
||||
|
|
@ -431,7 +300,7 @@ static doublereal c_b34 = 1.;
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int header_()
|
||||
/* Subroutine */ int header_(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -450,8 +319,7 @@ static doublereal c_b34 = 1.;
|
|||
|
||||
} /* header_ */
|
||||
|
||||
/* Subroutine */ int check0_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check0_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -464,7 +332,7 @@ doublereal *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer k;
|
||||
extern /* Subroutine */ int drotgtest_(), stest1_();
|
||||
extern /* Subroutine */ int drotgtest_(doublereal*,doublereal*,doublereal*,doublereal*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*);
|
||||
static doublereal sa, sb, sc, ss;
|
||||
|
||||
/* .. Parameters .. */
|
||||
|
|
@ -509,8 +377,7 @@ L40:
|
|||
return 0;
|
||||
} /* check0_ */
|
||||
|
||||
/* Subroutine */ int check1_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check1_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -535,14 +402,14 @@ doublereal *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern doublereal dnrm2test_();
|
||||
extern doublereal dnrm2test_(int*, doublereal*, int*);
|
||||
static doublereal stemp[1], strue[8];
|
||||
extern /* Subroutine */ int stest_(), dscaltest_();
|
||||
extern doublereal dasumtest_();
|
||||
extern /* Subroutine */ int itest1_(), stest1_();
|
||||
extern /* Subroutine */ int stest_(int*,doublereal*,doublereal*,doublereal*,doublereal*), dscaltest_(int*,doublereal*,doublereal*,int*);
|
||||
extern doublereal dasumtest_(int*,doublereal*,int*);
|
||||
extern /* Subroutine */ int itest1_(int*,int*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*);
|
||||
static doublereal sx[8];
|
||||
static integer np1;
|
||||
extern integer idamaxtest_();
|
||||
extern integer idamaxtest_(int*,doublereal*,int*);
|
||||
static integer len;
|
||||
|
||||
/* .. Parameters .. */
|
||||
|
|
@ -603,8 +470,7 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* check1_ */
|
||||
|
||||
/* Subroutine */ int check2_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check2_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -649,10 +515,10 @@ doublereal *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer lenx, leny;
|
||||
extern doublereal ddottest_();
|
||||
extern doublereal ddottest_(int*,doublereal*,int*,doublereal*,int*);
|
||||
static integer i__, j, ksize;
|
||||
extern /* Subroutine */ int stest_(), dcopytest_(), dswaptest_(),
|
||||
daxpytest_(), stest1_();
|
||||
extern /* Subroutine */ int stest_(int*,doublereal*,doublereal*,doublereal*,doublereal*), dcopytest_(int*,doublereal*,int*,doublereal*,int*), dswaptest_(int*,doublereal*,int*,doublereal*,int*),
|
||||
daxpytest_(int*,doublereal*,doublereal*,int*,doublereal*,int*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*);
|
||||
static integer ki, kn, mx, my;
|
||||
static doublereal sx[7], sy[7], stx[7], sty[7];
|
||||
|
||||
|
|
@ -733,8 +599,7 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* check2_ */
|
||||
|
||||
/* Subroutine */ int check3_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check3_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -753,9 +618,9 @@ doublereal *sfac;
|
|||
;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ int drottest_();
|
||||
extern /* Subroutine */ int drottest_(int*,doublereal*,int*,doublereal*,int*,doublereal*,doublereal*);
|
||||
static integer i__, k, ksize;
|
||||
extern /* Subroutine */int stest_(), drotmtest_();
|
||||
extern /* Subroutine */int stest_(int*,doublereal*,doublereal*,doublereal*,doublereal*), drotmtest_(int*,doublereal*,int*,doublereal*,int*,doublereal*);
|
||||
static integer ki, kn;
|
||||
static doublereal dparam[5], sx[10], sy[10], stx[10], sty[10];
|
||||
|
||||
|
|
@ -826,9 +691,7 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* check3_ */
|
||||
|
||||
/* Subroutine */ int stest_(len, scomp, strue, ssize, sfac)
|
||||
integer *len;
|
||||
doublereal *scomp, *strue, *ssize, *sfac;
|
||||
/* Subroutine */ int stest_(int* len, doublereal* scomp, doublereal* strue, doublereal* ssize, doublereal* sfac)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -836,7 +699,7 @@ doublereal *scomp, *strue, *ssize, *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(doublereal*,doublereal*);
|
||||
static doublereal sd;
|
||||
|
||||
/* ********************************* STEST ************************** */
|
||||
|
|
@ -892,11 +755,10 @@ L40:
|
|||
|
||||
} /* stest_ */
|
||||
|
||||
/* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac)
|
||||
doublereal *scomp1, *strue1, *ssize, *sfac;
|
||||
/* Subroutine */ int stest1_(doublereal* scomp1, doublereal* strue1, doublereal* ssize, doublereal* sfac)
|
||||
{
|
||||
static doublereal scomp[1], strue[1];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(int*, doublereal*, doublereal*, doublereal*, doublereal*);
|
||||
|
||||
/* ************************* STEST1 ***************************** */
|
||||
|
||||
|
|
@ -923,8 +785,7 @@ doublereal *scomp1, *strue1, *ssize, *sfac;
|
|||
return 0;
|
||||
} /* stest1_ */
|
||||
|
||||
doublereal sdiff_(sa, sb)
|
||||
doublereal *sa, *sb;
|
||||
doublereal sdiff_(doublereal* sa, doublereal* sb)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
@ -938,8 +799,7 @@ doublereal *sa, *sb;
|
|||
return ret_val;
|
||||
} /* sdiff_ */
|
||||
|
||||
/* Subroutine */ int itest1_(icomp, itrue)
|
||||
integer *icomp, *itrue;
|
||||
/* Subroutine */ int itest1_(int* icomp, int* itrue)
|
||||
{
|
||||
/* Local variables */
|
||||
static integer id;
|
||||
|
|
@ -1188,4 +1048,4 @@ doublereal *dparam;
|
|||
return 0;
|
||||
} /* drotm_ */
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -242,129 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -395,7 +272,7 @@ static integer c_n1 = -1;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -413,17 +290,21 @@ static logical c_false = FALSE_;
|
|||
static logical same;
|
||||
static integer ninc, nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int dchk1_(), dchk2_(), dchk3_(), dchk4_(),
|
||||
dchk5_(), dchk6_();
|
||||
extern /* Subroutine */ int dchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk6_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
static doublereal a[4225] /* was [65][65] */, g[65];
|
||||
static integer i__, j;
|
||||
extern doublereal ddiff_();
|
||||
extern doublereal ddiff_(doublereal*, doublereal*);
|
||||
static integer n;
|
||||
static logical fatal;
|
||||
static doublereal x[65], y[65], z__[130];
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static char snaps[32], trans[1];
|
||||
static integer isnum;
|
||||
static logical ltest[16];
|
||||
|
|
@ -437,11 +318,11 @@ static logical c_false = FALSE_;
|
|||
static char snamet[12];
|
||||
static doublereal thresh;
|
||||
static logical rorder;
|
||||
extern /* Subroutine */ int cd2chke_();
|
||||
extern /* Subroutine */ void cd2chke_(char*, ftnlen);
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
static doublereal alf[7];
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static integer inc[7], nkb;
|
||||
static doublereal bet[7],eps,err;
|
||||
char tmpchar;
|
||||
|
|
@ -977,21 +858,7 @@ L240:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int dchk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1007,10 +874,10 @@ ftnlen sname_len;
|
|||
static integer incx, incy;
|
||||
static logical full, tran, null;
|
||||
static integer i__, m, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys;
|
||||
|
|
@ -1018,13 +885,14 @@ ftnlen sname_len;
|
|||
static integer ia, ib, ic;
|
||||
static logical banded;
|
||||
static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns;
|
||||
extern /* Subroutine */ int cdgbmv_(), cdgemv_();
|
||||
extern logical lderes_();
|
||||
extern /* Subroutine */ void cdgbmv_(integer*, char*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void cdgemv_(integer*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static char ctrans[14];
|
||||
static doublereal errmax, transl;
|
||||
static char transs[1];
|
||||
static integer laa, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, bls, err;
|
||||
static integer iku, kls, kus;
|
||||
|
||||
|
|
@ -1429,21 +1297,7 @@ L140:
|
|||
|
||||
} /* dchk1_ */
|
||||
|
||||
/* Subroutine */ int dchk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1460,10 +1314,10 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, k, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
|
|
@ -1474,12 +1328,13 @@ ftnlen sname_len;
|
|||
static integer nc, ik, in;
|
||||
static logical packed;
|
||||
static integer nk, ks, ix, iy, ns, lx, ly;
|
||||
extern logical lderes_();
|
||||
extern /* Subroutine */ int cdsbmv_(), cdspmv_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdsbmv_(integer*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void cdspmv_(integer*, char*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
static doublereal errmax, transl;
|
||||
extern /* Subroutine */ int cdsymv_();
|
||||
extern /* Subroutine */ void cdsymv_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
static integer laa, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, bls, err;
|
||||
|
||||
|
||||
|
|
@ -1882,17 +1737,7 @@ L130:
|
|||
|
||||
} /* dchk2_ */
|
||||
|
||||
/* Subroutine */ int dchk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, xt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *xt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* xt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1911,10 +1756,10 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1], cdiag[14];
|
||||
static integer i__, k, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static char diags[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
|
|
@ -1924,16 +1769,19 @@ ftnlen sname_len;
|
|||
static integer nc, ik, in;
|
||||
static logical packed;
|
||||
static integer nk, ks, ix, ns, lx;
|
||||
extern logical lderes_();
|
||||
extern /* Subroutine */ int cdtbmv_(), cdtbsv_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdtbmv_(integer*, char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdtbsv_(integer*, char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char ctrans[14];
|
||||
static doublereal errmax;
|
||||
extern /* Subroutine */ int cdtpmv_(), cdtrmv_();
|
||||
extern /* Subroutine */ void cdtpmv_(integer*, char*, char*, char*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdtrmv_(integer*, char*, char*, char*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal transl;
|
||||
extern /* Subroutine */ int cdtpsv_(), cdtrsv_();
|
||||
extern /* Subroutine */ void cdtpsv_(integer*, char*, char*, char*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdtrsv_(integer*, char*, char*, char*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
static integer laa, icd, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static integer ict, icu;
|
||||
static doublereal err;
|
||||
|
||||
|
|
@ -2388,19 +2236,7 @@ L130:
|
|||
|
||||
} /* dchk3_ */
|
||||
|
||||
/* Subroutine */ int dchk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
|
||||
|
|
@ -2411,17 +2247,18 @@ ftnlen sname_len;
|
|||
static integer incx, incy;
|
||||
static logical null;
|
||||
static integer i__, j, m, n;
|
||||
extern /* Subroutine */ int dmake_(), cdger_();
|
||||
extern /* Subroutine */ void cdger_(integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, integer*);
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys, ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax, transl;
|
||||
static integer laa, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, err;
|
||||
|
||||
|
||||
|
|
@ -2727,19 +2564,7 @@ L150:
|
|||
|
||||
} /* dchk4_ */
|
||||
|
||||
/* Subroutine */ int dchk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2757,25 +2582,25 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int cdspr_();
|
||||
extern /* Subroutine */ void cdspr_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs;
|
||||
extern /* Subroutine */ int cdsyr_();
|
||||
extern /* Subroutine */ void cdsyr_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen);
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
static logical packed;
|
||||
static integer ix, ns, lx;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax, transl;
|
||||
static integer laa, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, err;
|
||||
|
||||
|
||||
|
|
@ -3096,19 +2921,7 @@ L130:
|
|||
|
||||
} /* dchk5_ */
|
||||
|
||||
/* Subroutine */ int dchk6_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk6_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -3125,24 +2938,25 @@ ftnlen sname_len;
|
|||
static logical full, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha, w[2];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int dmvch_();
|
||||
extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ int cdspr2_(), cdsyr2_();
|
||||
extern /* Subroutine */ void cdspr2_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, ftnlen);
|
||||
extern /* Subroutine */ void cdsyr2_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen);
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
static logical packed;
|
||||
static integer ix, iy, ns, lx, ly;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax, transl;
|
||||
static integer laa, lda;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, err;
|
||||
|
||||
/* Tests DSYR2 and DSPR2. */
|
||||
|
|
@ -3508,25 +3322,13 @@ L170:
|
|||
|
||||
} /* dchk6_ */
|
||||
|
||||
/* Subroutine */ int dmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl,
|
||||
ku, reset, transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
doublereal *a;
|
||||
integer *nmax;
|
||||
doublereal *aa;
|
||||
integer *lda, *kl, *ku;
|
||||
logical *reset;
|
||||
doublereal *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int dmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublereal* a, integer* nmax, doublereal* aa, integer* lda, integer* kl, integer* ku, logical* reset, doublereal* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
|
||||
|
||||
/* Local variables */
|
||||
extern doublereal dbeg_();
|
||||
extern doublereal dbeg_(logical* );
|
||||
static integer ibeg, iend, ioff;
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
|
|
@ -3752,28 +3554,14 @@ ftnlen diag_len;
|
|||
|
||||
} /* dmake_ */
|
||||
|
||||
/* Subroutine */ int dmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y,
|
||||
incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len)
|
||||
char *trans;
|
||||
integer *m, *n;
|
||||
doublereal *alpha, *a;
|
||||
integer *nmax;
|
||||
doublereal *x;
|
||||
integer *incx;
|
||||
doublereal *beta, *y;
|
||||
integer *incy;
|
||||
doublereal *yt, *g, *yy, *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen trans_len;
|
||||
/* Subroutine */ int dmvch_(char* trans, integer* m, integer* n, doublereal* alpha, doublereal* a, integer* nmax, doublereal* x, integer* incx, doublereal* beta, doublereal* y, integer* incy, doublereal* yt, doublereal* g, doublereal* yy, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2;
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt();
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static doublereal erri;
|
||||
|
|
@ -3902,9 +3690,7 @@ L70:
|
|||
|
||||
} /* dmvch_ */
|
||||
|
||||
logical lde_(ri, rj, lr)
|
||||
doublereal *ri, *rj;
|
||||
integer *lr;
|
||||
logical lde_(doublereal* ri, doublereal* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -3949,13 +3735,7 @@ L30:
|
|||
|
||||
} /* lde_ */
|
||||
|
||||
logical lderes_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
doublereal *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lderes_(char* type__, char* uplo, integer* m, integer* n, doublereal* aa, doublereal* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2;
|
||||
|
|
@ -4042,8 +3822,7 @@ L80:
|
|||
|
||||
} /* lderes_ */
|
||||
|
||||
doublereal dbeg_(reset)
|
||||
logical *reset;
|
||||
doublereal dbeg_(logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
@ -4094,8 +3873,7 @@ L10:
|
|||
|
||||
} /* dbeg_ */
|
||||
|
||||
doublereal ddiff_(x, y)
|
||||
doublereal *x, *y;
|
||||
doublereal ddiff_(doublereal* x, doublereal* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
|
|||
|
|
@ -242,129 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -393,7 +270,7 @@ static logical c_true = TRUE_;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program MAIN__() */ int main()
|
||||
/* Main program MAIN__() */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -403,25 +280,24 @@ static logical c_false = FALSE_;
|
|||
integer i__1, i__2, i__3;
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(),
|
||||
e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe();
|
||||
integer f_clos();
|
||||
|
||||
/* Local variables */
|
||||
static integer nalf, idim[9];
|
||||
static logical same;
|
||||
static integer nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int dchk1_(), dchk2_(), dchk3_(), dchk4_(),
|
||||
dchk5_();
|
||||
extern /* Subroutine */ int dchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int dchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen);
|
||||
/* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* ab, doublereal* aa, doublereal* as, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, doublereal* w, integer* iorder, ftnlen sname_len);
|
||||
static doublereal c__[4225] /* was [65][65] */, g[65];
|
||||
static integer i__, j;
|
||||
extern doublereal ddiff_();
|
||||
extern doublereal ddiff_(doublereal*, doublereal*);
|
||||
static integer n;
|
||||
static logical fatal;
|
||||
static doublereal w[130];
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
static char snaps[32];
|
||||
|
|
@ -433,11 +309,11 @@ static logical c_false = FALSE_;
|
|||
static char snamet[12], transa[1], transb[1];
|
||||
static doublereal thresh;
|
||||
static logical rorder;
|
||||
extern /* Subroutine */ int cd3chke_();
|
||||
extern /* Subroutine */ void cd3chke_(char*, ftnlen);
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
static doublereal alf[7];
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal bet[7], eps, err;
|
||||
char tmpchar;
|
||||
|
||||
|
|
@ -907,21 +783,7 @@ L230:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int dchk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *nmax;
|
||||
doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -931,29 +793,27 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5, i__6;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal beta;
|
||||
static integer ldas, ldbs, ldcs;
|
||||
static logical same, null;
|
||||
static integer i__, k, m, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical isame[13], trana, tranb;
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
extern /* Subroutine */ void dprcn1_();
|
||||
extern /* Subroutine */ void dprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, ib, ma, mb, na, nb, nc, ik, im, in;
|
||||
extern /* Subroutine */ int cdgemm_();
|
||||
extern /* Subroutine */ void cdgemm_(integer*, char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static integer ks, ms, ns;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static char tranas[1], tranbs[1], transa[1], transb[1];
|
||||
static doublereal errmax;
|
||||
static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als, bls, err;
|
||||
|
||||
/* Tests DGEMM. */
|
||||
|
|
@ -1283,23 +1143,8 @@ L130:
|
|||
|
||||
} /* dchk1_ */
|
||||
|
||||
/* Subroutine */ void dprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *k;
|
||||
doublereal *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ void dprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char crc[14], cta[14], ctb[14];
|
||||
|
|
@ -1328,21 +1173,7 @@ ftnlen transb_len;
|
|||
} /* dprcn1_ */
|
||||
|
||||
|
||||
/* Subroutine */ int dchk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *nmax;
|
||||
doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1353,8 +1184,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal beta;
|
||||
|
|
@ -1364,21 +1193,21 @@ ftnlen sname_len;
|
|||
static logical left, null;
|
||||
static char uplo[1];
|
||||
static integer i__, m, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical isame[13];
|
||||
static char sides[1];
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void dprcn2_();
|
||||
extern /* Subroutine */ void dprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, ib, na, nc, im, in, ms, ns;
|
||||
extern logical lderes_();
|
||||
extern /* Subroutine */ int cdsymm_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdsymm_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static integer ics;
|
||||
static doublereal als, bls;
|
||||
static integer icu;
|
||||
|
|
@ -1692,23 +1521,8 @@ L120:
|
|||
} /* dchk2_ */
|
||||
|
||||
|
||||
/* Subroutine */ void dprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha,
|
||||
lda, ldb, beta, ldc, sname_len, side_len, uplo_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo;
|
||||
integer *m, *n;
|
||||
doublereal *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
/* Subroutine */ void dprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char cs[14], cu[14], crc[14];
|
||||
|
|
@ -1733,19 +1547,7 @@ ftnlen uplo_len;
|
|||
} /* dprcn2_ */
|
||||
|
||||
|
||||
/* Subroutine */ int dchk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__,
|
||||
iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nmax;
|
||||
doublereal *a, *aa, *as, *b, *bb, *bs, *ct, *g, *c__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* ct, doublereal* g, doublereal* c__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1766,24 +1568,24 @@ ftnlen sname_len;
|
|||
static logical left, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, m, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
static char diags[1];
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical isame[13];
|
||||
static char sides[1];
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void dprcn3_();
|
||||
extern /* Subroutine */ void dprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, na, nc, im, in, ms, ns;
|
||||
extern logical lderes_();
|
||||
extern /* Subroutine */ int cdtrmm_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cdtrmm_(integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static char tranas[1], transa[1];
|
||||
extern /* Subroutine */ int cdtrsm_();
|
||||
extern /* Subroutine */ void cdtrsm_(integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
static integer laa, icd, lbb, lda, ldb;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static integer ics;
|
||||
static doublereal als;
|
||||
static integer ict, icu;
|
||||
|
|
@ -2165,24 +1967,8 @@ L160:
|
|||
} /* dchk3_ */
|
||||
|
||||
|
||||
/* Subroutine */ void dprcn3_(nout, nc, sname, iorder, side, uplo, transa,
|
||||
diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len,
|
||||
transa_len, diag_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo, *transa, *diag;
|
||||
integer *m, *n;
|
||||
doublereal *alpha;
|
||||
integer *lda, *ldb;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ void dprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, doublereal* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cd[14], cs[14], cu[14], crc[14];
|
||||
|
|
@ -2219,21 +2005,7 @@ ftnlen diag_len;
|
|||
} /* dprcn3_ */
|
||||
|
||||
|
||||
/* Subroutine */ int dchk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *nmax;
|
||||
doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2244,8 +2016,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal beta;
|
||||
|
|
@ -2255,23 +2025,23 @@ ftnlen sname_len;
|
|||
static logical tran, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, k, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical isame[13];
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char trans[1];
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void dprcn4_();
|
||||
extern /* Subroutine */ void dprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
extern /* Subroutine */ int cdsyrk_();
|
||||
extern /* Subroutine */ void cdsyrk_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
static integer laa, lda, lcc, ldc;
|
||||
extern logical lde_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
static doublereal als;
|
||||
static integer ict, icu;
|
||||
static doublereal err;
|
||||
|
|
@ -2586,23 +2356,8 @@ L130:
|
|||
} /* dchk4_ */
|
||||
|
||||
|
||||
/* Subroutine */ void dprcn4_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublereal *alpha;
|
||||
integer *lda;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ void dprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -2629,21 +2384,7 @@ ftnlen transa_len;
|
|||
} /* dprcn4_ */
|
||||
|
||||
|
||||
/* Subroutine */ int dchk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs,
|
||||
c__, cc, cs, ct, g, w, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublereal *alf;
|
||||
integer *nbet;
|
||||
doublereal *bet;
|
||||
integer *nmax;
|
||||
doublereal *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct, *g, *w;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* ab, doublereal* aa, doublereal* as, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, doublereal* w, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2653,8 +2394,6 @@ ftnlen sname_len;
|
|||
/* System generated locals */
|
||||
integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static integer jjab;
|
||||
|
|
@ -2665,23 +2404,23 @@ ftnlen sname_len;
|
|||
static logical tran, null;
|
||||
static char uplo[1];
|
||||
static integer i__, j, k, n;
|
||||
extern /* Subroutine */ int dmake_();
|
||||
extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen);
|
||||
static doublereal alpha;
|
||||
extern /* Subroutine */ int dmmch_();
|
||||
extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical isame[13];
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char trans[1];
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void dprcn5_();
|
||||
extern /* Subroutine */ void dprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns;
|
||||
extern logical lderes_();
|
||||
extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
static char transs[1];
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc;
|
||||
extern logical lde_();
|
||||
extern /* Subroutine */ int cdsyr2k_();
|
||||
extern logical lde_(doublereal*, doublereal*, integer*);
|
||||
extern /* Subroutine */ void cdsyr2k_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen);
|
||||
static doublereal als;
|
||||
static integer ict, icu;
|
||||
static doublereal err;
|
||||
|
|
@ -3048,23 +2787,8 @@ L160:
|
|||
} /* dchk5_ */
|
||||
|
||||
|
||||
/* Subroutine */ void dprcn5_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublereal *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ void dprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -3091,25 +2815,13 @@ ftnlen transa_len;
|
|||
} /* dprcn5_ */
|
||||
|
||||
|
||||
/* Subroutine */ int dmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset,
|
||||
transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
doublereal *a;
|
||||
integer *nmax;
|
||||
doublereal *aa;
|
||||
integer *lda;
|
||||
logical *reset;
|
||||
doublereal *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int dmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublereal* a, integer* nmax, doublereal* aa, integer* lda, logical* reset, doublereal* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2;
|
||||
|
||||
/* Local variables */
|
||||
extern doublereal dbeg_();
|
||||
extern doublereal dbeg_(logical*);
|
||||
static integer ibeg, iend;
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
|
|
@ -3241,25 +2953,7 @@ ftnlen diag_len;
|
|||
|
||||
} /* dmake_ */
|
||||
|
||||
/* Subroutine */ int dmmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb,
|
||||
beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv,
|
||||
transa_len, transb_len)
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *kk;
|
||||
doublereal *alpha, *a;
|
||||
integer *lda;
|
||||
doublereal *b;
|
||||
integer *ldb;
|
||||
doublereal *beta, *c__;
|
||||
integer *ldc;
|
||||
doublereal *ct, *g, *cc;
|
||||
integer *ldcc;
|
||||
doublereal *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ int dmmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, doublereal* alpha, doublereal* a, integer* lda, doublereal* b, integer* ldb, doublereal* beta, doublereal* c__, integer* ldc, doublereal* ct, doublereal* g, doublereal* cc, integer* ldcc, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1,
|
||||
|
|
@ -3267,8 +2961,7 @@ ftnlen transb_len;
|
|||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt();
|
||||
integer s_wsfe(), e_wsfe(), do_fio();
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static doublereal erri;
|
||||
|
|
@ -3432,9 +3125,7 @@ L150:
|
|||
|
||||
} /* dmmch_ */
|
||||
|
||||
logical lde_(ri, rj, lr)
|
||||
doublereal *ri, *rj;
|
||||
integer *lr;
|
||||
logical lde_(doublereal* ri, doublereal* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -3481,13 +3172,7 @@ L30:
|
|||
|
||||
} /* lde_ */
|
||||
|
||||
logical lderes_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
doublereal *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lderes_(char* type__, char* uplo, integer* m, integer* n, doublereal* aa, doublereal* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2;
|
||||
|
|
@ -3576,8 +3261,7 @@ L80:
|
|||
|
||||
} /* lderes_ */
|
||||
|
||||
doublereal dbeg_(reset)
|
||||
logical *reset;
|
||||
doublereal dbeg_(logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
@ -3629,8 +3313,7 @@ L10:
|
|||
|
||||
} /* dbeg_ */
|
||||
|
||||
doublereal ddiff_(x, y)
|
||||
doublereal *x, *y;
|
||||
doublereal ddiff_(doublereal* x, doublereal* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
|
|||
|
|
@ -21,19 +21,6 @@ typedef float real;
|
|||
typedef double doublereal;
|
||||
typedef struct { real r, i; } complex;
|
||||
typedef struct { doublereal r, i; } doublecomplex;
|
||||
#ifdef _MSC_VER
|
||||
static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;}
|
||||
static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;}
|
||||
static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;}
|
||||
static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;}
|
||||
#else
|
||||
static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
|
||||
static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
|
||||
#endif
|
||||
#define pCf(z) (*_pCf(z))
|
||||
#define pCd(z) (*_pCd(z))
|
||||
typedef int logical;
|
||||
typedef short int shortlogical;
|
||||
typedef char logical1;
|
||||
|
|
@ -242,250 +229,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
#if 0
|
||||
static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i]) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i]) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -502,16 +245,16 @@ struct {
|
|||
static integer c__1 = 1;
|
||||
static real c_b34 = (float)1.;
|
||||
|
||||
/* Main program */ int main ()
|
||||
/* Main program */ int main (void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static real sfac = (float)9.765625e-4;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ int check0_(), check1_(), check2_(), check3_();
|
||||
extern /* Subroutine */ int check0_(real*), check1_(real*), check2_(real*), check3_(real*);
|
||||
static integer ic;
|
||||
extern /* Subroutine */ int header_();
|
||||
extern /* Subroutine */ int header_(void);
|
||||
|
||||
/* Test program for the REAL Level 1 CBLAS. */
|
||||
/* Based upon the original CBLAS test routine together with: */
|
||||
|
|
@ -557,7 +300,7 @@ static real c_b34 = (float)1.;
|
|||
exit(0);
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int header_()
|
||||
/* Subroutine */ int header_(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -580,8 +323,7 @@ static real c_b34 = (float)1.;
|
|||
|
||||
} /* header_ */
|
||||
|
||||
/* Subroutine */ int check0_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check0_(real *sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -600,7 +342,7 @@ real *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer k;
|
||||
extern /* Subroutine */ int srotgtest_(), stest1_();
|
||||
extern /* Subroutine */ int srotgtest_(real*,real*,real*,real*), stest1_(real*,real*,real*,real*);
|
||||
static real sa, sb, sc, ss;
|
||||
|
||||
/* .. Parameters .. */
|
||||
|
|
@ -645,8 +387,7 @@ L40:
|
|||
return 0;
|
||||
} /* check0_ */
|
||||
|
||||
/* Subroutine */ int check1_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check1_(real* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -692,14 +433,14 @@ real *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern real snrm2test_();
|
||||
extern real snrm2test_(int*,real*,int*);
|
||||
static real stemp[1], strue[8];
|
||||
extern /* Subroutine */ int stest_(), sscaltest_();
|
||||
extern real sasumtest_();
|
||||
extern /* Subroutine */ int itest1_(), stest1_();
|
||||
extern /* Subroutine */ int stest_(int*, real*,real*,real*,real*), sscaltest_(int*,real*,real*,int*);
|
||||
extern real sasumtest_(int*,real*,int*);
|
||||
extern /* Subroutine */ int itest1_(int*,int*), stest1_(real*,real*,real*,real*);
|
||||
static real sx[8];
|
||||
static integer np1;
|
||||
extern integer isamaxtest_();
|
||||
extern integer isamaxtest_(int*,real*,int*);
|
||||
static integer len;
|
||||
|
||||
|
||||
|
|
@ -761,8 +502,7 @@ real *sfac;
|
|||
return 0;
|
||||
} /* check1_ */
|
||||
|
||||
/* Subroutine */ int check2_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check2_(real* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -850,12 +590,12 @@ real *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer lenx, leny;
|
||||
extern real sdottest_();
|
||||
extern real sdottest_(int*,real*,int*,real*,int*);
|
||||
static integer i__, j, ksize;
|
||||
extern /* Subroutine */ int stest_(), scopytest_(), sswaptest_(),
|
||||
saxpytest_();
|
||||
extern /* Subroutine */ int stest_(int*,real*,real*,real*,real*), scopytest_(int*,real*,int*,real*,int*), sswaptest_(int*,real*,int*,real*,int*),
|
||||
saxpytest_(int*,real*,real*,int*,real*,int*);
|
||||
static integer ki;
|
||||
extern /* Subroutine */ int stest1_();
|
||||
extern /* Subroutine */ int stest1_(real*,real*,real*,real*);
|
||||
static integer kn, mx, my;
|
||||
static real sx[7], sy[7], stx[7], sty[7];
|
||||
|
||||
|
|
@ -936,8 +676,7 @@ real *sfac;
|
|||
return 0;
|
||||
} /* check2_ */
|
||||
|
||||
/* Subroutine */ int check3_(sfac)
|
||||
real *sfac;
|
||||
/* Subroutine */ int check3_(real* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -969,9 +708,9 @@ real *sfac;
|
|||
1.17 };
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ void srottest_();
|
||||
extern /* Subroutine */ void srottest_(int*,real*,int*,real*,int*,real*,real*);
|
||||
static integer i__, k, ksize;
|
||||
extern /* Subroutine */ int stest_(), srotmtest_();
|
||||
extern /* Subroutine */ int stest_(int*,real*,real*,real*,real*), srotmtest_(int*,real*,int*,real*,int*,real*);
|
||||
static integer ki, kn;
|
||||
static real sx[19], sy[19], sparam[5], stx[19], sty[19];
|
||||
|
||||
|
|
@ -1042,16 +781,14 @@ real *sfac;
|
|||
return 0;
|
||||
} /* check3_ */
|
||||
|
||||
/* Subroutine */ int stest_(len, scomp, strue, ssize, sfac)
|
||||
integer *len;
|
||||
real *scomp, *strue, *ssize, *sfac;
|
||||
/* Subroutine */ int stest_(int* len, real* scomp, real* strue, real* ssize, real* sfac)
|
||||
{
|
||||
integer i__1;
|
||||
real r__1, r__2, r__3, r__4, r__5;
|
||||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(real*,real*);
|
||||
static real sd;
|
||||
|
||||
/* ********************************* STEST ************************** */
|
||||
|
|
@ -1107,11 +844,10 @@ L40:
|
|||
|
||||
} /* stest_ */
|
||||
|
||||
/* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac)
|
||||
real *scomp1, *strue1, *ssize, *sfac;
|
||||
/* Subroutine */ int stest1_(real* scomp1, real* strue1, real* ssize, real* sfac)
|
||||
{
|
||||
static real scomp[1], strue[1];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(int*,real*,real*,real*,real*);
|
||||
|
||||
/* ************************* STEST1 ***************************** */
|
||||
|
||||
|
|
@ -1138,8 +874,7 @@ real *scomp1, *strue1, *ssize, *sfac;
|
|||
return 0;
|
||||
} /* stest1_ */
|
||||
|
||||
doublereal sdiff_(sa, sb)
|
||||
real *sa, *sb;
|
||||
doublereal sdiff_(real* sa, real* sb)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
@ -1153,8 +888,7 @@ real *sa, *sb;
|
|||
return ret_val;
|
||||
} /* sdiff_ */
|
||||
|
||||
/* Subroutine */ int itest1_(icomp, itrue)
|
||||
integer *icomp, *itrue;
|
||||
/* Subroutine */ int itest1_(integer* icomp, integer* itrue)
|
||||
{
|
||||
/* Local variables */
|
||||
static integer id;
|
||||
|
|
|
|||
|
|
@ -242,255 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
#if 0
|
||||
static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i]) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i]) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -521,7 +272,7 @@ static integer c_n1 = -1;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -539,16 +290,20 @@ static logical c_false = FALSE_;
|
|||
static logical same;
|
||||
static integer ninc, nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int schk1_(), schk2_(), schk3_(), schk4_(),
|
||||
schk5_(), schk6_();
|
||||
extern /* Subroutine */ int schk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len);
|
||||
static real a[4225] /* was [65][65] */, g[65];
|
||||
static integer i__, j, n;
|
||||
static logical fatal;
|
||||
static real x[65], y[65], z__[130];
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(real*, real*);
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static char snaps[32], trans[1];
|
||||
static integer isnum;
|
||||
static logical ltest[16];
|
||||
|
|
@ -564,12 +319,12 @@ static logical c_false = FALSE_;
|
|||
static logical rorder;
|
||||
static integer layout;
|
||||
static logical ltestt;
|
||||
extern /* Subroutine */ int cs2chke_();
|
||||
extern /* Subroutine */ int cs2chke_(char*, ftnlen);
|
||||
static logical tsterr;
|
||||
static real alf[7];
|
||||
static integer inc[7], nkb;
|
||||
static real bet[7];
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real eps, err;
|
||||
char tmpchar;
|
||||
|
||||
|
|
@ -1098,21 +853,7 @@ L240:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int schk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, real* alf, integer* nbet, real* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1130,24 +871,25 @@ ftnlen sname_len;
|
|||
static integer i__, m, n;
|
||||
static real alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static integer incxs, incys;
|
||||
static char trans[1];
|
||||
static integer ia, ib, ic;
|
||||
static logical banded;
|
||||
static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns;
|
||||
extern /* Subroutine */ int csgbmv_(), csgemv_();
|
||||
extern /* Subroutine */ void csgbmv_(integer*, char*, integer*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void csgemv_(integer*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen);
|
||||
static char ctrans[14];
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len);
|
||||
static real transl;
|
||||
static char transs[1];
|
||||
static integer laa, lda;
|
||||
static real als, bls;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
static integer iku, kls, kus;
|
||||
|
||||
|
|
@ -1552,21 +1294,7 @@ L140:
|
|||
|
||||
} /* schk1_ */
|
||||
|
||||
/* Subroutine */ int schk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, real* alf, integer* nbet, real* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1585,9 +1313,9 @@ ftnlen sname_len;
|
|||
static integer i__, k, n;
|
||||
static real alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
|
|
@ -1598,13 +1326,14 @@ ftnlen sname_len;
|
|||
static logical packed;
|
||||
static integer nk, ks, ix, iy, ns, lx, ly;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern /* Subroutine */ int cssbmv_();
|
||||
extern logical lseres_(char* , char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cssbmv_(integer*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen);
|
||||
static real transl;
|
||||
extern /* Subroutine */ int csspmv_(), cssymv_();
|
||||
extern /* Subroutine */ void csspmv_(integer*, char*, integer*, real*, real*, real*, integer*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void cssymv_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen);
|
||||
static integer laa, lda;
|
||||
static real als, bls;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYMV, SSBMV and SSPMV. */
|
||||
|
|
@ -2003,17 +1732,7 @@ L130:
|
|||
|
||||
} /* schk2_ */
|
||||
|
||||
/* Subroutine */ int schk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, xt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *xt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* xt, real* g, real* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2034,9 +1753,9 @@ ftnlen sname_len;
|
|||
static integer i__, k, n;
|
||||
static char diags[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs;
|
||||
|
|
@ -2047,14 +1766,17 @@ ftnlen sname_len;
|
|||
static integer nk, ks, ix, ns, lx;
|
||||
static char ctrans[14];
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern /* Subroutine */ int cstbmv_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstbmv_(integer*, char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static real transl;
|
||||
extern /* Subroutine */ int cstbsv_();
|
||||
extern /* Subroutine */ void cstbsv_(integer*, char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
extern /* Subroutine */ int cstpmv_(), cstrmv_(), cstpsv_(), cstrsv_();
|
||||
extern /* Subroutine */ void cstpmv_(integer*, char*, char*, char*, integer*, real*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstrmv_(integer*, char*, char*, char*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstpsv_(integer*, char*, char*, char*, integer*, real*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstrsv_(integer*, char*, char*, char*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer laa, icd, lda, ict, icu;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests STRMV, STBMV, STPMV, STRSV, STBSV and STPSV. */
|
||||
|
|
@ -2508,19 +2230,7 @@ L130:
|
|||
|
||||
} /* schk3_ */
|
||||
|
||||
/* Subroutine */ int schk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
|
||||
|
|
@ -2533,17 +2243,18 @@ ftnlen sname_len;
|
|||
static integer i__, j, m, n;
|
||||
static real alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_(), csger_();
|
||||
/* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void csger_(integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, integer*);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static integer incxs, incys, ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lseres_(char* , char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
static real transl;
|
||||
static integer laa, lda;
|
||||
static real als;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SGER. */
|
||||
|
|
@ -2848,19 +2559,7 @@ L150:
|
|||
|
||||
} /* schk4_ */
|
||||
|
||||
/* Subroutine */ int schk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2880,25 +2579,25 @@ ftnlen sname_len;
|
|||
static integer i__, j, n;
|
||||
static real alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs;
|
||||
extern /* Subroutine */ int csspr_();
|
||||
extern /* Subroutine */ void csspr_(integer*, char*, integer*, real*, real*, integer*, real*, ftnlen);
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ int cssyr_();
|
||||
extern /* Subroutine */ void cssyr_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, ftnlen);
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
static logical packed;
|
||||
static integer ix, ns, lx;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
static real transl;
|
||||
static integer laa, lda;
|
||||
static real als;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYR and SSPR. */
|
||||
|
|
@ -3218,19 +2917,7 @@ L130:
|
|||
|
||||
} /* schk5_ */
|
||||
|
||||
/* Subroutine */ int schk6_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -3249,26 +2936,26 @@ ftnlen sname_len;
|
|||
static integer i__, j, n;
|
||||
static real alpha, w[2];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int smvch_();
|
||||
extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ja, ic;
|
||||
extern /* Subroutine */ int csspr2_();
|
||||
extern /* Subroutine */ void csspr2_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, ftnlen);
|
||||
static integer nc, jj, lj, in;
|
||||
static logical packed;
|
||||
extern /* Subroutine */ int cssyr2_();
|
||||
extern /* Subroutine */ void cssyr2_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, integer*, ftnlen);
|
||||
static integer ix, iy, ns, lx, ly;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len);
|
||||
static real transl;
|
||||
static integer laa, lda;
|
||||
static real als;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYR2 and SSPR2. */
|
||||
|
|
@ -3634,26 +3321,14 @@ L170:
|
|||
|
||||
} /* schk6_ */
|
||||
|
||||
/* Subroutine */ int smake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl,
|
||||
ku, reset, transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
real *a;
|
||||
integer *nmax;
|
||||
real *aa;
|
||||
integer *lda, *kl, *ku;
|
||||
logical *reset;
|
||||
real *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
{
|
||||
/* Subroutine */ int smake_(char* type__, char* uplo, char* diag, integer* m, integer* n, real* a, integer* nmax, real* aa, integer* lda, integer* kl, integer* ku, logical* reset, real* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
|
||||
|
||||
/* Local variables */
|
||||
static integer ibeg, iend;
|
||||
extern doublereal sbeg_();
|
||||
extern doublereal sbeg_(logical*);
|
||||
static integer ioff;
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
|
|
@ -3879,28 +3554,14 @@ ftnlen diag_len;
|
|||
|
||||
} /* smake_ */
|
||||
|
||||
/* Subroutine */ int smvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y,
|
||||
incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len)
|
||||
char *trans;
|
||||
integer *m, *n;
|
||||
real *alpha, *a;
|
||||
integer *nmax;
|
||||
real *x;
|
||||
integer *incx;
|
||||
real *beta, *y;
|
||||
integer *incy;
|
||||
real *yt, *g, *yy, *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen trans_len;
|
||||
/* Subroutine */ int smvch_(char* trans, integer* m, integer* n, real* alpha, real* a, integer* nmax, real* x, integer* incx, real* beta, real* y, integer* incy, real* yt, real* g, real* yy, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2;
|
||||
real r__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt();
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static real erri;
|
||||
|
|
@ -4029,9 +3690,7 @@ L70:
|
|||
|
||||
} /* smvch_ */
|
||||
|
||||
logical lse_(ri, rj, lr)
|
||||
real *ri, *rj;
|
||||
integer *lr;
|
||||
logical lse_(real* ri, real* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -4076,13 +3735,7 @@ L30:
|
|||
|
||||
} /* lse_ */
|
||||
|
||||
logical lseres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
real *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2;
|
||||
|
|
@ -4169,8 +3822,7 @@ L80:
|
|||
|
||||
} /* lseres_ */
|
||||
|
||||
doublereal sbeg_(reset)
|
||||
logical *reset;
|
||||
doublereal sbeg_(logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
@ -4221,8 +3873,7 @@ L10:
|
|||
|
||||
} /* sbeg_ */
|
||||
|
||||
doublereal sdiff_(x, y)
|
||||
real *x, *y;
|
||||
doublereal sdiff_(real* x, real* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
|
|||
|
|
@ -242,129 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -393,7 +270,7 @@ static logical c_true = TRUE_;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program MAIN__() */ int main()
|
||||
/* Main program MAIN__() */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -402,26 +279,25 @@ static logical c_false = FALSE_;
|
|||
/* System generated locals */
|
||||
integer i__1, i__2, i__3;
|
||||
real r__1;
|
||||
/* Builtin functions */
|
||||
integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(),
|
||||
e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe();
|
||||
integer f_clos();
|
||||
|
||||
/* Local variables */
|
||||
static integer nalf, idim[9];
|
||||
static logical same;
|
||||
static integer nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int schk1_(), schk2_(), schk3_(), schk4_(),
|
||||
schk5_();
|
||||
extern /* Subroutine */ int schk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int schk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen);
|
||||
static real c__[4225] /* was [65][65] */, g[65];
|
||||
static integer i__, j, n;
|
||||
static logical fatal;
|
||||
static real w[130];
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(real*, real*);
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
extern /* Subroutine */ int smmch_();
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static char snaps[32];
|
||||
static integer isnum;
|
||||
static logical ltest[6];
|
||||
|
|
@ -433,9 +309,9 @@ static logical c_false = FALSE_;
|
|||
static logical rorder;
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
extern /* Subroutine */ int cs3chke_();
|
||||
extern /* Subroutine */ void cs3chke_(char*, ftnlen);
|
||||
static real alf[7], bet[7];
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real eps, err;
|
||||
char tmpchar;
|
||||
|
||||
|
|
@ -899,21 +775,7 @@ L230:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int schk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *nmax;
|
||||
real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -923,8 +785,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5, i__6;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static real beta;
|
||||
|
|
@ -936,18 +796,17 @@ ftnlen sname_len;
|
|||
static logical trana, tranb;
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
extern /* Subroutine */ void sprcn1_();
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smmch_();
|
||||
extern /* Subroutine */ void sprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static integer ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns;
|
||||
extern /* Subroutine */ int csgemm_();
|
||||
extern /* Subroutine */ void csgemm_(integer*, char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
static char tranas[1], tranbs[1], transa[1], transb[1];
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lse_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc;
|
||||
static real als, bls;
|
||||
extern logical lse_();
|
||||
static real err;
|
||||
|
||||
/* Tests SGEMM. */
|
||||
|
|
@ -1278,23 +1137,8 @@ L130:
|
|||
|
||||
|
||||
|
||||
/* Subroutine */ void sprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *k;
|
||||
real *alpha;
|
||||
integer *lda, *ldb;
|
||||
real *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ void sprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char crc[14], cta[14], ctb[14];
|
||||
|
|
@ -1324,21 +1168,7 @@ ftnlen transb_len;
|
|||
} /* sprcn1_ */
|
||||
|
||||
|
||||
/* Subroutine */ int schk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *nmax;
|
||||
real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1349,8 +1179,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static real beta;
|
||||
|
|
@ -1368,15 +1196,15 @@ ftnlen sname_len;
|
|||
static char uplos[1];
|
||||
static integer ia, ib, na, nc, im, in, ms, ns;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern /* Subroutine */ int cssymm_();
|
||||
extern void sprcn2_();
|
||||
extern int smake_();
|
||||
extern int smmch_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cssymm_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern void sprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc, ics;
|
||||
static real als, bls;
|
||||
static integer icu;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYMM. */
|
||||
|
|
@ -1685,23 +1513,8 @@ L120:
|
|||
} /* schk2_ */
|
||||
|
||||
|
||||
/* Subroutine */ void sprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha,
|
||||
lda, ldb, beta, ldc, sname_len, side_len, uplo_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo;
|
||||
integer *m, *n;
|
||||
real *alpha;
|
||||
integer *lda, *ldb;
|
||||
real *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
/* Subroutine */ void sprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char cs[14], cu[14], crc[14];
|
||||
|
|
@ -1726,19 +1539,7 @@ ftnlen uplo_len;
|
|||
} /* sprcn2_ */
|
||||
|
||||
|
||||
/* Subroutine */ int schk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__,
|
||||
iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *nmax;
|
||||
real *a, *aa, *as, *b, *bb, *bs, *ct, *g, *c__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* ct, real* g, real* c__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1751,8 +1552,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static char diag[1];
|
||||
|
|
@ -1769,18 +1568,19 @@ ftnlen sname_len;
|
|||
static integer nargs;
|
||||
static logical reset;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void sprcn3_();
|
||||
extern /* Subroutine */ void sprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, real*, integer*, integer*, ftnlen , ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static integer ia, na, nc, im, in, ms, ns;
|
||||
static char tranas[1], transa[1];
|
||||
static real errmax;
|
||||
extern int smake_();
|
||||
extern int smmch_();
|
||||
extern logical lseres_();
|
||||
extern /* Subroutine */ int cstrmm_(), cstrsm_();
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstrmm_(integer*, char*, char*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cstrsm_(integer*, char*, char*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static integer laa, icd, lbb, lda, ldb, ics;
|
||||
static real als;
|
||||
static integer ict, icu;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests STRMM and STRSM. */
|
||||
|
|
@ -2155,24 +1955,8 @@ L160:
|
|||
} /* schk3_ */
|
||||
|
||||
|
||||
/* Subroutine */ void sprcn3_(nout, nc, sname, iorder, side, uplo, transa,
|
||||
diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len,
|
||||
transa_len, diag_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo, *transa, *diag;
|
||||
integer *m, *n;
|
||||
real *alpha;
|
||||
integer *lda, *ldb;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ void sprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, real* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cd[14], cs[14], cu[14], crc[14];
|
||||
|
|
@ -2210,21 +1994,7 @@ ftnlen diag_len;
|
|||
} /* sprcn3_ */
|
||||
|
||||
|
||||
/* Subroutine */ int schk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *nmax;
|
||||
real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2235,8 +2005,6 @@ ftnlen sname_len;
|
|||
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4, i__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static real beta;
|
||||
|
|
@ -2253,18 +2021,18 @@ ftnlen sname_len;
|
|||
static char trans[1];
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ void sprcn4_();
|
||||
extern /* Subroutine */ int smake_();
|
||||
extern /* Subroutine */ int smmch_();
|
||||
extern /* Subroutine */ void sprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
extern /* Subroutine */ int cssyrk_();
|
||||
extern /* Subroutine */ void cssyrk_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lda, lcc, ldc;
|
||||
static real als;
|
||||
static integer ict, icu;
|
||||
extern logical lse_();
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYRK. */
|
||||
|
|
@ -2575,23 +2343,8 @@ L130:
|
|||
} /* schk4_ */
|
||||
|
||||
|
||||
/* Subroutine */ void sprcn4_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
real *alpha;
|
||||
integer *lda;
|
||||
real *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ void sprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, real* alpha, integer* lda, real* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -2619,21 +2372,7 @@ ftnlen transa_len;
|
|||
} /* sprcn4_ */
|
||||
|
||||
|
||||
/* Subroutine */ int schk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs,
|
||||
c__, cc, cs, ct, g, w, iorder, sname_len)
|
||||
char *sname;
|
||||
real *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
real *alf;
|
||||
integer *nbet;
|
||||
real *bet;
|
||||
integer *nmax;
|
||||
real *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct, *g, *w;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int schk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* ab, real* aa, real* as, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, real* w, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2643,8 +2382,6 @@ ftnlen sname_len;
|
|||
/* System generated locals */
|
||||
integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
|
||||
|
||||
/* Builtin functions */
|
||||
integer f_rew(), s_wsfe(), e_wsfe(), do_fio();
|
||||
|
||||
/* Local variables */
|
||||
static integer jjab;
|
||||
|
|
@ -2663,18 +2400,18 @@ ftnlen sname_len;
|
|||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ib;
|
||||
extern /* Subroutine */ void sprcn5_();
|
||||
extern /* Subroutine */ void sprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer jc, ma, na, nc, ik, in, jj, lj, ks, ns;
|
||||
static real errmax;
|
||||
extern logical lseres_();
|
||||
extern int smake_();
|
||||
extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc;
|
||||
static real als;
|
||||
static integer ict, icu;
|
||||
extern /* Subroutine */ int cssyr2k_();
|
||||
extern logical lse_();
|
||||
extern int smmch_();
|
||||
extern /* Subroutine */ void cssyr2k_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen);
|
||||
extern logical lse_(real*, real*, integer*);
|
||||
extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static real err;
|
||||
|
||||
/* Tests SSYR2K. */
|
||||
|
|
@ -3037,23 +2774,8 @@ L160:
|
|||
} /* schk5_ */
|
||||
|
||||
|
||||
/* Subroutine */ void sprcn5_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
real *alpha;
|
||||
integer *lda, *ldb;
|
||||
real *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ void sprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), do_fio(), e_wsfe();
|
||||
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -3081,19 +2803,7 @@ ftnlen transa_len;
|
|||
} /* sprcn5_ */
|
||||
|
||||
|
||||
/* Subroutine */ int smake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset,
|
||||
transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
real *a;
|
||||
integer *nmax;
|
||||
real *aa;
|
||||
integer *lda;
|
||||
logical *reset;
|
||||
real *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int smake_(char* type__, char* uplo, char* diag, integer* m, integer* n, real* a, integer* nmax, real* aa, integer* lda, logical* reset, real* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2;
|
||||
|
|
@ -3102,7 +2812,7 @@ ftnlen diag_len;
|
|||
|
||||
/* Local variables */
|
||||
static integer ibeg, iend;
|
||||
extern doublereal sbeg_();
|
||||
extern doublereal sbeg_(logical*);
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
static logical lower, upper, gen, tri, sym;
|
||||
|
|
@ -3233,25 +2943,7 @@ ftnlen diag_len;
|
|||
|
||||
} /* smake_ */
|
||||
|
||||
/* Subroutine */ int smmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb,
|
||||
beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv,
|
||||
transa_len, transb_len)
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *kk;
|
||||
real *alpha, *a;
|
||||
integer *lda;
|
||||
real *b;
|
||||
integer *ldb;
|
||||
real *beta, *c__;
|
||||
integer *ldc;
|
||||
real *ct, *g, *cc;
|
||||
integer *ldcc;
|
||||
real *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ int smmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, real* alpha, real* a, integer* lda, real* b, integer* ldb, real* beta, real* c__, integer* ldc, real* ct, real* g, real* cc, integer* ldcc, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
|
||||
/* System generated locals */
|
||||
|
|
@ -3260,8 +2952,7 @@ ftnlen transb_len;
|
|||
real r__1, r__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt();
|
||||
integer s_wsfe(), e_wsfe(), do_fio();
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static real erri;
|
||||
|
|
@ -3426,9 +3117,7 @@ L150:
|
|||
|
||||
} /* smmch_ */
|
||||
|
||||
logical lse_(ri, rj, lr)
|
||||
real *ri, *rj;
|
||||
integer *lr;
|
||||
logical lse_(real* ri, real* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
|
@ -3475,13 +3164,7 @@ L30:
|
|||
|
||||
} /* lse_ */
|
||||
|
||||
logical lseres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
real *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2;
|
||||
|
|
@ -3572,8 +3255,7 @@ L80:
|
|||
|
||||
} /* lseres_ */
|
||||
|
||||
doublereal sbeg_(reset)
|
||||
logical *reset;
|
||||
doublereal sbeg_(logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
@ -3625,8 +3307,7 @@ L10:
|
|||
|
||||
} /* sbeg_ */
|
||||
|
||||
doublereal sdiff_(x, y)
|
||||
real *x, *y;
|
||||
doublereal sdiff_(real* x, real* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
real ret_val;
|
||||
|
|
|
|||
|
|
@ -242,250 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
#if 0
|
||||
static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Fcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex float zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i]) * Cf(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCf(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
|
||||
integer n = *n_, incx = *incx_, incy = *incy_, i;
|
||||
#ifdef _MSC_VER
|
||||
_Dcomplex zdotc = {0.0, 0.0};
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1];
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0];
|
||||
zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1];
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#else
|
||||
_Complex double zdotc = 0.0;
|
||||
if (incx == 1 && incy == 1) {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i]) * Cd(&y[i]);
|
||||
}
|
||||
} else {
|
||||
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
|
||||
zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
|
||||
}
|
||||
}
|
||||
pCd(z) = zdotc;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
||||
|
|
@ -502,16 +258,16 @@ static integer c__1 = 1;
|
|||
static integer c__5 = 5;
|
||||
static doublereal c_b43 = 1.;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static doublereal sfac = 9.765625e-4;
|
||||
|
||||
/* Local variables */
|
||||
extern /* Subroutine */ int check1_(), check2_();
|
||||
extern /* Subroutine */ int check1_(doublereal*), check2_(doublereal*);
|
||||
static integer ic;
|
||||
extern /* Subroutine */ int header_();
|
||||
extern /* Subroutine */ int header_(void);
|
||||
|
||||
/* Test program for the COMPLEX*16 Level 1 CBLAS. */
|
||||
/* Based upon the original CBLAS test routine together with: */
|
||||
|
|
@ -551,7 +307,7 @@ static doublereal c_b43 = 1.;
|
|||
exit(0);
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int header_()
|
||||
/* Subroutine */ int header_(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -570,8 +326,7 @@ static doublereal c_b43 = 1.;
|
|||
|
||||
} /* header_ */
|
||||
|
||||
/* Subroutine */ int check1_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check1_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -623,15 +378,15 @@ doublereal *sfac;
|
|||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern /* Subroutine */ int ctest_();
|
||||
extern /* Subroutine */ int ctest_(int*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*);
|
||||
static doublecomplex mwpcs[5], mwpct[5];
|
||||
extern /* Subroutine */ int zscaltest_(), itest1_(), stest1_();
|
||||
extern /* Subroutine */ int zscaltest_(int*, doublereal*, doublecomplex*, int*), itest1_(int*, int*), stest1_(doublereal*, doublereal*, doublereal*, doublereal*);
|
||||
static doublecomplex cx[8];
|
||||
extern doublereal dznrm2test_();
|
||||
extern doublereal dznrm2test_(integer*, doublecomplex*, integer*);
|
||||
static integer np1;
|
||||
extern /* Subroutine */ int zdscaltest_();
|
||||
extern integer izamaxtest_();
|
||||
extern doublereal dzasumtest_();
|
||||
extern /* Subroutine */ int zdscaltest_(integer*, doublereal*, doublecomplex*, integer*);
|
||||
extern integer izamaxtest_(integer*, doublecomplex*, integer*);
|
||||
extern doublereal dzasumtest_(integer*, doublecomplex*, integer*);
|
||||
static integer len;
|
||||
|
||||
/* .. Parameters .. */
|
||||
|
|
@ -748,8 +503,7 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* check1_ */
|
||||
|
||||
/* Subroutine */ int check2_(sfac)
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int check2_(doublereal* sfac)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -834,14 +588,14 @@ doublereal *sfac;
|
|||
/* Local variables */
|
||||
static doublecomplex cdot[1];
|
||||
static integer lenx, leny, i__;
|
||||
extern /* Subroutine */ int ctest_();
|
||||
extern /* Subroutine */ int ctest_(int*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*);
|
||||
static integer ksize;
|
||||
static doublecomplex ztemp;
|
||||
extern /* Subroutine */ int zdotctest_(), zcopytest_();
|
||||
extern /* Subroutine */ int zdotctest_(int*, doublecomplex*, int*, doublecomplex*, int*, doublecomplex*), zcopytest_(int*, doublecomplex*, int*, doublecomplex*, int*);
|
||||
static integer ki;
|
||||
extern /* Subroutine */ int zdotutest_(), zswaptest_();
|
||||
extern /* Subroutine */ int zdotutest_(int*, doublecomplex*, int*, doublecomplex*, int*, doublecomplex*), zswaptest_(int*, doublecomplex*, int*, doublecomplex*, int*);
|
||||
static integer kn;
|
||||
extern /* Subroutine */ int zaxpytest_();
|
||||
extern /* Subroutine */ int zaxpytest_(int*, doublereal*, doublecomplex*, int*, doublecomplex*, int*);
|
||||
static doublecomplex cx[7], cy[7];
|
||||
static integer mx, my;
|
||||
|
||||
|
|
@ -923,20 +677,18 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* check2_ */
|
||||
|
||||
/* Subroutine */ int stest_(len, scomp, strue, ssize, sfac)
|
||||
integer *len;
|
||||
doublereal *scomp, *strue, *ssize, *sfac;
|
||||
/* Subroutine */ int stest_(integer* len, doublereal* scomp, doublereal* strue, doublereal* ssize, doublereal* sfac)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
doublereal d__1, d__2, d__3, d__4, d__5;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(), e_wsfe(), do_fio();
|
||||
integer s_wsfe(void), e_wsfe(void), do_fio(void);
|
||||
|
||||
/* Local variables */
|
||||
static integer i__;
|
||||
extern doublereal sdiff_();
|
||||
extern doublereal sdiff_(doublereal*, doublereal*);
|
||||
static doublereal sd;
|
||||
|
||||
/* ********************************* STEST ************************** */
|
||||
|
|
@ -992,11 +744,10 @@ L40:
|
|||
|
||||
} /* stest_ */
|
||||
|
||||
/* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac)
|
||||
doublereal *scomp1, *strue1, *ssize, *sfac;
|
||||
/* Subroutine */ int stest1_(doublereal* scomp1, doublereal* strue1, doublereal* ssize, doublereal* sfac)
|
||||
{
|
||||
static doublereal scomp[1], strue[1];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(int*,doublereal*, doublereal*, doublereal*, doublereal*);
|
||||
|
||||
/* ************************* STEST1 ***************************** */
|
||||
|
||||
|
|
@ -1023,8 +774,7 @@ doublereal *scomp1, *strue1, *ssize, *sfac;
|
|||
return 0;
|
||||
} /* stest1_ */
|
||||
|
||||
doublereal sdiff_(sa, sb)
|
||||
doublereal *sa, *sb;
|
||||
doublereal sdiff_(doublereal* sa, doublereal* sb)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
@ -1038,10 +788,7 @@ doublereal *sa, *sb;
|
|||
return ret_val;
|
||||
} /* sdiff_ */
|
||||
|
||||
/* Subroutine */ int ctest_(len, ccomp, ctrue, csize, sfac)
|
||||
integer *len;
|
||||
doublecomplex *ccomp, *ctrue, *csize;
|
||||
doublereal *sfac;
|
||||
/* Subroutine */ int ctest_(integer* len, doublecomplex* ccomp, doublecomplex* ctrue, doublecomplex* csize, doublereal* sfac)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1, i__2;
|
||||
|
|
@ -1049,7 +796,7 @@ doublereal *sfac;
|
|||
/* Local variables */
|
||||
static integer i__;
|
||||
static doublereal scomp[20], ssize[20], strue[20];
|
||||
extern /* Subroutine */ int stest_();
|
||||
extern /* Subroutine */ int stest_(integer*, doublereal*, doublereal*, doublereal*, doublereal*);
|
||||
|
||||
/* **************************** CTEST ***************************** */
|
||||
|
||||
|
|
@ -1087,8 +834,7 @@ doublereal *sfac;
|
|||
return 0;
|
||||
} /* ctest_ */
|
||||
|
||||
/* Subroutine */ int itest1_(icomp, itrue)
|
||||
integer *icomp, *itrue;
|
||||
/* Subroutine */ int itest1_(integer* icomp, integer* itrue)
|
||||
{
|
||||
static integer id;
|
||||
|
||||
|
|
|
|||
|
|
@ -242,129 +242,6 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
/* -- translated by f2c (version 20000121).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
|
@ -396,7 +273,7 @@ static integer c_n1 = -1;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program */ int main()
|
||||
/* Main program */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -414,19 +291,23 @@ static logical c_false = FALSE_;
|
|||
static logical same;
|
||||
static integer ninc, nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int zchk1_(), zchk2_(), zchk3_(), zchk4_(),
|
||||
zchk5_(), zchk6_();
|
||||
extern /* Subroutine */ int zchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk6_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
static doublecomplex a[4225] /* was [65][65] */;
|
||||
static doublereal g[65];
|
||||
static integer i__, j;
|
||||
extern doublereal ddiff_();
|
||||
extern doublereal ddiff_(doublereal*, doublereal*);
|
||||
static integer n;
|
||||
static logical fatal;
|
||||
static doublecomplex x[65], y[65], z__[130];
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
static char snaps[32], trans[1];
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer isnum;
|
||||
static logical ltest[17];
|
||||
static doublecomplex aa[4225];
|
||||
|
|
@ -441,12 +322,12 @@ static logical c_false = FALSE_;
|
|||
static logical rorder;
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
extern /* Subroutine */ int cz2chke_();
|
||||
extern /* Subroutine */ void cz2chke_(char*, ftnlen);
|
||||
static doublecomplex alf[7];
|
||||
static integer inc[7], nkb;
|
||||
static doublecomplex bet[7];
|
||||
static doublereal eps, err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
char tmpchar;
|
||||
|
||||
/* Test program for the DOUBLE PRECISION COMPLEX Level 2 Blas. */
|
||||
|
|
@ -984,22 +865,7 @@ L240:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int zchk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
doublereal *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1018,27 +884,27 @@ ftnlen sname_len;
|
|||
static integer i__, m, n;
|
||||
static doublecomplex alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys;
|
||||
static char trans[1];
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer ia, ib, ic;
|
||||
static logical banded;
|
||||
static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns;
|
||||
extern /* Subroutine */ int czgbmv_();
|
||||
extern /* Subroutine */ void czgbmv_(integer*, char*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen);
|
||||
static char ctrans[14];
|
||||
extern /* Subroutine */ int czgemv_();
|
||||
extern /* Subroutine */ void czgemv_(integer*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen);
|
||||
static doublereal errmax;
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
static integer laa, lda;
|
||||
static doublecomplex als, bls;
|
||||
static doublereal err;
|
||||
static integer iku, kls;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
static integer kus;
|
||||
|
||||
|
||||
|
|
@ -1451,22 +1317,7 @@ L140:
|
|||
|
||||
} /* zchk1_ */
|
||||
|
||||
/* Subroutine */ int zchk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax,
|
||||
incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
doublereal *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1486,27 +1337,28 @@ ftnlen sname_len;
|
|||
static integer i__, k, n;
|
||||
static doublecomplex alpha;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static char uplos[1];
|
||||
static integer ia, ib, ic;
|
||||
static logical banded;
|
||||
static integer nc, ik, in;
|
||||
static logical packed;
|
||||
static integer nk, ks, ix, iy, ns, lx, ly;
|
||||
extern /* Subroutine */ int czhbmv_(), czhemv_();
|
||||
extern /* Subroutine */ void czhbmv_(integer*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void czhemv_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen);
|
||||
static doublereal errmax;
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern /* Subroutine */ int czhpmv_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void czhpmv_(integer*, char*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen);
|
||||
static integer laa, lda;
|
||||
static doublecomplex als, bls;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests CHEMV, CHBMV and CHPMV. */
|
||||
|
||||
|
|
@ -1909,19 +1761,7 @@ L130:
|
|||
|
||||
} /* zchk2_ */
|
||||
|
||||
/* Subroutine */ int zchk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, xt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *xt;
|
||||
doublereal *g;
|
||||
doublecomplex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* xt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1942,13 +1782,13 @@ ftnlen sname_len;
|
|||
static integer i__, k, n;
|
||||
static char diags[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs;
|
||||
static char trans[1];
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static char uplos[1];
|
||||
static logical banded;
|
||||
static integer nc, ik, in;
|
||||
|
|
@ -1957,14 +1797,17 @@ ftnlen sname_len;
|
|||
static char ctrans[14];
|
||||
static doublereal errmax;
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern /* Subroutine */ int cztbmv_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztbmv_(integer*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static char transs[1];
|
||||
extern /* Subroutine */ int cztbsv_(), cztpmv_(), cztrmv_(), cztpsv_(),
|
||||
cztrsv_();
|
||||
extern /* Subroutine */ void cztbsv_(integer*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztpmv_(integer*, char*, char*, char*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztpsv_(integer*, char*, char*, char*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztrmv_(integer*, char*, char*, char*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztrsv_(integer*, char*, char*, char*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer laa, icd, lda, ict, icu;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
|
||||
|
||||
|
|
@ -2422,21 +2265,7 @@ L130:
|
|||
|
||||
} /* zchk3_ */
|
||||
|
||||
/* Subroutine */ int zchk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
doublereal *g;
|
||||
doublecomplex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
|
||||
|
|
@ -2450,21 +2279,21 @@ ftnlen sname_len;
|
|||
static integer i__, j, m, n;
|
||||
static doublecomplex alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static integer incxs, incys;
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static integer ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly;
|
||||
extern /* Subroutine */ int czgerc_();
|
||||
extern /* Subroutine */ void czgerc_(integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*);
|
||||
static doublereal errmax;
|
||||
extern /* Subroutine */ int czgeru_();
|
||||
extern /* Subroutine */ void czgeru_(integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*);
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lda;
|
||||
static doublecomplex als;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
|
||||
|
||||
|
|
@ -2793,21 +2622,7 @@ L150:
|
|||
|
||||
} /* zchk4_ */
|
||||
|
||||
/* Subroutine */ int zchk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
doublereal *g;
|
||||
doublecomplex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2827,13 +2642,14 @@ ftnlen sname_len;
|
|||
static integer i__, j, n;
|
||||
static doublecomplex alpha, w[1];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int czher_();
|
||||
extern /* Subroutine */ void czher_(integer*, char*, integer*, doublereal*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen);
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs;
|
||||
extern /* Subroutine */ int czhpr_(), zmvch_();
|
||||
extern /* Subroutine */ void czhpr_(integer*, char*, integer*, doublereal*, doublecomplex*, integer*, doublecomplex*, ftnlen);
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
|
|
@ -2841,10 +2657,10 @@ ftnlen sname_len;
|
|||
static integer ix, ns, lx;
|
||||
static doublereal ralpha, errmax;
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lda;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZHER and ZHPR. */
|
||||
|
||||
|
|
@ -3167,21 +2983,7 @@ L130:
|
|||
|
||||
} /* zchk5_ */
|
||||
|
||||
/* Subroutine */ int zchk6_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x,
|
||||
xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *ninc, *inc, *nmax, *incmax;
|
||||
doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt;
|
||||
doublereal *g;
|
||||
doublecomplex *z__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk6_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -3201,25 +3003,26 @@ ftnlen sname_len;
|
|||
static integer i__, j, n;
|
||||
static doublecomplex alpha, w[2];
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
static logical reset;
|
||||
static char cuplo[14];
|
||||
static integer incxs, incys;
|
||||
extern /* Subroutine */ int zmvch_();
|
||||
extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen);
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
extern /* Subroutine */ int czher2_(), czhpr2_();
|
||||
extern /* Subroutine */ void czher2_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ void czhpr2_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, ftnlen);
|
||||
static integer ia, ja, ic, nc, jj, lj, in;
|
||||
static logical packed;
|
||||
static integer ix, iy, ns, lx, ly;
|
||||
static doublereal errmax;
|
||||
static doublecomplex transl;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lda;
|
||||
static doublecomplex als;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZHER2 and ZHPR2. */
|
||||
|
||||
|
|
@ -3604,24 +3407,7 @@ L170:
|
|||
|
||||
} /* zchk6_ */
|
||||
|
||||
/* Subroutine */ int zmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y,
|
||||
incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len)
|
||||
char *trans;
|
||||
integer *m, *n;
|
||||
doublecomplex *alpha, *a;
|
||||
integer *nmax;
|
||||
doublecomplex *x;
|
||||
integer *incx;
|
||||
doublecomplex *beta, *y;
|
||||
integer *incy;
|
||||
doublecomplex *yt;
|
||||
doublereal *g;
|
||||
doublecomplex *yy;
|
||||
doublereal *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen trans_len;
|
||||
/* Subroutine */ int zmvch_(char* trans, integer* m, integer* n, doublecomplex* alpha, doublecomplex* a, integer* nmax, doublecomplex* x, integer* incx, doublecomplex* beta, doublecomplex* y, integer* incy, doublecomplex* yt, doublereal* g, doublecomplex* yy, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len)
|
||||
{
|
||||
|
||||
/* System generated locals */
|
||||
|
|
@ -3819,9 +3605,7 @@ L80:
|
|||
|
||||
} /* zmvch_ */
|
||||
|
||||
logical lze_(ri, rj, lr)
|
||||
doublecomplex *ri, *rj;
|
||||
integer *lr;
|
||||
logical lze_(doublecomplex* ri, doublecomplex* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1, i__2, i__3;
|
||||
|
|
@ -3868,13 +3652,7 @@ L30:
|
|||
|
||||
} /* lze_ */
|
||||
|
||||
logical lzeres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
doublecomplex *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lzeres_(char* type__, char* uplo, integer* m, integer* n, doublecomplex* aa, doublecomplex* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -3967,9 +3745,7 @@ L80:
|
|||
|
||||
} /* lzeres_ */
|
||||
|
||||
/* Double Complex */ VOID zbeg_( ret_val, reset)
|
||||
doublecomplex * ret_val;
|
||||
logical *reset;
|
||||
/* Double Complex */ VOID zbeg_( doublecomplex* ret_val, logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal d__1, d__2;
|
||||
|
|
@ -4030,8 +3806,7 @@ L10:
|
|||
|
||||
} /* zbeg_ */
|
||||
|
||||
doublereal ddiff_(x, y)
|
||||
doublereal *x, *y;
|
||||
doublereal ddiff_(doublereal* x, doublereal* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
@ -4051,19 +3826,7 @@ doublereal *x, *y;
|
|||
|
||||
} /* ddiff_ */
|
||||
|
||||
/* Subroutine */ int zmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl,
|
||||
ku, reset, transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
doublecomplex *a;
|
||||
integer *nmax;
|
||||
doublecomplex *aa;
|
||||
integer *lda, *kl, *ku;
|
||||
logical *reset;
|
||||
doublecomplex *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int zmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublecomplex* a, integer* nmax, doublecomplex* aa, integer* lda, integer* kl, integer* ku, logical* reset, doublecomplex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -4072,7 +3835,7 @@ ftnlen diag_len;
|
|||
|
||||
/* Local variables */
|
||||
static integer ibeg, iend, ioff;
|
||||
extern /* Double Complex */ VOID zbeg_();
|
||||
extern /* Double Complex */ VOID zbeg_(doublecomplex*, logical*);
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
static logical lower;
|
||||
|
|
|
|||
|
|
@ -22,14 +22,11 @@ typedef double doublereal;
|
|||
typedef struct { real r, i; } complex;
|
||||
typedef struct { doublereal r, i; } doublecomplex;
|
||||
#ifdef _MSC_VER
|
||||
static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;}
|
||||
static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;}
|
||||
static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;}
|
||||
static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;}
|
||||
#else
|
||||
static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
|
||||
static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
|
||||
static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
|
||||
#endif
|
||||
#define pCf(z) (*_pCf(z))
|
||||
|
|
@ -242,124 +239,7 @@ typedef struct Namelist Namelist;
|
|||
/* procedure parameter types for -A and -C++ */
|
||||
|
||||
#define F2C_proc_par_types 1
|
||||
#ifdef __cplusplus
|
||||
typedef logical (*L_fp)(...);
|
||||
#else
|
||||
typedef logical (*L_fp)();
|
||||
#endif
|
||||
#if 0
|
||||
static float spow_ui(float x, integer n) {
|
||||
float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static double dpow_ui(double x, integer n) {
|
||||
double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
static _Fcomplex cpow_ui(complex x, integer n) {
|
||||
complex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow.r *= x.r, pow.i *= x.i;
|
||||
if(u >>= 1) x.r *= x.r, x.i *= x.i;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Fcomplex p={pow.r, pow.i};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex float cpow_ui(_Complex float x, integer n) {
|
||||
_Complex float pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
#ifdef _MSC_VER
|
||||
static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
|
||||
_Dcomplex pow={1.0,0.0}; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
|
||||
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
|
||||
else break;
|
||||
}
|
||||
}
|
||||
_Dcomplex p = {pow._Val[0], pow._Val[1]};
|
||||
return p;
|
||||
}
|
||||
#else
|
||||
static _Complex double zpow_ui(_Complex double x, integer n) {
|
||||
_Complex double pow=1.0; unsigned long int u;
|
||||
if(n != 0) {
|
||||
if(n < 0) n = -n, x = 1/x;
|
||||
for(u = n; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
#endif
|
||||
static integer pow_ii(integer x, integer n) {
|
||||
integer pow; unsigned long int u;
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) pow = 1;
|
||||
else if (x != -1) pow = x == 0 ? 1/x : 0;
|
||||
else n = -n;
|
||||
}
|
||||
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
|
||||
u = n;
|
||||
for(pow = 1; ; ) {
|
||||
if(u & 01) pow *= x;
|
||||
if(u >>= 1) x *= x;
|
||||
else break;
|
||||
}
|
||||
}
|
||||
return pow;
|
||||
}
|
||||
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
|
||||
{
|
||||
double m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
static integer smaxloc_(float *w, integer s, integer e, integer *n)
|
||||
{
|
||||
float m; integer i, mi;
|
||||
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
|
||||
if (w[i-1]>m) mi=i ,m=w[i-1];
|
||||
return mi-s+1;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/* Common Block Declarations */
|
||||
|
||||
|
|
@ -388,7 +268,7 @@ static logical c_true = TRUE_;
|
|||
static integer c__0 = 0;
|
||||
static logical c_false = FALSE_;
|
||||
|
||||
/* Main program MAIN__() */ int main()
|
||||
/* Main program MAIN__() */ int main(void)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -400,26 +280,29 @@ static logical c_false = FALSE_;
|
|||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(),
|
||||
e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe();
|
||||
integer s_rsle(void), do_lio(void), e_rsle(void), f_open(void), s_wsfe(void), do_fio(void),
|
||||
e_wsfe(void), s_wsle(void), e_wsle(void), s_rsfe(void), e_rsfe(void);
|
||||
|
||||
/* Local variables */
|
||||
static integer nalf, idim[9];
|
||||
static logical same;
|
||||
static integer nbet, ntra;
|
||||
static logical rewi;
|
||||
extern /* Subroutine */ int zchk1_(), zchk2_(), zchk3_(), zchk4_(),
|
||||
zchk5_();
|
||||
extern /* Subroutine */ int zchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen);
|
||||
extern /* Subroutine */ int zchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen);
|
||||
static doublecomplex c__[4225] /* was [65][65] */;
|
||||
static doublereal g[65];
|
||||
static integer i__, j;
|
||||
extern doublereal ddiff_();
|
||||
extern doublereal ddiff_(doublereal*, doublereal*);
|
||||
static integer n;
|
||||
static logical fatal;
|
||||
static doublecomplex w[130];
|
||||
static logical trace;
|
||||
static integer nidim;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static char snaps[32];
|
||||
static integer isnum;
|
||||
static logical ltest[9];
|
||||
|
|
@ -431,10 +314,10 @@ static logical c_false = FALSE_;
|
|||
static logical rorder;
|
||||
static integer layout;
|
||||
static logical ltestt, tsterr;
|
||||
extern /* Subroutine */ int cz3chke_();
|
||||
extern /* Subroutine */ int cz3chke_(char*, ftnlen);
|
||||
static doublecomplex alf[7], bet[7];
|
||||
static doublereal eps, err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
char tmpchar;
|
||||
|
||||
/* Test program for the COMPLEX*16 Level 3 Blas. */
|
||||
|
|
@ -924,22 +807,7 @@ L230:
|
|||
|
||||
} /* MAIN__ */
|
||||
|
||||
/* Subroutine */ int zchk1_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *nmax;
|
||||
doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct;
|
||||
doublereal *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -956,21 +824,21 @@ ftnlen sname_len;
|
|||
static integer i__, k, m, n;
|
||||
static doublecomplex alpha;
|
||||
static logical isame[13], trana, tranb;
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical reset;
|
||||
static integer ia, ib;
|
||||
extern /* Subroutine */ int zprcn1_();
|
||||
extern /* Subroutine */ int zprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ma, mb, na, nb, nc, ik, im, in, ks, ms, ns;
|
||||
extern /* Subroutine */ int czgemm_();
|
||||
extern /* Subroutine */ void czgemm_(integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static char tranas[1], tranbs[1], transa[1], transb[1];
|
||||
static doublereal errmax;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc;
|
||||
static doublecomplex als, bls;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZGEMM. */
|
||||
|
||||
|
|
@ -1313,20 +1181,7 @@ L130:
|
|||
} /* zchk1_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *k;
|
||||
doublecomplex *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublecomplex *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ int zprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
/* Local variables */
|
||||
static char crc[14], cta[14], ctb[14];
|
||||
|
|
@ -1357,22 +1212,7 @@ return 0;
|
|||
} /* zprcn1_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zchk2_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *nmax;
|
||||
doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct;
|
||||
doublereal *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1394,23 +1234,23 @@ ftnlen sname_len;
|
|||
static doublecomplex alpha;
|
||||
static logical isame[13];
|
||||
static char sides[1];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical reset;
|
||||
static char uplos[1];
|
||||
static integer ia, ib;
|
||||
extern /* Subroutine */ int zprcn2_();
|
||||
extern /* Subroutine */ int zprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer na, nc, im, in, ms, ns;
|
||||
extern /* Subroutine */ int czhemm_();
|
||||
extern /* Subroutine */ void czhemm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
extern logical lzeres_();
|
||||
extern /* Subroutine */ int czsymm_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void czsymm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc, ics;
|
||||
static doublecomplex als, bls;
|
||||
static integer icu;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZHEMM and ZSYMM. */
|
||||
|
||||
|
|
@ -1737,20 +1577,7 @@ L120:
|
|||
} /* zchk2_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha,
|
||||
lda, ldb, beta, ldc, sname_len, side_len, uplo_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo;
|
||||
integer *m, *n;
|
||||
doublecomplex *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublecomplex *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
/* Subroutine */ int zprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len)
|
||||
{
|
||||
/* Local variables */
|
||||
static char cs[14], cu[14], crc[14];
|
||||
|
|
@ -1777,21 +1604,7 @@ return 0;
|
|||
} /* zprcn2_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zchk3_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__,
|
||||
iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nmax;
|
||||
doublecomplex *a, *aa, *as, *b, *bb, *bs, *ct;
|
||||
doublereal *g;
|
||||
doublecomplex *c__;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* ct, doublereal* g, doublecomplex* c__, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -1817,23 +1630,24 @@ ftnlen sname_len;
|
|||
static char diags[1];
|
||||
static logical isame[13];
|
||||
static char sides[1];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static logical reset;
|
||||
static char uplos[1];
|
||||
static integer ia, na;
|
||||
extern /* Subroutine */ int zprcn3_();
|
||||
extern /* Subroutine */ int zprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static integer nc, im, in, ms, ns;
|
||||
static char tranas[1], transa[1];
|
||||
static doublereal errmax;
|
||||
extern logical lzeres_();
|
||||
extern /* Subroutine */ int cztrmm_(), cztrsm_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztrmm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ void cztrsm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen);
|
||||
static integer laa, icd, lbb, lda, ldb, ics;
|
||||
static doublecomplex als;
|
||||
static integer ict, icu;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZTRMM and ZTRSM. */
|
||||
|
||||
|
|
@ -2227,21 +2041,7 @@ L160:
|
|||
} /* zchk3_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn3_(nout, nc, sname, iorder, side, uplo, transa,
|
||||
diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len,
|
||||
transa_len, diag_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *side, *uplo, *transa, *diag;
|
||||
integer *m, *n;
|
||||
doublecomplex *alpha;
|
||||
integer *lda, *ldb;
|
||||
ftnlen sname_len;
|
||||
ftnlen side_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int zprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len)
|
||||
{
|
||||
|
||||
/* Local variables */
|
||||
|
|
@ -2281,22 +2081,7 @@ return 0;
|
|||
} /* zprcn3_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zchk4_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs,
|
||||
c__, cc, cs, ct, g, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *nmax;
|
||||
doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct;
|
||||
doublereal *g;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2320,30 +2105,30 @@ ftnlen sname_len;
|
|||
static doublecomplex alpha;
|
||||
static doublereal rbeta;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static doublereal rbets;
|
||||
static logical reset;
|
||||
static char trans[1];
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ib, jc, ma, na;
|
||||
extern /* Subroutine */ int zprcn4_();
|
||||
extern /* Subroutine */ int zprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nc;
|
||||
extern /* Subroutine */ int zprcn6_();
|
||||
extern /* Subroutine */ int zprcn6_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ik, in, jj, lj, ks, ns;
|
||||
static doublereal ralpha;
|
||||
extern /* Subroutine */ int czherk_();
|
||||
extern /* Subroutine */ int czherk_(integer*, char*, char*, integer*, integer*, doublereal*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static doublereal errmax;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static char transs[1], transt[1];
|
||||
extern /* Subroutine */ int czsyrk_();
|
||||
extern /* Subroutine */ int czsyrk_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lda, lcc, ldc;
|
||||
static doublecomplex als;
|
||||
static integer ict, icu;
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZHERK and ZSYRK. */
|
||||
|
||||
|
|
@ -2732,20 +2517,7 @@ L130:
|
|||
} /* zchk4_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn4_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublecomplex *alpha;
|
||||
integer *lda;
|
||||
doublecomplex *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ int zprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -2775,20 +2547,7 @@ return 0;
|
|||
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn6_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublereal *alpha;
|
||||
integer *lda;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ int zprcn6_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
|
||||
/* Local variables */
|
||||
|
|
@ -2818,23 +2577,7 @@ return 0;
|
|||
} /* zprcn6_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zchk5_(sname, eps, thresh, nout, ntra, trace, rewi,
|
||||
fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs,
|
||||
c__, cc, cs, ct, g, w, iorder, sname_len)
|
||||
char *sname;
|
||||
doublereal *eps, *thresh;
|
||||
integer *nout, *ntra;
|
||||
logical *trace, *rewi, *fatal;
|
||||
integer *nidim, *idim, *nalf;
|
||||
doublecomplex *alf;
|
||||
integer *nbet;
|
||||
doublecomplex *bet;
|
||||
integer *nmax;
|
||||
doublecomplex *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct;
|
||||
doublereal *g;
|
||||
doublecomplex *w;
|
||||
integer *iorder;
|
||||
ftnlen sname_len;
|
||||
/* Subroutine */ int zchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* ab, doublecomplex* aa, doublecomplex* as, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, doublecomplex* w, integer* iorder, ftnlen sname_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
|
|
@ -2857,27 +2600,28 @@ ftnlen sname_len;
|
|||
static doublecomplex alpha;
|
||||
static doublereal rbeta;
|
||||
static logical isame[13];
|
||||
extern /* Subroutine */ int zmake_();
|
||||
extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen);
|
||||
static integer nargs;
|
||||
extern /* Subroutine */ int zmmch_();
|
||||
extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen);
|
||||
static doublereal rbets;
|
||||
static logical reset;
|
||||
static char trans[1];
|
||||
static logical upper;
|
||||
static char uplos[1];
|
||||
static integer ia, ib, jc, ma, na, nc;
|
||||
extern /* Subroutine */ int zprcn5_(), zprcn7_();
|
||||
extern /* Subroutine */ int zprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int zprcn7_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen);
|
||||
static integer ik, in, jj, lj, ks, ns;
|
||||
static doublereal errmax;
|
||||
extern logical lzeres_();
|
||||
extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static char transs[1], transt[1];
|
||||
extern /* Subroutine */ int czher2k_();
|
||||
extern /* Subroutine */ int czher2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static integer laa, lbb, lda, lcc, ldb, ldc;
|
||||
static doublecomplex als;
|
||||
static integer ict, icu;
|
||||
extern /* Subroutine */ int czsyr2k_();
|
||||
extern /* Subroutine */ int czsyr2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen);
|
||||
static doublereal err;
|
||||
extern logical lze_();
|
||||
extern logical lze_(doublecomplex*, doublecomplex*, integer*);
|
||||
|
||||
/* Tests ZHER2K and ZSYR2K. */
|
||||
|
||||
|
|
@ -3349,20 +3093,7 @@ L160:
|
|||
} /* zchk5_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn5_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublecomplex *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublecomplex *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ int zprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
/* Local variables */
|
||||
static char ca[14], cu[14], crc[14];
|
||||
|
|
@ -3392,20 +3123,7 @@ return 0;
|
|||
|
||||
|
||||
|
||||
/* Subroutine */ int zprcn7_(nout, nc, sname, iorder, uplo, transa, n, k,
|
||||
alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len)
|
||||
integer *nout, *nc;
|
||||
char *sname;
|
||||
integer *iorder;
|
||||
char *uplo, *transa;
|
||||
integer *n, *k;
|
||||
doublecomplex *alpha;
|
||||
integer *lda, *ldb;
|
||||
doublereal *beta;
|
||||
integer *ldc;
|
||||
ftnlen sname_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen transa_len;
|
||||
/* Subroutine */ int zprcn7_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len)
|
||||
{
|
||||
|
||||
/* Local variables */
|
||||
|
|
@ -3435,19 +3153,7 @@ return 0;
|
|||
} /* zprcn7_ */
|
||||
|
||||
|
||||
/* Subroutine */ int zmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset,
|
||||
transl, type_len, uplo_len, diag_len)
|
||||
char *type__, *uplo, *diag;
|
||||
integer *m, *n;
|
||||
doublecomplex *a;
|
||||
integer *nmax;
|
||||
doublecomplex *aa;
|
||||
integer *lda;
|
||||
logical *reset;
|
||||
doublecomplex *transl;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
ftnlen diag_len;
|
||||
/* Subroutine */ int zmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublecomplex* a, integer* nmax, doublecomplex* aa, integer* lda, logical* reset, doublecomplex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -3456,7 +3162,7 @@ ftnlen diag_len;
|
|||
|
||||
/* Local variables */
|
||||
static integer ibeg, iend;
|
||||
extern /* Double Complex */ VOID zbeg_();
|
||||
extern /* Double Complex */ VOID zbeg_(doublecomplex*, logical*);
|
||||
static logical unit;
|
||||
static integer i__, j;
|
||||
static logical lower, upper;
|
||||
|
|
@ -3629,27 +3335,7 @@ ftnlen diag_len;
|
|||
|
||||
} /* zmake_ */
|
||||
|
||||
/* Subroutine */ int zmmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb,
|
||||
beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv,
|
||||
transa_len, transb_len)
|
||||
char *transa, *transb;
|
||||
integer *m, *n, *kk;
|
||||
doublecomplex *alpha, *a;
|
||||
integer *lda;
|
||||
doublecomplex *b;
|
||||
integer *ldb;
|
||||
doublecomplex *beta, *c__;
|
||||
integer *ldc;
|
||||
doublecomplex *ct;
|
||||
doublereal *g;
|
||||
doublecomplex *cc;
|
||||
integer *ldcc;
|
||||
doublereal *eps, *err;
|
||||
logical *fatal;
|
||||
integer *nout;
|
||||
logical *mv;
|
||||
ftnlen transa_len;
|
||||
ftnlen transb_len;
|
||||
/* Subroutine */ int zmmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, doublecomplex* alpha, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* beta, doublecomplex* c__, integer* ldc, doublecomplex* ct, doublereal* g, doublecomplex* cc, integer* ldcc, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len)
|
||||
{
|
||||
|
||||
/* System generated locals */
|
||||
|
|
@ -3658,7 +3344,7 @@ ftnlen transb_len;
|
|||
doublereal d__1, d__2, d__3, d__4, d__5, d__6;
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
double sqrt();
|
||||
double sqrt(double);
|
||||
/* Local variables */
|
||||
static doublereal erri;
|
||||
static integer i__, j, k;
|
||||
|
|
@ -4031,9 +3717,7 @@ L250:
|
|||
|
||||
} /* zmmch_ */
|
||||
|
||||
logical lze_(ri, rj, lr)
|
||||
doublecomplex *ri, *rj;
|
||||
integer *lr;
|
||||
logical lze_(doublecomplex* ri, doublecomplex* rj, integer* lr)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1, i__2, i__3;
|
||||
|
|
@ -4082,13 +3766,7 @@ L30:
|
|||
|
||||
} /* lze_ */
|
||||
|
||||
logical lzeres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len)
|
||||
char *type__, *uplo;
|
||||
integer *m, *n;
|
||||
doublecomplex *aa, *as;
|
||||
integer *lda;
|
||||
ftnlen type_len;
|
||||
ftnlen uplo_len;
|
||||
logical lzeres_(char* type__, char* uplo, integer* m, integer* n, doublecomplex *aa, doublecomplex* as, integer* lda, ftnlen type_len, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4;
|
||||
|
|
@ -4184,9 +3862,7 @@ L80:
|
|||
|
||||
} /* lzeres_ */
|
||||
|
||||
/* Double Complex */ VOID zbeg_( ret_val, reset)
|
||||
doublecomplex * ret_val;
|
||||
logical *reset;
|
||||
/* Double Complex */ VOID zbeg_(doublecomplex* ret_val, logical* reset)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal d__1, d__2;
|
||||
|
|
@ -4249,8 +3925,7 @@ L10:
|
|||
|
||||
} /* zbeg_ */
|
||||
|
||||
doublereal ddiff_(x, y)
|
||||
doublereal *x, *y;
|
||||
doublereal ddiff_(doublereal* x, doublereal* y)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
|
|
|||
Loading…
Reference in New Issue