OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

revert back to netlib versions as of f2c-19990501 

From-SVN: r26739
This commit is contained in:
Craig Burley 1999-05-03 08:33:21 +00:00 committed by Craig Burley
parent d0369a2f4e
commit 9cfd948e77
16 changed files with 202 additions and 256 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
libf2c/ChangeLog
View File

@ -1,3 +1,11 @@
Mon May 3 10:52:53 1999 Craig Burley <craig@jcb-sc.com>
* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, libF77/c_log.c,
libF77/c_sin.c, libF77/c_sqrt.c, libF77/d_cnjg.c, libF77/pow_zi.c,
libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c,
libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c: Revert back to
netlib versions as of f2c-19990501.
Sun May 2 01:38:50 1999 Craig Burley <craig@jcb-sc.com>
* libU77/u77-test.f (main): Declare FTELL as intrinsic.

18
libf2c/libF77/c_cos.c
View File

@ -3,19 +3,15 @@
#ifdef KR_headers
extern double sin(), cos(), sinh(), cosh();
VOID c_cos(resx, z) complex *resx, *z;
VOID c_cos(r, z) complex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
void c_cos(complex *resx, complex *z)
void c_cos(complex *r, complex *z)
#endif
{
complex res;
res.r = cos(z->r) * cosh(z->i);
res.i = - sin(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
double zr = z->r;
r->r = cos(zr) * cosh(z->i);
r->i = - sin(zr) * sinh(z->i);
}

57
libf2c/libF77/c_div.c
View File

@ -2,39 +2,36 @@
#ifdef KR_headers
extern VOID sig_die();
VOID c_div(resx, a, b)
complex *a, *b, *resx;
VOID c_div(c, a, b)
complex *a, *b, *c;
#else
extern void sig_die(char*,int);
void c_div(complex *resx, complex *a, complex *b)
void c_div(complex *c, complex *a, complex *b)
#endif
{
double ratio, den;
double abr, abi;
complex res;
double ratio, den;
double abr, abi, cr;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
res.r = (a->r*ratio + a->i) / den;
res.i = (a->i*ratio - a->r) / den;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den;
c->i = (a->i*ratio - a->r) / den;
}
else
{
ratio = (double)b->i / b->r ;
den = b->r * (1 + ratio*ratio);
cr = (a->r + a->i*ratio) / den;
c->i = (a->i - a->r*ratio) / den;
}
c->r = cr;
}
else
{
ratio = (double)b->i / b->r ;
den = b->r * (1 + ratio*ratio);
res.r = (a->r + a->i*ratio) / den;
res.i = (a->i - a->r*ratio) / den;
}
resx->r = res.r;
resx->i = res.i;
}

14
libf2c/libF77/c_exp.c
View File

@ -3,21 +3,17 @@
#ifdef KR_headers
extern double exp(), cos(), sin();
VOID c_exp(resx, z) complex *resx, *z;
VOID c_exp(r, z) complex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
void c_exp(complex *resx, complex *z)
void c_exp(complex *r, complex *z)
#endif
{
double expx;
complex res;
expx = exp(z->r);
res.r = expx * cos(z->i);
res.i = expx * sin(z->i);
resx->r = res.r;
resx->i = res.i;
r->r = expx * cos(z->i);
r->i = expx * sin(z->i);
}

18
libf2c/libF77/c_log.c
View File

@ -2,20 +2,16 @@
#ifdef KR_headers
extern double log(), f__cabs(), atan2();
VOID c_log(resx, z) complex *resx, *z;
VOID c_log(r, z) complex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
extern double f__cabs(double, double);
void c_log(complex *resx, complex *z)
void c_log(complex *r, complex *z)
#endif
{
complex res;
res.i = atan2(z->i, z->r);
res.r = log( f__cabs(z->r, z->i) );
resx->r = res.r;
resx->i = res.i;
}
double zi;
r->i = atan2(zi = z->i, z->r);
r->r = log( f__cabs(z->r, zi) );
}

18
libf2c/libF77/c_sin.c
View File

