Commit 407c72cb by Kaveh R. Ghazi Committed by Kaveh Ghazi

*: Fix formatting.

	* libF77/*: Fix formatting.
	* libI77/*: Likewise.
	* libU77/*: Likewise.

From-SVN: r54145
parent 113dc143
Sat Jun 1 08:33:14 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* libF77/*: Fix formatting.
* libI77/*: Likewise.
* libU77/*: Likewise.
Fri May 31 21:56:30 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* g2c.hin, libF77/d_cnjg.c, libF77/main.c, libF77/r_cnjg.c,
......
......@@ -7,18 +7,18 @@
static integer memfailure = 3;
#include <stdlib.h>
extern void G77_exit_0 (integer*);
extern void G77_exit_0 (integer *);
char *
F77_aloc(integer Len, char *whence)
char *
F77_aloc (integer Len, char *whence)
{
char *rv;
unsigned int uLen = (unsigned int) Len; /* for K&R C */
char *rv;
unsigned int uLen = (unsigned int) Len; /* for K&R C */
if (!(rv = (char*)malloc(uLen))) {
fprintf(stderr, "malloc(%u) failure in %s\n",
uLen, whence);
G77_exit_0 (&memfailure);
}
return rv;
}
if (!(rv = (char *) malloc (uLen)))
{
fprintf (stderr, "malloc(%u) failure in %s\n", uLen, whence);
G77_exit_0 (&memfailure);
}
return rv;
}
#include <stdio.h>
#include "f2c.h"
extern void sig_die(char*,int);
extern void sig_die (char *, int);
int G77_abort_0 (void)
int
G77_abort_0 (void)
{
sig_die("Fortran abort routine called", 1);
return 0; /* not reached */
sig_die ("Fortran abort routine called", 1);
return 0; /* not reached */
}
#include "f2c.h"
extern double f__cabs(double, double);
extern double f__cabs (double, double);
double c_abs(complex *z)
double
c_abs (complex * z)
{
return( f__cabs( z->r, z->i ) );
return (f__cabs (z->r, z->i));
}
......@@ -3,9 +3,10 @@
#undef abs
#include "math.h"
void c_cos(complex *r, complex *z)
void
c_cos (complex * r, complex * z)
{
double zi = z->i, zr = z->r;
r->r = cos(zr) * cosh(zi);
r->i = - sin(zr) * sinh(zi);
}
double zi = z->i, zr = z->r;
r->r = cos (zr) * cosh (zi);
r->i = -sin (zr) * sinh (zi);
}
#include "f2c.h"
extern void sig_die(char*,int);
void c_div(complex *c, complex *a, complex *b)
extern void sig_die (char *, int);
void
c_div (complex * c, complex * a, complex * b)
{
double ratio, den;
double abr, abi, cr;
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) {
if ((abr = b->r) < 0.)
abr = -abr;
if ((abi = b->i) < 0.)
abi = -abi;
if (abr <= abi)
{
if (abi == 0)
{
#ifdef IEEE_COMPLEX_DIVIDE
float af, bf;
af = bf = abr;
if (a->i != 0 || a->r != 0)
af = 1.;
c->i = c->r = af / bf;
return;
float af, bf;
af = bf = abr;
if (a->i != 0 || a->r != 0)
af = 1.;
c->i = c->r = af / bf;
return;
#else
sig_die("complex division by zero", 1);
sig_die ("complex division by zero", 1);
#endif
}
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;
}
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;
}
......@@ -3,11 +3,12 @@
#undef abs
#include "math.h"
void c_exp(complex *r, complex *z)
void
c_exp (complex * r, complex * z)
{
double expx, zi = z->i;
double expx, zi = z->i;
expx = exp(z->r);
r->r = expx * cos(zi);
r->i = expx * sin(zi);
}
expx = exp (z->r);
r->r = expx * cos (zi);
r->i = expx * sin (zi);
}
......@@ -2,11 +2,12 @@
#undef abs
#include "math.h"
extern double f__cabs(double, double);
extern double f__cabs (double, double);
void c_log(complex *r, complex *z)
void
c_log (complex * r, complex * z)
{
double zi, zr;
r->i = atan2(zi = z->i, zr = z->r);
r->r = log( f__cabs(zr, zi) );
}
double zi, zr;
r->i = atan2 (zi = z->i, zr = z->r);
r->r = log (f__cabs (zr, zi));
}
......@@ -3,9 +3,10 @@
#undef abs
#include "math.h"
void c_sin(complex *r, complex *z)
void
c_sin (complex * r, complex * z)
{
double zi = z->i, zr = z->r;
r->r = sin(zr) * cosh(zi);
r->i = cos(zr) * sinh(zi);
}
double zi = z->i, zr = z->r;
r->r = sin (zr) * cosh (zi);
r->i = cos (zr) * sinh (zi);
}
......@@ -2,28 +2,29 @@
#undef abs
#include "math.h"
extern double f__cabs(double, double);
extern double f__cabs (double, double);
void c_sqrt(complex *r, complex *z)
void
c_sqrt (complex * r, complex * z)
{
double mag, t;
double zi = z->i, zr = z->r;
double mag, t;
double zi = z->i, zr = z->r;
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;
}
}
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;
}
}
#undef abs
#include <math.h>
double f__cabs(double real, double imag)
double
f__cabs (double real, double imag)
{
double temp;
double temp;
if(real < 0)
real = -real;
if(imag < 0)
imag = -imag;
if(imag > real){
temp = real;
real = imag;
imag = temp;
}
if((real+imag) == real)
return(real);
if (real < 0)
real = -real;
if (imag < 0)
imag = -imag;
if (imag > real)
{
temp = real;
real = imag;
imag = temp;
}
if ((real + imag) == real)
return (real);
temp = imag/real;
temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/
return(temp);
temp = imag / real;
temp = real * sqrt (1.0 + temp * temp); /*overflow!! */
return (temp);
}
#include "f2c.h"
double d_abs(doublereal *x)
double
d_abs (doublereal * x)
{
if(*x >= 0)
return(*x);
return(- *x);
if (*x >= 0)
return (*x);
return (-*x);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_acos(doublereal *x)
double
d_acos (doublereal * x)
{
return( acos(*x) );
return (acos (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_asin(doublereal *x)
double
d_asin (doublereal * x)
{
return( asin(*x) );
return (asin (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_atan(doublereal *x)
double
d_atan (doublereal * x)
{
return( atan(*x) );
return (atan (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_atn2(doublereal *x, doublereal *y)
double
d_atn2 (doublereal * x, doublereal * y)
{
return( atan2(*x,*y) );
return (atan2 (*x, *y));
}
#include "f2c.h"
void
d_cnjg(doublecomplex *r, doublecomplex *z)
d_cnjg (doublecomplex * r, doublecomplex * z)
{
doublereal zi = z->i;
r->r = z->r;
r->i = -zi;
}
doublereal zi = z->i;
r->r = z->r;
r->i = -zi;
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_cos(doublereal *x)
double
d_cos (doublereal * x)
{
return( cos(*x) );
return (cos (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_cosh(doublereal *x)
double
d_cosh (doublereal * x)
{
return( cosh(*x) );
return (cosh (*x));
}
#include "f2c.h"
double d_dim(doublereal *a, doublereal *b)
double
d_dim (doublereal * a, doublereal * b)
{
return( *a > *b ? *a - *b : 0);
return (*a > *b ? *a - *b : 0);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_exp(doublereal *x)
double
d_exp (doublereal * x)
{
return( exp(*x) );
return (exp (*x));
}
#include "f2c.h"
double d_imag(doublecomplex *z)
double
d_imag (doublecomplex * z)
{
return(z->i);
return (z->i);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_int(doublereal *x)
double
d_int (doublereal * x)
{
return( (*x>0) ? floor(*x) : -floor(- *x) );
return ((*x > 0) ? floor (*x) : -floor (-*x));
}
......@@ -4,7 +4,8 @@
#undef abs
#include <math.h>
double d_lg10(doublereal *x)
double
d_lg10 (doublereal * x)
{
return( log10e * log(*x) );
return (log10e * log (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_log(doublereal *x)
double
d_log (doublereal * x)
{
return( log(*x) );
return (log (*x));
}
#include "f2c.h"
#ifdef IEEE_drem
double drem(double, double);
double drem (double, double);
#else
#undef abs
#include <math.h>
#endif
double d_mod(doublereal *x, doublereal *y)
double
d_mod (doublereal * x, doublereal * y)
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem(xa = *x, ya);
if (xa > 0) {
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem (xa = *x, ya);
if (xa > 0)
{
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if( (quotient = *x / *y) >= 0)
quotient = floor(quotient);
else
quotient = -floor(-quotient);
return(*x - (*y) * quotient );
double quotient;
if ((quotient = *x / *y) >= 0)
quotient = floor (quotient);
else
quotient = -floor (-quotient);
return (*x - (*y) * quotient);
#endif
}
......@@ -2,8 +2,8 @@
#undef abs
#include <math.h>
double d_nint(doublereal *x)
double
d_nint (doublereal * x)
{
return( (*x)>=0 ?
floor(*x + .5) : -floor(.5 - *x) );
return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
#include "f2c.h"
double d_prod(real *x, real *y)
double
d_prod (real * x, real * y)
{
return( (*x) * (*y) );
return ((*x) * (*y));
}
#include "f2c.h"
double d_sign(doublereal *a, doublereal *b)
double
d_sign (doublereal * a, doublereal * b)
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
double x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_sin(doublereal *x)
double
d_sin (doublereal * x)
{
return( sin(*x) );
return (sin (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_sinh(doublereal *x)
double
d_sinh (doublereal * x)
{
return( sinh(*x) );
return (sinh (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_sqrt(doublereal *x)
double
d_sqrt (doublereal * x)
{
return( sqrt(*x) );
return (sqrt (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_tan(doublereal *x)
double
d_tan (doublereal * x)
{
return( tan(*x) );
return (tan (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double d_tanh(doublereal *x)
double
d_tanh (doublereal * x)
{
return( tanh(*x) );
return (tanh (*x));
}
#include "f2c.h"
extern double erf(double);
double G77_derf_0 (doublereal *x)
extern double erf (double);
double
G77_derf_0 (doublereal * x)
{
return( erf(*x) );
return (erf (*x));
}
#include "f2c.h"
extern double erfc(double);
extern double erfc (double);
double G77_derfc_0 (doublereal *x)
double
G77_derfc_0 (doublereal * x)
{
return( erfc(*x) );
return (erfc (*x));
}
......@@ -23,27 +23,27 @@
#endif
#endif
double
dtime_(float *tarray)
double
dtime_ (float *tarray)
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
static double t0;
double t = clock();
tarray[1] = 0;
tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
t0 = t;
return tarray[0];
static double t0;
double t = clock ();
tarray[1] = 0;
tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
t0 = t;
return tarray[0];
#else
struct tms t;
static struct tms t0;
struct tms t;
static struct tms t0;
times(&t);
tarray[0] = (double)(t.tms_utime - t0.tms_utime) / Hz;
tarray[1] = (double)(t.tms_stime - t0.tms_stime) / Hz;
t0 = t;
return tarray[0] + tarray[1];
times (&t);
tarray[0] = (double) (t.tms_utime - t0.tms_utime) / Hz;
tarray[1] = (double) (t.tms_stime - t0.tms_stime) / Hz;
t0 = t;
return tarray[0] + tarray[1];
#endif
}
}
......@@ -6,9 +6,10 @@
#define M ( (long) (sizeof(long) - 1) )
#define EVEN(x) ( ( (x)+ M) & (~M) )
extern void s_copy(char*,char*,ftnlen,ftnlen);
int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
extern void s_copy (char *, char *, ftnlen, ftnlen);
int
G77_ef1asc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
{
s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
return 0; /* ignored return value */
s_copy ((char *) a, (char *) b, EVEN (*la), *lb);
return 0; /* ignored return value */
}
......@@ -2,8 +2,9 @@
#include "f2c.h"
extern integer s_cmp(char*,char*,ftnlen,ftnlen);
integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
integer
G77_ef1cmc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
{
return( s_cmp( (char *)a, (char *)b, *la, *lb) );
return (s_cmp ((char *) a, (char *) b, *la, *lb));
}
#include "f2c.h"
extern double erf(double);
double G77_erf_0 (real *x)
extern double erf (double);
double
G77_erf_0 (real * x)
{
return( erf(*x) );
return (erf (*x));
}
#include "f2c.h"
extern double erfc(double);
double G77_erfc_0 (real *x)
extern double erfc (double);
double
G77_erfc_0 (real * x)
{
return( erfc(*x) );
return (erfc (*x));
}
......@@ -23,21 +23,21 @@
#endif
#endif
double
etime_(float *tarray)
double
etime_ (float *tarray)
{
#ifdef USE_CLOCK
#ifndef CLOCKS_PER_SECOND
#define CLOCKS_PER_SECOND Hz
#endif
double t = clock();
tarray[1] = 0;
return tarray[0] = t / CLOCKS_PER_SECOND;
double t = clock ();
tarray[1] = 0;
return tarray[0] = t / CLOCKS_PER_SECOND;
#else
struct tms t;
struct tms t;
times(&t);
return (tarray[0] = (double)t.tms_utime/Hz)
+ (tarray[1] = (double)t.tms_stime/Hz);
times (&t);
return (tarray[0] = (double) t.tms_utime / Hz)
+ (tarray[1] = (double) t.tms_stime / Hz);
#endif
}
}
......@@ -13,13 +13,13 @@
#undef min
#undef max
#include <stdlib.h>
extern void f_exit(void);
extern void f_exit (void);
void
G77_exit_0 (integer *rc)
void
G77_exit_0 (integer * rc)
{
#ifdef NO_ONEXIT
f_exit();
f_exit ();
#endif
exit(*rc);
}
exit (*rc);
}
......@@ -6,19 +6,20 @@
* variable argument c
*/
void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls)
void
G77_getarg_0 (ftnint * n, register char *s, ftnlen ls)
{
extern int f__xargc;
extern char **f__xargv;
register char *t;
register int i;
extern int f__xargc;
extern char **f__xargv;
register char *t;
register int i;
if(*n>=0 && *n<f__xargc)
t = f__xargv[*n];
else
t = "";
for(i = 0; i<ls && *t!='\0' ; ++i)
*s++ = *t++;
for( ; i<ls ; ++i)
*s++ = ' ';
if (*n >= 0 && *n < f__xargc)
t = f__xargv[*n];
else
t = "";
for (i = 0; i < ls && *t != '\0'; ++i)
*s++ = *t++;
for (; i < ls; ++i)
*s++ = ' ';
}
......@@ -2,7 +2,7 @@
#undef abs
#include <stdlib.h>
#include <string.h>
extern char *F77_aloc(ftnlen, char*);
extern char *F77_aloc (ftnlen, char *);
/*
* getenv - f77 subroutine to return environment variables
......@@ -16,32 +16,34 @@ extern char *F77_aloc(ftnlen, char*);
* if ENV_NAME is not defined
*/
void
void
G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
{
char buf[256], *ep, *fp;
integer i;
char buf[256], *ep, *fp;
integer i;
if (flen <= 0)
goto add_blanks;
for(i = 0; i < sizeof(buf); i++) {
if (i == flen || (buf[i] = fname[i]) == ' ') {
buf[i] = 0;
ep = getenv(buf);
goto have_ep;
}
}
while(i < flen && fname[i] != ' ')
i++;
strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i);
fp[i] = 0;
ep = getenv(fp);
free(fp);
have_ep:
if (ep)
while(*ep && vlen-- > 0)
*value++ = *ep++;
add_blanks:
while(vlen-- > 0)
*value++ = ' ';
if (flen <= 0)
goto add_blanks;
for (i = 0; i < sizeof (buf); i++)
{
if (i == flen || (buf[i] = fname[i]) == ' ')
{
buf[i] = 0;
ep = getenv (buf);
goto have_ep;
}
}
while (i < flen && fname[i] != ' ')
i++;
strncpy (fp = F77_aloc (i + 1, "getenv_"), fname, (int) i);
fp[i] = 0;
ep = getenv (fp);
free (fp);
have_ep:
if (ep)
while (*ep && vlen-- > 0)
*value++ = *ep++;
add_blanks:
while (vlen-- > 0)
*value++ = ' ';
}
#include "f2c.h"
shortint h_abs(shortint *x)
shortint
h_abs (shortint * x)
{
if(*x >= 0)
return(*x);
return(- *x);
if (*x >= 0)
return (*x);
return (-*x);
}
#include "f2c.h"
shortint h_dim(shortint *a, shortint *b)
shortint
h_dim (shortint * a, shortint * b)
{
return( *a > *b ? *a - *b : 0);
return (*a > *b ? *a - *b : 0);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
shortint h_dnnt(doublereal *x)
shortint
h_dnnt (doublereal * x)
{
return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
return (shortint) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
}
#include "f2c.h"
shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb)
shortint
h_indx (char *a, char *b, ftnlen la, ftnlen lb)
{
ftnlen i, n;
char *s, *t, *bend;
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
n = la - lb + 1;
bend = b + lb;
for(i = 0 ; i < n ; ++i)
{
s = a + i;
t = b;
while(t < bend)
if(*s++ != *t++)
goto no;
return((shortint)i+1);
no: ;
}
return(0);
for (i = 0; i < n; ++i)
{
s = a + i;
t = b;
while (t < bend)
if (*s++ != *t++)
goto no;
return ((shortint) i + 1);
no:;
}
return (0);
}
#include "f2c.h"
shortint h_len(char *s, ftnlen n)
shortint
h_len (char *s, ftnlen n)
{
return(n);
return (n);
}
#include "f2c.h"
shortint h_mod(short *a, short *b)
shortint
h_mod (short *a, short *b)
{
return( *a % *b);
return (*a % *b);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
shortint h_nint(real *x)
shortint
h_nint (real * x)
{
return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
return (shortint) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
#include "f2c.h"
shortint h_sign(shortint *a, shortint *b)
shortint
h_sign (shortint * a, shortint * b)
{
shortint x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
shortint x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_ge (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) >= 0);
return (s_cmp (a, b, la, lb) >= 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_gt (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) > 0);
return (s_cmp (a, b, la, lb) > 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_le (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) <= 0);
return (s_cmp (a, b, la, lb) <= 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
shortlogical
hl_lt (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) < 0);
return (s_cmp (a, b, la, lb) < 0);
}
#include "f2c.h"
integer i_abs(integer *x)
integer
i_abs (integer * x)
{
if(*x >= 0)
return(*x);
return(- *x);
if (*x >= 0)
return (*x);
return (-*x);
}
#include "f2c.h"
integer i_dim(integer *a, integer *b)
integer
i_dim (integer * a, integer * b)
{
return( *a > *b ? *a - *b : 0);
return (*a > *b ? *a - *b : 0);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
integer i_dnnt(doublereal *x)
integer
i_dnnt (doublereal * x)
{
return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
return (integer) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
}
#include "f2c.h"
integer i_indx(char *a, char *b, ftnlen la, ftnlen lb)
integer
i_indx (char *a, char *b, ftnlen la, ftnlen lb)
{
ftnlen i, n;
char *s, *t, *bend;
ftnlen i, n;
char *s, *t, *bend;
n = la - lb + 1;
bend = b + lb;
n = la - lb + 1;
bend = b + lb;
for(i = 0 ; i < n ; ++i)
{
s = a + i;
t = b;
while(t < bend)
if(*s++ != *t++)
goto no;
return(i+1);
no: ;
}
return(0);
for (i = 0; i < n; ++i)
{
s = a + i;
t = b;
while (t < bend)
if (*s++ != *t++)
goto no;
return (i + 1);
no:;
}
return (0);
}
#include "f2c.h"
integer i_len(char *s, ftnlen n)
integer
i_len (char *s, ftnlen n)
{
return(n);
return (n);
}
#include "f2c.h"
integer i_mod(integer *a, integer *b)
integer
i_mod (integer * a, integer * b)
{
return( *a % *b);
return (*a % *b);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
integer i_nint(real *x)
integer
i_nint (real * x)
{
return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
return (integer) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
}
#include "f2c.h"
integer i_sign(integer *a, integer *b)
integer
i_sign (integer * a, integer * b)
{
integer x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
integer x;
x = (*a >= 0 ? *a : -*a);
return (*b >= 0 ? x : -x);
}
#include "f2c.h"
ftnint G77_iargc_0 (void)
ftnint
G77_iargc_0 (void)
{
extern int f__xargc;
return ( f__xargc - 1 );
extern int f__xargc;
return (f__xargc - 1);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
logical l_ge(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_ge (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) >= 0);
return (s_cmp (a, b, la, lb) >= 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
logical l_gt(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_gt (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) > 0);
return (s_cmp (a, b, la, lb) > 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
logical l_le(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_le (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) <= 0);
return (s_cmp (a, b, la, lb) <= 0);
}
#include "f2c.h"
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
logical l_lt(char *a, char *b, ftnlen la, ftnlen lb)
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
logical
l_lt (char *a, char *b, ftnlen la, ftnlen lb)
{
return(s_cmp(a,b,la,lb) < 0);
return (s_cmp (a, b, la, lb) < 0);
}
......@@ -4,51 +4,55 @@
#define LONGBITS 32
#endif
integer
lbit_bits(integer a, integer b, integer len)
integer
lbit_bits (integer a, integer b, integer len)
{
/* Assume 2's complement arithmetic */
/* Assume 2's complement arithmetic */
unsigned long x, y;
unsigned long x, y;
x = (unsigned long) a;
y = (unsigned long)-1L;
x >>= b;
y <<= len;
return (integer)(x & ~y);
}
x = (unsigned long) a;
y = (unsigned long) -1L;
x >>= b;
y <<= len;
return (integer) (x & ~y);
}
integer
lbit_cshift(integer a, integer b, integer len)
integer
lbit_cshift (integer a, integer b, integer len)
{
unsigned long x, y, z;
unsigned long x, y, z;
x = (unsigned long)a;
if (len <= 0) {
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONGBITS) {
full_len:
if (b >= 0) {
b %= LONGBITS;
return (integer)(x << b | x >> LONGBITS -b );
}
b = -b;
b %= LONGBITS;
return (integer)(x << LONGBITS - b | x >> b);
}
y = z = (unsigned long)-1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0) {
b %= len;
return (integer)(y | z & (x << b | x >> len - b));
}
b = -b;
b %= len;
return (integer)(y | z & (x >> b | x << len - b));
x = (unsigned long) a;
if (len <= 0)
{
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONGBITS)
{
full_len:
if (b >= 0)
{
b %= LONGBITS;
return (integer) (x << b | x >> LONGBITS - b);
}
b = -b;
b %= LONGBITS;
return (integer) (x << LONGBITS - b | x >> b);
}
y = z = (unsigned long) -1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0)
{
b %= len;
return (integer) (y | z & (x << b | x >> len - b));
}
b = -b;
b %= len;
return (integer) (y | z & (x >> b | x << len - b));
}
#include "f2c.h"
integer
lbit_shift(integer a, integer b)
integer
lbit_shift (integer a, integer b)
{
return b >= 0 ? a << b : (integer)((uinteger)a >> -b);
}
return b >= 0 ? a << b : (integer) ((uinteger) a >> -b);
}
......@@ -5,28 +5,28 @@
#include <stdlib.h>
extern void f_exit(void);
extern void f_exit (void);
#ifndef NO_ONEXIT
#define ONEXIT atexit
extern int atexit(void (*)(void));
extern int atexit (void (*)(void));
#endif
extern void f_init(void);
extern int MAIN__(void);
extern void f_init (void);
extern int MAIN__ (void);
main(int argc, char **argv)
main (int argc, char **argv)
{
f_setarg(argc, argv);
f_setsig();
f_init();
f_setarg (argc, argv);
f_setsig ();
f_init ();
#ifndef NO_ONEXIT
ONEXIT(f_exit);
ONEXIT (f_exit);
#endif
MAIN__();
MAIN__ ();
#ifdef NO_ONEXIT
f_exit();
f_exit ();
#endif
exit(0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
exit (0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
}
#include "f2c.h"
extern void pow_zi(doublecomplex*, doublecomplex*, integer*);
void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */
extern void pow_zi (doublecomplex *, doublecomplex *, integer *);
void
pow_ci (complex * p, complex * a, integer * b) /* p = a**b */
{
doublecomplex p1, a1;
doublecomplex p1, a1;
a1.r = a->r;
a1.i = a->i;
a1.r = a->r;
a1.i = a->i;
pow_zi(&p1, &a1, b);
pow_zi (&p1, &a1, b);
p->r = p1.r;
p->i = p1.i;
p->r = p1.r;
p->i = p1.i;
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double pow_dd(doublereal *ap, doublereal *bp)
double
pow_dd (doublereal * ap, doublereal * bp)
{
return(pow(*ap, *bp) );
return (pow (*ap, *bp));
}
#include "f2c.h"
double pow_di(doublereal *ap, integer *bp)
double
pow_di (doublereal * ap, integer * bp)
{
double pow, x;
integer n;
unsigned long u;
double pow, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
pow = 1;
x = *ap;
n = *bp;
if(n != 0)
if (n != 0)
{
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;
}
n = -n;
x = 1 / x;
}
return(pow);
for (u = n;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
}
return (pow);
}
#include "f2c.h"
shortint pow_hh(shortint *ap, shortint *bp)
shortint
pow_hh (shortint * ap, shortint * bp)
{
shortint pow, x, n;
unsigned u;
shortint pow, x, n;
unsigned u;
x = *ap;
n = *bp;
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
#include "f2c.h"
integer pow_ii(integer *ap, integer *bp)
integer
pow_ii (integer * ap, integer * bp)
{
integer pow, x, n;
unsigned long u;
integer pow, x, n;
unsigned long u;
x = *ap;
n = *bp;
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
#include "f2c.h"
longint pow_qq(longint *ap, longint *bp)
longint
pow_qq (longint * ap, longint * bp)
{
longint pow, x, n;
unsigned long long u; /* system-dependent */
longint pow, x, n;
unsigned long long u; /* system-dependent */
x = *ap;
n = *bp;
x = *ap;
n = *bp;
if (n <= 0) {
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1/x : 0;
n = -n;
}
u = n;
for(pow = 1; ; )
{
if(u & 01)
pow *= x;
if(u >>= 1)
x *= x;
else
break;
}
return(pow);
}
if (n <= 0)
{
if (n == 0 || x == 1)
return 1;
if (x != -1)
return x == 0 ? 1 / x : 0;
n = -n;
}
u = n;
for (pow = 1;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
return (pow);
}
#include "f2c.h"
double pow_ri(real *ap, integer *bp)
double
pow_ri (real * ap, integer * bp)
{
double pow, x;
integer n;
unsigned long u;
double pow, x;
integer n;
unsigned long u;
pow = 1;
x = *ap;
n = *bp;
pow = 1;
x = *ap;
n = *bp;
if(n != 0)
if (n != 0)
{
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;
}
n = -n;
x = 1 / x;
}
return(pow);
for (u = n;;)
{
if (u & 01)
pow *= x;
if (u >>= 1)
x *= x;
else
break;
}
}
return (pow);
}
#include "f2c.h"
extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */
extern void z_div (doublecomplex *, doublecomplex *, doublecomplex *);
void
pow_zi (doublecomplex * p, doublecomplex * a, integer * b) /* p = a**b */
{
integer n;
unsigned long u;
double t;
doublecomplex q, x;
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;
q.r = 1;
q.i = 0;
n = *b;
q.r = 1;
q.i = 0;
if(n == 0)
goto done;
if(n < 0)
{
n = -n;
z_div(&x, &one, a);
}
else
{
x.r = a->r;
x.i = a->i;
}
if (n == 0)
goto done;
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)
{
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;
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;
}
......@@ -2,17 +2,18 @@
#undef abs
#include <math.h>
extern double f__cabs(double,double);
void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b)
extern double f__cabs (double, double);
void
pow_zz (doublecomplex * r, doublecomplex * a, doublecomplex * b)
{
double logr, logi, x, y;
double logr, logi, x, y;
logr = log( f__cabs(a->r, a->i) );
logi = atan2(a->i, a->r);
logr = log (f__cabs (a->r, a->i));
logi = atan2 (a->i, a->r);
x = exp( logr * b->r - logi * b->i );
y = logr * b->i + logi * b->r;
x = exp (logr * b->r - logi * b->i);
y = logr * b->i + logi * b->r;
r->r = x * cos(y);
r->i = x * sin(y);
r->r = x * cos (y);
r->i = x * sin (y);
}
......@@ -8,51 +8,55 @@
#define LONG8BITS (2*LONGBITS)
#endif
integer
qbit_bits(longint a, integer b, integer len)
integer
qbit_bits (longint a, integer b, integer len)
{
/* Assume 2's complement arithmetic */
/* Assume 2's complement arithmetic */
ulongint x, y;
ulongint x, y;
x = (ulongint) a;
y = (ulongint)-1L;
x >>= b;
y <<= len;
return (longint)(x & y);
}
x = (ulongint) a;
y = (ulongint) - 1L;
x >>= b;
y <<= len;
return (longint) (x & y);
}
longint
qbit_cshift(longint a, integer b, integer len)
longint
qbit_cshift (longint a, integer b, integer len)
{
ulongint x, y, z;
ulongint x, y, z;
x = (ulongint)a;
if (len <= 0) {
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONG8BITS) {
full_len:
if (b >= 0) {
b %= LONG8BITS;
return (longint)(x << b | x >> LONG8BITS - b );
}
b = -b;
b %= LONG8BITS;
return (longint)(x << LONG8BITS - b | x >> b);
}
y = z = (unsigned long)-1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0) {
b %= len;
return (longint)(y | z & (x << b | x >> len - b));
}
b = -b;
b %= len;
return (longint)(y | z & (x >> b | x << len - b));
x = (ulongint) a;
if (len <= 0)
{
if (len == 0)
return 0;
goto full_len;
}
if (len >= LONG8BITS)
{
full_len:
if (b >= 0)
{
b %= LONG8BITS;
return (longint) (x << b | x >> LONG8BITS - b);
}
b = -b;
b %= LONG8BITS;
return (longint) (x << LONG8BITS - b | x >> b);
}
y = z = (unsigned long) -1;
y <<= len;
z &= ~y;
y &= x;
x &= z;
if (b >= 0)
{
b %= len;
return (longint) (y | z & (x << b | x >> len - b));
}
b = -b;
b %= len;
return (longint) (y | z & (x >> b | x << len - b));
}
#include "f2c.h"
longint
qbit_shift(longint a, integer b)
longint
qbit_shift (longint a, integer b)
{
return b >= 0 ? a << b : (longint)((ulongint)a >> -b);
}
return b >= 0 ? a << b : (longint) ((ulongint) a >> -b);
}
#include "f2c.h"
double r_abs(real *x)
double
r_abs (real * x)
{
if(*x >= 0)
return(*x);
return(- *x);
if (*x >= 0)
return (*x);
return (-*x);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_acos(real *x)
double
r_acos (real * x)
{
return( acos(*x) );
return (acos (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_asin(real *x)
double
r_asin (real * x)
{
return( asin(*x) );
return (asin (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_atan(real *x)
double
r_atan (real * x)
{
return( atan(*x) );
return (atan (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_atn2(real *x, real *y)
double
r_atn2 (real * x, real * y)
{
return( atan2(*x,*y) );
return (atan2 (*x, *y));
}
#include "f2c.h"
void
r_cnjg(complex *r, complex *z)
r_cnjg (complex * r, complex * z)
{
real zi = z->i;
r->r = z->r;
r->i = -zi;
}
real zi = z->i;
r->r = z->r;
r->i = -zi;
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_cos(real *x)
double
r_cos (real * x)
{
return( cos(*x) );
return (cos (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_cosh(real *x)
double
r_cosh (real * x)
{
return( cosh(*x) );
return (cosh (*x));
}
#include "f2c.h"
double r_dim(real *a, real *b)
double
r_dim (real * a, real * b)
{
return( *a > *b ? *a - *b : 0);
return (*a > *b ? *a - *b : 0);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_exp(real *x)
double
r_exp (real * x)
{
return( exp(*x) );
return (exp (*x));
}
#include "f2c.h"
double r_imag(complex *z)
double
r_imag (complex * z)
{
return(z->i);
return (z->i);
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_int(real *x)
double
r_int (real * x)
{
return( (*x>0) ? floor(*x) : -floor(- *x) );
return ((*x > 0) ? floor (*x) : -floor (-*x));
}
......@@ -4,7 +4,8 @@
#undef abs
#include <math.h>
double r_lg10(real *x)
double
r_lg10 (real * x)
{
return( log10e * log(*x) );
return (log10e * log (*x));
}
......@@ -2,7 +2,8 @@
#undef abs
#include <math.h>
double r_log(real *x)
double
r_log (real * x)
{
return( log(*x) );
return (log (*x));
}
#include "f2c.h"
#ifdef IEEE_drem
double drem(double, double);
double drem (double, double);
#else
#undef abs
#include <math.h>
#endif
double r_mod(real *x, real *y)
double
r_mod (real * x, real * y)
{
#ifdef IEEE_drem
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem(xa = *x, ya);
if (xa > 0) {
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
double xa, ya, z;
if ((ya = *y) < 0.)
ya = -ya;
z = drem (xa = *x, ya);
if (xa > 0)
{
if (z < 0)
z += ya;
}
else if (z > 0)
z -= ya;
return z;
#else
double quotient;
if( (quotient = (double)*x / *y) >= 0)
quotient = floor(quotient);
else
quotient = -floor(-quotient);
return(*x - (*y) * quotient );
double quotient;
if ((quotient = (double) *x / *y) >= 0)
quotient = floor (quotient);
else
quotient = -floor (-quotient);
return (*x - (*y) * quotient);
#endif
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment