From 754ffb382bdd3f61b5bbe929f5e472ab76ca7304 Mon Sep 17 00:00:00 2001 From: martin-frbg Date: Wed, 13 Apr 2022 09:34:22 +0200 Subject: [PATCH] fix typo in z_div --- lapack-netlib/SRC/zgbtrf.c | 2 +- lapack-netlib/SRC/zgejsv.c | 3 +- lapack-netlib/SRC/zgetc2.c | 3 +- lapack-netlib/SRC/zgetrf2.c | 3 +- lapack-netlib/SRC/zgtsv.c | 3 +- lapack-netlib/SRC/zgttrf.c | 3 +- lapack-netlib/SRC/zgtts2.c | 3 +- lapack-netlib/SRC/zhecon_3.c | 2 +- lapack-netlib/SRC/zheevr.c | 127 +++++++++++++++++++++++++++++--- lapack-netlib/SRC/zhetri.c | 3 +- lapack-netlib/SRC/zhetri2x.c | 3 +- lapack-netlib/SRC/zhetri_3x.c | 3 +- lapack-netlib/SRC/zhetrs.c | 3 +- lapack-netlib/SRC/zhetrs2.c | 3 +- lapack-netlib/SRC/zhetrs_3.c | 3 +- lapack-netlib/SRC/zhetrs_rook.c | 3 +- lapack-netlib/SRC/zhgeqz.c | 3 +- lapack-netlib/SRC/zhptrs.c | 3 +- 18 files changed, 147 insertions(+), 29 deletions(-) diff --git a/lapack-netlib/SRC/zgbtrf.c b/lapack-netlib/SRC/zgbtrf.c index 0067ff049..a9df0d4ae 100644 --- a/lapack-netlib/SRC/zgbtrf.c +++ b/lapack-netlib/SRC/zgbtrf.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} diff --git a/lapack-netlib/SRC/zgejsv.c b/lapack-netlib/SRC/zgejsv.c index e85634b0a..21549d400 100644 --- a/lapack-netlib/SRC/zgejsv.c +++ b/lapack-netlib/SRC/zgejsv.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* Table of constant values */ static doublecomplex c_b1 = {0.,0.}; diff --git a/lapack-netlib/SRC/zgetc2.c b/lapack-netlib/SRC/zgetc2.c index 4a0d895f8..0d024477a 100644 --- a/lapack-netlib/SRC/zgetc2.c +++ b/lapack-netlib/SRC/zgetc2.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* Table of constant values */ static integer c__1 = 1; diff --git a/lapack-netlib/SRC/zgetrf2.c b/lapack-netlib/SRC/zgetrf2.c index 3faa35c9e..44e1df00b 100644 --- a/lapack-netlib/SRC/zgetrf2.c +++ b/lapack-netlib/SRC/zgetrf2.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* Table of constant values */ static doublecomplex c_b1 = {1.,0.}; diff --git a/lapack-netlib/SRC/zgtsv.c b/lapack-netlib/SRC/zgtsv.c index c0f836ef5..d99f67948 100644 --- a/lapack-netlib/SRC/zgtsv.c +++ b/lapack-netlib/SRC/zgtsv.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* > \brief ZGTSV computes the solution to system of linear equations A * X = B for GT matrices */ /* =========== DOCUMENTATION =========== */ diff --git a/lapack-netlib/SRC/zgttrf.c b/lapack-netlib/SRC/zgttrf.c index 03bb5d4c3..323424af1 100644 --- a/lapack-netlib/SRC/zgttrf.c +++ b/lapack-netlib/SRC/zgttrf.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* > \brief \b ZGTTRF */ /* =========== DOCUMENTATION =========== */ diff --git a/lapack-netlib/SRC/zgtts2.c b/lapack-netlib/SRC/zgtts2.c index 55320a169..c1df66d96 100644 --- a/lapack-netlib/SRC/zgtts2.c +++ b/lapack-netlib/SRC/zgtts2.c @@ -191,7 +191,7 @@ typedef struct Namelist Namelist; #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } #ifdef _MSC_VER #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} #else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} @@ -510,6 +510,7 @@ static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integ + /* > \brief \b ZGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. */ diff --git a/lapack-netlib/SRC/zhecon_3.c b/lapack-netlib/SRC/zhecon_3.c index 7feb00d05..2e18f8a60 100644 --- a/lapack-netlib/SRC/zhecon_3.c +++ b/lapack-netlib/SRC/zhecon_3.c @@ -1,4 +1,4 @@ -k#include +#include #include #include #include diff --git a/lapack-netlib/SRC/zheevr.c b/lapack-netlib/SRC/zheevr.c index 02853907e..f5dfaf9a2 100644 --- a/lapack-netlib/SRC/zheevr.c +++ b/lapack-netlib/SRC/zheevr.c @@ -1,12 +1,3 @@ -/* f2c.h -- Standard Fortran to C header file */ - -/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." - - - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ - -#ifndef F2C_INCLUDE -#define F2C_INCLUDE - #include #include #include @@ -48,10 +39,17 @@ 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; @@ -191,8 +189,13 @@ typedef struct Namelist Namelist; #define abort_() { sig_die("Fortran abort routine called", 1); } #define c_abs(z) (cabsf(Cf(z))) #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } +#ifdef _MSC_VER +#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} +#else #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} +#endif #define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} #define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} #define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} @@ -204,13 +207,13 @@ typedef struct Namelist Namelist; #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) #define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conj(Cf(Z)); } +#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) #define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimag(Cf(z))) +#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -288,6 +291,21 @@ static double dpow_ui(double x, integer n) { } 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) { @@ -300,6 +318,22 @@ static _Complex float cpow_ui(_Complex float x, integer n) { } 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) { @@ -312,6 +346,7 @@ static _Complex double zpow_ui(_Complex double x, integer n) { } return pow; } +#endif static integer pow_ii(integer x, integer n) { integer pow; unsigned long int u; if (n <= 0) { @@ -345,6 +380,22 @@ static integer smaxloc_(float *w, integer s, integer e, integer *n) } 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