floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixes mymaxloc and complex pow_ii for MSVC

This commit is contained in:
martin-frbg 2022-04-13 22:09:52 +02:00
parent 091ff5ef51
commit 67839be8f4
15 changed files with 40 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lapack-netlib/SRC/chgeqz.c
View File

@ -292,18 +292,17 @@ static double dpow_ui(double x, integer n) {
return pow;
}
#ifdef _MSC_VER
static _Fcomplex cpow_ui(_Fomplex x, integer n) {
complex pow={1.0,0.0}; unsigned long int u;
static _Fcomplex cpow_ui(_Fcomplex x, integer n) {
_Fcomplex pow={1.0,0.0}; complex tmp; 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.r *= x._Val[0], pow.i *= x._Val[1];
if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
if(u & 01) pow = _FCmulcc(pow,x);
if(u >>= 1) x = _FCmulcc(x,x);
else break;
}
}
_Fcomplex p={pow.r, pow.i};
return p;
return pow;
}
#else
static _Complex float cpow_ui(_Complex float x, integer n) {
@ -325,13 +324,12 @@ static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
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];
if(u & 01) pow = _Cmulcc(pow,x);
if(u >>= 1) x = _Cmulcc(x,x);
else break;
}
}
_Dcomplex p = {pow._Val[0], pow._Val[1]};
return p;
return pow;
}
#else
static _Complex double zpow_ui(_Complex double x, integer n) {

20
lapack-netlib/SRC/claesy.c
View File

@ -292,18 +292,17 @@ 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;
static _Fcomplex cpow_ui(_Fcomplex x, integer n) {
_Fcomplex 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;
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.r *= x.r, pow.i *= x.i;
if(u >>= 1) x.r *= x.r, x.i *= x.i;
if(u & 01) pow = _FCmulcc(pow,x) ;
if(u >>= 1) x = _FCmulcc(x,x);
else break;
}
}
_Fcomplex p={pow.r, pow.i};
return p;
return pow;
}
#else
static _Complex float cpow_ui(_Complex float x, integer n) {
@ -325,13 +324,12 @@ static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
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];
if(u & 01) pow = _Cmulcc(pow,x);
if(u >>= 1) x = _Cmulcc(x,x);
else break;
}
}
_Dcomplex p = {pow._Val[0], pow._Val[1]};
return p;
return pow;
}
#else
static _Complex double zpow_ui(_Complex double x, integer n) {

11
lapack-netlib/SRC/clahqr.c
View File

@ -292,18 +292,17 @@ 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;
static _Fcomplex cpow_ui(_Fcomplex x, integer n) {
_Fcomplex 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;
if(u & 01) pow = _FCmulcc (pow,x);
if(u >>= 1) x = _FCmulcc (x,x);
else break;
}
}
_Fcomplex p={pow.r, pow.i};
return p;
return pow;
}
#else
static _Complex float cpow_ui(_Complex float x, integer n) {

2
lapack-netlib/SRC/cpstf2.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/cpstrf.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/dpstf2.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/dpstrf.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/spstf2.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/spstrf.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/zgesc2.c
View File

@ -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);}

7
lapack-netlib/SRC/zlaed0.c
View File

@ -325,13 +325,12 @@ static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
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];
if(u & 01) pow = _Cmulcc(pow, x);
if(u >>= 1) x = _Cmulcc(x, x);
else break;
}
}
_Dcomplex p = {pow._Val[0], pow._Val[1]};
return p;
return pow;
}
#else
static _Complex double zpow_ui(_Complex double x, integer n) {

7
lapack-netlib/SRC/zlaed7.c
View File

@ -325,13 +325,12 @@ static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
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];
if(u & 01) pow = _Cmulcc(pow, x);
if(u >>= 1) x = _Cmulcc(x, x);
else break;
}
}
_Dcomplex p = {pow._Val[0], pow._Val[1]};
return p;
return pow;
}
#else
static _Complex double zpow_ui(_Complex double x, integer n) {

2
lapack-netlib/SRC/zpstf2.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

2
lapack-netlib/SRC/zpstrf.c
View File

@ -256,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
#define myceiling_(w) {ceil(w)}
#define myhuge_(w) {HUGE_VAL}
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
#define mymaxloc_(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
/* procedure parameter types for -A and -C++ */

7
lapack-netlib/SRC/zstedc.c
View File

@ -325,13 +325,12 @@ static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
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];
if(u & 01) pow = _Cmulcc(pow, x);
if(u >>= 1) x = _Cmulcc(x, x);
else break;
}
}
_Dcomplex p = {pow._Val[0], pow._Val[1]};
return p;
return pow;
}
#else
static _Complex double zpow_ui(_Complex double x, integer n) {