@ -3,19 +3,15 @@
#ifdef KR_headers
extern double sin(), cos(), sinh(), cosh();
VOID c_sin(resx, z) complex *resx, *z;
VOID c_sin(r, z) complex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
void c_sin(complex *resx, complex *z)
void c_sin(complex *r, complex *z)
#endif
{
complex res;
res.r = sin(z->r) * cosh(z->i);
res.i = cos(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
double zr = z->r;
r->r = sin(zr) * cosh(z->i);
r->i = cos(zr) * sinh(z->i);
}

47
libf2c/libF77/c_sqrt.c
View File

@ -3,36 +3,33 @@
#ifdef KR_headers
extern double sqrt(), f__cabs();
VOID c_sqrt(resx, z) complex *resx, *z;
VOID c_sqrt(r, z) complex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
extern double f__cabs(double, double);
void c_sqrt(complex *resx, complex *z)
void c_sqrt(complex *r, complex *z)
#endif
{
double mag, t;
complex res;
double mag, t;
double zi = z->i, zr = z->r;
if( (mag = f__cabs(z->r, z->i)) == 0.)
res.r = res.i = 0.;
else if(z->r > 0)
{
res.r = t = sqrt(0.5 * (mag + z->r) );
t = z->i / t;
res.i = 0.5 * t;
if( (mag = f__cabs(zr, zi)) == 0.)
r->r = r->i = 0.;
else if(zr > 0)
{
r->r = t = sqrt(0.5 * (mag + zr) );
t = zi / t;
r->i = 0.5 * t;
}
else
{
t = sqrt(0.5 * (mag - zr) );
if(zi < 0)
t = -t;
r->i = t;
t = zi / t;
r->r = 0.5 * t;
}
}
else
{
t = sqrt(0.5 * (mag - z->r) );
if(z->i < 0)
t = -t;
res.i = t;
t = z->i / t;
res.r = 0.5 * t;
}
resx->r = res.r;
resx->i = res.i;
}

13
libf2c/libF77/d_cnjg.c
View File

@ -2,16 +2,11 @@
VOID
#ifdef KR_headers
d_cnjg(resx, z) doublecomplex *resx, *z;
d_cnjg(r, z) doublecomplex *r, *z;
#else
d_cnjg(doublecomplex *resx, doublecomplex *z)
d_cnjg(doublecomplex *r, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = z->r;
res.i = - z->i;
resx->r = res.r;
resx->i = res.i;
r->r = z->r;
r->i = - z->i;
}

89
libf2c/libF77/pow_zi.c
View File

@ -1,61 +1,54 @@
#include "f2c.h"
#ifdef KR_headers
VOID pow_zi(resx, a, b) /* p = a**b */
doublecomplex *resx, *a; integer *b;
VOID pow_zi(p, a, b) /* p = a**b */
doublecomplex *p, *a; integer *b;
#else
extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */
void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */
#endif
{
integer n;
unsigned long u;
double t;
doublecomplex x;
doublecomplex res;
static doublecomplex one = {1.0, 0.0};
integer n;
unsigned long u;
double t;
doublecomplex q, x;
static doublecomplex one = {1.0, 0.0};
n = *b;
n = *b;
q.r = 1;
q.i = 0;
if(n == 0)
{
resx->r = 1;
resx->i = 0;
return;
}
res.r = 1;
res.i = 0;
if(n < 0)
{
n = -n;
z_div(&x, &one, a);
}
else
{
x.r = a->r;
x.i = a->i;
}
for(u = n; ; )
{
if(u & 01)
if(n == 0)
goto done;
if(n < 0)
{
t = res.r * x.r - res.i * x.i;
res.i = res.r * x.i + res.i * x.r;
res.r = t;
}
if(u >>= 1)
{
t = x.r * x.r - x.i * x.i;
x.i = 2 * x.r * x.i;
x.r = t;
n = -n;
z_div(&x, &one, a);
}
else
break;
}
{
x.r = a->r;
x.i = a->i;
}
resx->r = res.r;
resx->i = res.i;
}
for(u = n; ; )
{
if(u & 01)
{
t = q.r * x.r - q.i * x.i;
q.i = q.r * x.i + q.i * x.r;
q.r = t;
}
if(u >>= 1)
{
t = x.r * x.r - x.i * x.i;
x.i = 2 * x.r * x.i;
x.r = t;
}
else
break;
}
done:
p->i = q.i;
p->r = q.r;
}

13
libf2c/libF77/r_cnjg.c
View File

@ -1,16 +1,11 @@
#include "f2c.h"
#ifdef KR_headers
VOID r_cnjg(resx, z) complex *resx, *z;
VOID r_cnjg(r, z) complex *r, *z;
#else
VOID r_cnjg(complex *resx, complex *z)
VOID r_cnjg(complex *r, complex *z)
#endif
{
complex res;
res.r = z->r;
res.i = - z->i;
resx->r = res.r;
resx->i = res.i;
r->r = z->r;
r->i = - z->i;
}

18
libf2c/libF77/z_cos.c
View File

@ -2,18 +2,14 @@
#ifdef KR_headers
double sin(), cos(), sinh(), cosh();
VOID z_cos(resx, z) doublecomplex *resx, *z;
VOID z_cos(r, z) doublecomplex *r, *z;
#else
#undef abs
#include <math.h>
void z_cos(doublecomplex *resx, doublecomplex *z)
#include "math.h"
void z_cos(doublecomplex *r, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = cos(z->r) * cosh(z->i);
res.i = - sin(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
double zr = z->r;
r->r = cos(zr) * cosh(z->i);
r->i = - sin(zr) * sinh(z->i);
}

55
libf2c/libF77/z_div.c
View File

@ -2,38 +2,35 @@
#ifdef KR_headers
extern VOID sig_die();
VOID z_div(resx, a, b) doublecomplex *a, *b, *resx;
VOID z_div(c, a, b) doublecomplex *a, *b, *c;
#else
extern void sig_die(char*, int);
void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b)
void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
#endif
{
double ratio, den;
double abr, abi;
doublecomplex res;
double ratio, den;
double abr, abi, cr;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
res.r = (a->r*ratio + a->i) / den;
res.i = (a->i*ratio - a->r) / den;
if( (abr = b->r) < 0.)
abr = - abr;
if( (abi = b->i) < 0.)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
sig_die("complex division by zero", 1);
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den;
c->i = (a->i*ratio - a->r) / den;
}
else
{
ratio = b->i / b->r ;
den = b->r * (1 + ratio*ratio);
cr = (a->r + a->i*ratio) / den;
c->i = (a->i - a->r*ratio) / den;
}
c->r = cr;
}
else
{
ratio = b->i / b->r ;
den = b->r * (1 + ratio*ratio);
res.r = (a->r + a->i*ratio) / den;
res.i = (a->i - a->r*ratio) / den;
}
resx->r = res.r;
resx->i = res.i;
}

14
libf2c/libF77/z_exp.c
View File

@ -2,20 +2,16 @@
#ifdef KR_headers
double exp(), cos(), sin();
VOID z_exp(resx, z) doublecomplex *resx, *z;
VOID z_exp(r, z) doublecomplex *r, *z;
#else
#undef abs
#include <math.h>
void z_exp(doublecomplex *resx, doublecomplex *z)
#include "math.h"
void z_exp(doublecomplex *r, doublecomplex *z)
#endif
{
double expx;
doublecomplex res;
expx = exp(z->r);
res.r = expx * cos(z->i);
res.i = expx * sin(z->i);
resx->r = res.r;
resx->i = res.i;
r->r = expx * cos(z->i);
r->i = expx * sin(z->i);
}

18
libf2c/libF77/z_log.c
View File

@ -2,19 +2,15 @@
#ifdef KR_headers
double log(), f__cabs(), atan2();
VOID z_log(resx, z) doublecomplex *resx, *z;
VOID z_log(r, z) doublecomplex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
extern double f__cabs(double, double);
void z_log(doublecomplex *resx, doublecomplex *z)
void z_log(doublecomplex *r, doublecomplex *z)
#endif
{
doublecomplex res;
res.i = atan2(z->i, z->r);
res.r = log( f__cabs( z->r, z->i ) );
resx->r = res.r;
resx->i = res.i;
}
double zi = z->i;
r->i = atan2(zi, z->r);
r->r = log( f__cabs( z->r, zi ) );
}

18
libf2c/libF77/z_sin.c
View File

@ -2,18 +2,14 @@
#ifdef KR_headers
double sin(), cos(), sinh(), cosh();
VOID z_sin(resx, z) doublecomplex *resx, *z;
VOID z_sin(r, z) doublecomplex *r, *z;
#else
#undef abs
#include <math.h>
void z_sin(doublecomplex *resx, doublecomplex *z)
#include "math.h"
void z_sin(doublecomplex *r, doublecomplex *z)
#endif
{
doublecomplex res;
res.r = sin(z->r) * cosh(z->i);
res.i = cos(z->r) * sinh(z->i);
resx->r = res.r;
resx->i = res.i;
}
double zr = z->r;
r->r = sin(zr) * cosh(z->i);
r->i = cos(zr) * sinh(z->i);
}

40
libf2c/libF77/z_sqrt.c
View File

@ -2,32 +2,28 @@
#ifdef KR_headers
double sqrt(), f__cabs();
VOID z_sqrt(resx, z) doublecomplex *resx, *z;
VOID z_sqrt(r, z) doublecomplex *r, *z;
#else
#undef abs
#include <math.h>
#include "math.h"
extern double f__cabs(double, double);
void z_sqrt(doublecomplex *resx, doublecomplex *z)
void z_sqrt(doublecomplex *r, doublecomplex *z)
#endif
{
double mag;
doublecomplex res;
double mag, zi = z->i, zr = z->r;
if( (mag = f__cabs(z->r, z->i)) == 0.)
res.r = res.i = 0.;
else if(z->r > 0)
{
res.r = sqrt(0.5 * (mag + z->r) );
res.i = z->i / res.r / 2;
if( (mag = f__cabs(zr, zi)) == 0.)
r->r = r->i = 0.;
else if(zr > 0)
{
r->r = sqrt(0.5 * (mag + zr) );
r->i = zi / r->r / 2;
}
else
{
r->i = sqrt(0.5 * (mag - zr) );
if(zi < 0)
r->i = - r->i;
r->r = zi / r->i / 2;
}
}
else
{
res.i = sqrt(0.5 * (mag - z->r) );
if(z->i < 0)
res.i = - res.i;
res.r = z->i / res.i / 2;
}
resx->r = res.r;
resx->i = res.i;
}