Return to libF77.st0 CVS log

Up to [Research Unix] / researchv10no / cmd / f2c

researchv10 Norman

./ ADD NAME=libF77/README TIME=627343162
If your system lacks onexit() and you are not using an ANSI C
compiler, then you should compile main.c with NO_ONEXIT defined.
See the comments about onexit in the makefile.

If your system lacks a _cleanup routine (which is called just
before abort(), e.g. to flush buffers), just add a dummy, i.e.,
	_cleanup() {}
to libF77.
./ ADD NAME=libF77/makefile TIME=627748011
.SUFFIXES: .c .o
# compile, then strip unnecessary symbols
.c.o:
	cc -O -c $*.c
	ld -r -x $*.o
	mv a.out $*.o

MISC =	Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o getenv_.o\
	signal_.o s_stop.o s_paus.o system_.o cabs.o\
	derf_.o derfc_.o erf_.o erfc_.o
POW =	pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o  pow_ri.o pow_zi.o pow_zz.o
CX =	c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
DCX =	z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
REAL =	r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
	r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
	r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
	r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
DBL =	d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
	d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
	d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
	d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
	d_sqrt.o d_tan.o d_tanh.o 
INT =	i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
HALF =	h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o  h_nint.o h_sign.o
CMP =	l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
EFL =	ef1asc_.o ef1cmc_.o
CHAR =	s_cat.o s_cmp.o s_copy.o 

libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
	$(HALF) $(CMP) $(EFL) $(CHAR)
	ar r libF77.a $?
	ranlib libF77.a

Version.o: Version.c
	cc -c Version.c

# If your system lacks onexit() and you are not using an
# ANSI C compiler, then you should uncomment the following
# two lines (for compiling main.o):
#main.o: main.c
#	cc -c -DNO_ONEXIT main.c
# On at least some Sun systems, it is more appropriate to
# uncomment the following two lines:
#main.o: main.c
#	cc -c -Donexit=on_exit main.c

install:	libF77.a
	mv libF77.a /usr/lib

clean:
	rm -f libF77.a *.o
./ ADD NAME=libF77/Version.c TIME=628430639
static char junk[] = "\n@(#)LIBF77 VERSION 2.01   30 Nov. 1989\n";

/*
2.00	11 June 1980.  File version.c added to library.
2.01	31 May 1988.  s_paus() flushes stderr; names of hl_* fixed
	[ d]erf[c ] added
	8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
	29 Nov. 1989: s_cmp returns long (for f2c).
	30 Nov. 1989: arg types from argtypes.h
*/
./ ADD NAME=libF77/abort_.c TIME=628474861
#include "stdio.h"
#include "f2c.h"

extern VOID abort();

VOID abort_()
{
fprintf(stderr, "Fortran abort routine called\n");
_cleanup();
abort();
}
./ ADD NAME=libF77/c_abs.c TIME=628437500
#include "f2c.h"

double c_abs(z)
complex *z;
{
double cabs();

return( cabs( z->r, z->i ) );
}
./ ADD NAME=libF77/c_cos.c TIME=628437500
#include "f2c.h"

VOID c_cos(r, z)
complex *r, *z;
{
double sin(), cos(), sinh(), cosh();

r->r = cos(z->r) * cosh(z->i);
r->i = - sin(z->r) * sinh(z->i);
}
./ ADD NAME=libF77/c_div.c TIME=628437671
#include "f2c.h"

VOID c_div(c, a, b)
complex *a, *b, *c;
{
double ratio, den;
double abr, abi;

if( (abr = b->r) < 0.)
	abr = - abr;
if( (abi = b->i) < 0.)
	abi = - abi;
if( abr <= abi )
	{
	if(abi == 0)
		abort(); /* fatal("complex division by zero"); */
	ratio = b->r / b->i ;
	den = b->i * (1 + ratio*ratio);
	c->r = (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);
	c->r = (a->r + a->i*ratio) / den;
	c->i = (a->i - a->r*ratio) / den;
	}
}
./ ADD NAME=libF77/c_exp.c TIME=628437500
#include "f2c.h"

VOID c_exp(r, z)
complex *r, *z;
{
double expx;
double exp(), cos(), sin();

expx = exp(z->r);
r->r = expx * cos(z->i);
r->i = expx * sin(z->i);
}
./ ADD NAME=libF77/c_log.c TIME=628437500
#include "f2c.h"

VOID c_log(r, z)
complex *r, *z;
{
double log(), cabs(), atan2();

r->i = atan2(z->i, z->r);
r->r = log( cabs(z->r, z->i) );
}
./ ADD NAME=libF77/c_sin.c TIME=628437501
#include "f2c.h"

VOID c_sin(r, z)
complex *r, *z;
{
double sin(), cos(), sinh(), cosh();

r->r = sin(z->r) * cosh(z->i);
r->i = cos(z->r) * sinh(z->i);
}
./ ADD NAME=libF77/c_sqrt.c TIME=628437501
#include "f2c.h"

VOID c_sqrt(r, z)
complex *r, *z;
{
double mag, sqrt(), cabs();

if( (mag = cabs(z->r, z->i)) == 0.)
	r->r = r->i = 0.;
else if(z->r > 0)
	{
	r->r = sqrt(0.5 * (mag + z->r) );
	r->i = z->i / r->r / 2;
	}
else
	{
	r->i = sqrt(0.5 * (mag - z->r) );
	if(z->i < 0)
		r->i = - r->i;
	r->r = z->i / r->i /2;
	}
}
./ ADD NAME=libF77/cabs.c TIME=379733534
double cabs(real, imag)
double real, imag;
{
double temp, sqrt();

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);
}
./ ADD NAME=libF77/argtypes.h TIME=628436547
typedef long integer;
typedef short shortint;
typedef double doublereal;
typedef float real;
typedef struct { float real, imag; } complex;
typedef struct { double dreal, dimag; } dcomplex;
typedef void VOID;
/* VOID can be int on systems that do not recognize void */
./ ADD NAME=libF77/d_abs.c TIME=628437501
#include "f2c.h"

double d_abs(x)
doublereal *x;
{
if(*x >= 0)
	return(*x);
return(- *x);
}
./ ADD NAME=libF77/d_acos.c TIME=628437502
#include "f2c.h"

double d_acos(x)
doublereal *x;
{
double acos();
return( acos(*x) );
}
./ ADD NAME=libF77/d_asin.c TIME=628437502
#include "f2c.h"

double d_asin(x)
doublereal *x;
{
double asin();
return( asin(*x) );
}
./ ADD NAME=libF77/d_atan.c TIME=628437502
#include "f2c.h"

double d_atan(x)
doublereal *x;
{
double atan();
return( atan(*x) );
}
./ ADD NAME=libF77/d_atn2.c TIME=628437502
#include "f2c.h"

double d_atn2(x,y)
doublereal *x, *y;
{
double atan2();
return( atan2(*x,*y) );
}
./ ADD NAME=libF77/d_cnjg.c TIME=628437502
#include "f2c.h"

d_cnjg(r, z)
doublecomplex *r, *z;
{
r->r = z->r;
r->i = - z->i;
}
./ ADD NAME=libF77/d_cos.c TIME=628437502
#include "f2c.h"

double d_cos(x)
doublereal *x;
{
double cos();
return( cos(*x) );
}
./ ADD NAME=libF77/d_cosh.c TIME=628437503
#include "f2c.h"

double d_cosh(x)
doublereal *x;
{
double cosh();
return( cosh(*x) );
}
./ ADD NAME=libF77/d_dim.c TIME=628437503
#include "f2c.h"

double d_dim(a,b)
doublereal *a, *b;
{
return( *a > *b ? *a - *b : 0);
}
./ ADD NAME=libF77/d_exp.c TIME=628437503
#include "f2c.h"

double d_exp(x)
doublereal *x;
{
double exp();
return( exp(*x) );
}
./ ADD NAME=libF77/d_imag.c TIME=628437503
#include "f2c.h"

double d_imag(z)
doublecomplex *z;
{
return(z->i);
}
./ ADD NAME=libF77/d_int.c TIME=628437503
#include "f2c.h"

double d_int(x)
doublereal *x;
{
double floor();

return( (*x>0) ? floor(*x) : -floor(- *x) );
}
./ ADD NAME=libF77/d_lg10.c TIME=628437503
#include "f2c.h"

#define log10e 0.43429448190325182765

double d_lg10(x)
doublereal *x;
{
double log();

return( log10e * log(*x) );
}
./ ADD NAME=libF77/d_log.c TIME=628437503
#include "f2c.h"

double d_log(x)
doublereal *x;
{
double log();
return( log(*x) );
}
./ ADD NAME=libF77/d_mod.c TIME=628437503
#include "f2c.h"

double d_mod(x,y)
doublereal *x, *y;
{
double floor(), quotient;
if( (quotient = *x / *y) >= 0)
	quotient = floor(quotient);
else
	quotient = -floor(-quotient);
return(*x - (*y) * quotient );
}
./ ADD NAME=libF77/d_nint.c TIME=628437504
#include "f2c.h"

double d_nint(x)
doublereal *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/d_prod.c TIME=628437504
#include "f2c.h"

double d_prod(x,y)
real *x, *y;
{
return( (*x) * (*y) );
}
./ ADD NAME=libF77/d_sign.c TIME=628437504
#include "f2c.h"

double d_sign(a,b)
doublereal *a, *b;
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
./ ADD NAME=libF77/d_sin.c TIME=628437504
#include "f2c.h"

double d_sin(x)
doublereal *x;
{
double sin();
return( sin(*x) );
}
./ ADD NAME=libF77/d_sinh.c TIME=628437504
#include "f2c.h"

double d_sinh(x)
doublereal *x;
{
double sinh();
return( sinh(*x) );
}
./ ADD NAME=libF77/d_sqrt.c TIME=628437504
#include "f2c.h"

double d_sqrt(x)
doublereal *x;
{
double sqrt();
return( sqrt(*x) );
}
./ ADD NAME=libF77/d_tan.c TIME=628437504
#include "f2c.h"

double d_tan(x)
doublereal *x;
{
double tan();
return( tan(*x) );
}
./ ADD NAME=libF77/d_tanh.c TIME=628437504
#include "f2c.h"

double d_tanh(x)
doublereal *x;
{
double tanh();
return( tanh(*x) );
}
./ ADD NAME=libF77/derf_.c TIME=628437505
#include "f2c.h"

double derf_(x)
doublereal *x;
{
double erf();

return( erf(*x) );
}
./ ADD NAME=libF77/derfc_.c TIME=628437505
#include "f2c.h"

double derfc_(x)
doublereal *x;
{
double erfc();

return( erfc(*x) );
}
./ ADD NAME=libF77/ef1asc_.c TIME=628437505
/* EFL support routine to copy string b to string a */

#include "f2c.h"

extern VOID s_copy();

#define M	( (long) (sizeof(long) - 1) )
#define EVEN(x)	( ( (x)+ M) & (~M) )

VOID ef1asc_(a, la, b, lb)
int *a, *b;
long int *la, *lb;
{
s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
}
./ ADD NAME=libF77/ef1cmc_.c TIME=628437505
/* EFL support routine to compare two character strings */

#include "f2c.h"

extern integer s_cmp();

integer ef1cmc_(a, la, b, lb)
integer *a, *b;
integer *la, *lb;
{
return( s_cmp( (char *)a, (char *)b, *la, *lb) );
}
./ ADD NAME=libF77/erf_.c TIME=628437505
#include "f2c.h"

double erf_(x)
real *x;
{
double erf();

return( erf(*x) );
}
./ ADD NAME=libF77/erfc_.c TIME=628437505
#include "f2c.h"

double erfc_(x)
real *x;
{
double erfc();

return( erfc(*x) );
}
./ ADD NAME=libF77/getarg_.c TIME=628437505
#include "f2c.h"

/*
 * subroutine getarg(k, c)
 * returns the kth unix command argument in fortran character
 * variable argument c
*/

VOID getarg_(n, s, ls)
long int *n;
register char *s;
long int ls;
{
extern int xargc;
extern char **xargv;
register char *t;
register int i;

if(*n>=0 && *n<xargc)
	t = xargv[*n];
else
	t = "";
for(i = 0; i<ls && *t!='\0' ; ++i)
	*s++ = *t++;
for( ; i<ls ; ++i)
	*s++ = ' ';
}
./ ADD NAME=libF77/getenv_.c TIME=628437505
#include "f2c.h"

/*
 * getenv - f77 subroutine to return environment variables
 *
 * called by:
 *	call getenv (ENV_NAME, char_var)
 * where:
 *	ENV_NAME is the name of an environment variable
 *	char_var is a character variable which will receive
 *		the current value of ENV_NAME, or all blanks
 *		if ENV_NAME is not defined
 */

VOID getenv_(fname, value, flen, vlen)
char *value, *fname;
long int vlen, flen;
{
extern char **environ;
register char *ep, *fp, *flast;
register char **env = environ;

flast = fname + flen;
for(fp = fname ; fp < flast ; ++fp)
	if(*fp == ' ')
		{
		flast = fp;
		break;
		}

while (ep = *env++)
	{
	for(fp = fname; fp<flast ; )
		if(*fp++ != *ep++)
			goto endloop;

	if(*ep++ == '=')	/* copy right hand side */
		while( *ep && --vlen>=0 )
			*value++ = *ep++;

	goto blank;

endloop: ;
	}

blank:
	while( --vlen >= 0 )
		*value++ = ' ';
}
./ ADD NAME=libF77/h_abs.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_abs(x)
shortint *x;
{
if(*x >= 0)
	return(*x);
return(- *x);
}
./ ADD NAME=libF77/h_dim.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_dim(a,b)
shortint *a, *b;
{
return( *a > *b ? *a - *b : 0);
}
./ ADD NAME=libF77/h_dnnt.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_dnnt(x)
doublereal *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/h_indx.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_indx(a, b, la, lb)
char *a, *b;
long int la, lb;
{
int i, n;
char *s, *t, *bend;

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);
}
./ ADD NAME=libF77/h_len.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_len(s, n)
char *s;
long int n;
{
return(n);
}
./ ADD NAME=libF77/h_mod.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_mod(a,b)
short *a, *b;
{
return( *a % *b);
}
./ ADD NAME=libF77/h_nint.c TIME=628437506
#include "f2c.h"

extern integer s_cmp();

shortint h_nint(x)
real *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/h_sign.c TIME=628437507
#include "f2c.h"

extern integer s_cmp();

shortint h_sign(a,b)
shortint *a, *b;
{
shortint x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
./ ADD NAME=libF77/hl_ge.c TIME=628437507
#include "f2c.h"

extern integer s_cmp();

shortint hl_ge(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) >= 0);
}
./ ADD NAME=libF77/hl_gt.c TIME=628437507
#include "f2c.h"

extern integer s_cmp();

shortint hl_gt(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) > 0);
}
./ ADD NAME=libF77/hl_le.c TIME=628437507
#include "f2c.h"

extern integer s_cmp();

shortint hl_le(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) <= 0);
}
./ ADD NAME=libF77/hl_lt.c TIME=628437507
#include "f2c.h"

extern integer s_cmp();

shortint hl_lt(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) < 0);
}
./ ADD NAME=libF77/i_abs.c TIME=628437507
#include "f2c.h"

integer i_abs(x)
integer *x;
{
if(*x >= 0)
	return(*x);
return(- *x);
}
./ ADD NAME=libF77/i_dim.c TIME=628437507
#include "f2c.h"

integer i_dim(a,b)
integer *a, *b;
{
return( *a > *b ? *a - *b : 0);
}
./ ADD NAME=libF77/i_dnnt.c TIME=628437507
#include "f2c.h"

integer i_dnnt(x)
doublereal *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/i_indx.c TIME=628437507
#include "f2c.h"

integer i_indx(a, b, la, lb)
char *a, *b;
long int la, lb;
{
long int i, n;
char *s, *t, *bend;

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);
}
./ ADD NAME=libF77/i_len.c TIME=628437508
#include "f2c.h"

integer i_len(s, n)
char *s;
long int n;
{
return(n);
}
./ ADD NAME=libF77/i_mod.c TIME=628437508
#include "f2c.h"

integer i_mod(a,b)
integer *a, *b;
{
return( *a % *b);
}
./ ADD NAME=libF77/i_nint.c TIME=628437508
#include "f2c.h"

integer i_nint(x)
real *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/i_sign.c TIME=628437508
#include "f2c.h"

integer i_sign(a,b)
integer *a, *b;
{
integer x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
./ ADD NAME=libF77/iargc_.c TIME=628437508
#include "f2c.h"

integer iargc_()
{
extern int xargc;
return ( xargc - 1 );
}
./ ADD NAME=libF77/l_ge.c TIME=628437508
#include "f2c.h"

extern integer s_cmp();

integer l_ge(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) >= 0);
}
./ ADD NAME=libF77/l_gt.c TIME=628437508
#include "f2c.h"

extern integer s_cmp();

integer l_gt(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) > 0);
}
./ ADD NAME=libF77/l_le.c TIME=628437508
#include "f2c.h"

extern integer s_cmp();

integer l_le(a,b,la,lb)
char *a, *b;
long int la, lb;
{
return(s_cmp(a,b,la,lb) <= 0);
}
./ ADD NAME=libF77/l_lt.c TIME=628437509
#include "f2c.h"

integer l_lt(a,b,la,lb)
char *a, *b;
long la, lb;
{
return(s_cmp(a,b,la,lb) < 0);
}
./ ADD NAME=libF77/main.c TIME=628524317
/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */

#include "stdio.h"
#include "signal.h"

#ifndef SIGIOT
#define SIGIOT SIGABRT
#endif

#ifdef NO__STDC
#define ONEXIT onexit
extern void f_exit();
#else
#ifdef __STDC__
#include "stdlib.h"
extern void f_exit(void);
#ifndef NO_ONEXIT
#define ONEXIT atexit
extern int atexit(void (*)(void));
#endif
#else
#ifndef NO_ONEXIT
#define ONEXIT onexit
extern void f_exit();
#endif
#endif
#endif

static void sigdie(s, kill)
register char *s;
int kill;
{
/* print error message, then clear buffers */
fflush(stderr);
fprintf(stderr, "%s\n", s);
f_exit();
fflush(stderr);

if(kill)
	{
	/* now get a core */
	signal(SIGIOT, 0);
	abort();
	}
else
	exit(1);
}

static void sigfdie(n)
{
sigdie("Floating Exception", 1);
}



static void sigidie(n)
{
sigdie("IOT Trap", 1);
}


static void sigqdie(n)
{
sigdie("Quit signal", 1);
}



static void sigindie(n)
{
sigdie("Interrupt", 0);
}



static void sigtdie(n)
{
sigdie("Killed", 0);
}


int xargc;
char **xargv;

main(argc, argv)
int argc;
char **argv;
{
xargc = argc;
xargv = argv;
signal(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */
signal(SIGIOT, sigidie);
#ifdef SIGQUIT
if( (int)signal(SIGQUIT,sigqdie) & 01) signal(SIGQUIT, SIG_IGN);
#endif
if( (int)signal(SIGINT, sigindie) & 01) signal(SIGINT, SIG_IGN);
signal(SIGTERM,sigtdie);

#ifdef pdp11
	ldfps(01200); /* detect overflow as an exception */
#endif

f_init();
#ifndef NO_ONEXIT
ONEXIT(f_exit);
#endif
MAIN__();
#ifdef NO_ONEXIT
f_exit();
#endif
}
./ ADD NAME=libF77/pow_ci.c TIME=628438069
#include "f2c.h"

VOID pow_ci(p, a, b) 	/* p = a**b  */
complex *p, *a;
integer *b;
{
doublecomplex p1, a1;

a1.r = a->r;
a1.i = a->i;

pow_zi(&p1, &a1, b);

p->r = p1.r;
p->i = p1.i;
}
./ ADD NAME=libF77/pow_dd.c TIME=628437509
#include "f2c.h"

double pow_dd(ap, bp)
doublereal *ap, *bp;
{
double pow();

return(pow(*ap, *bp) );
}
./ ADD NAME=libF77/pow_di.c TIME=628437509
#include "f2c.h"

double pow_di(ap, bp)
doublereal *ap;
integer *bp;
{
double pow, x;
integer n;

pow = 1;
x = *ap;
n = *bp;

if(n != 0)
	{
	if(n < 0)
		{
		if(x == 0)
			{
			return(pow);
			}
		n = -n;
		x = 1/x;
		}
	for( ; ; )
		{
		if(n & 01)
			pow *= x;
		if(n >>= 1)
			x *= x;
		else
			break;
		}
	}
return(pow);
}
./ ADD NAME=libF77/pow_hh.c TIME=628437509
#include "f2c.h"

shortint pow_hh(ap, bp)
shortint *ap, *bp;
{
shortint pow, x, n;

pow = 1;
x = *ap;
n = *bp;

if(n < 0)
	{ }
else if(n > 0)
	for( ; ; )
		{
		if(n & 01)
			pow *= x;
		if(n >>= 1)
			x *= x;
		else
			break;
		}
return(pow);
}
./ ADD NAME=libF77/pow_ii.c TIME=628437509
#include "f2c.h"

integer pow_ii(ap, bp)
integer *ap, *bp;
{
integer pow, x, n;

pow = 1;
x = *ap;
n = *bp;

if(n < 0)
	{ }
else if(n > 0)
	for( ; ; )
		{
		if(n & 01)
			pow *= x;
		if(n >>= 1)
			x *= x;
		else
			break;
		}
return(pow);
}
./ ADD NAME=libF77/pow_ri.c TIME=628437509
#include "f2c.h"

double pow_ri(ap, bp)
real *ap;
integer *bp;
{
double pow, x;
integer n;

pow = 1;
x = *ap;
n = *bp;

if(n != 0)
	{
	if(n < 0)
		{
		if(x == 0)
			{
			return(pow);
			}
		n = -n;
		x = 1/x;
		}
	for( ; ; )
		{
		if(n & 01)
			pow *= x;
		if(n >>= 1)
			x *= x;
		else
			break;
		}
	}
return(pow);
}
./ ADD NAME=libF77/pow_zi.c TIME=628438134
#include "f2c.h"

VOID pow_zi(p, a, b) 	/* p = a**b  */
doublecomplex *p, *a;
integer *b;
{
integer n;
double t;
doublecomplex x;
static doublecomplex one = {1.0, 0.0};

n = *b;
p->r = 1;
p->i = 0;

if(n == 0)
	return;
if(n < 0)
	{
	n = -n;
	z_div(&x, &one, a);
	}
else
	{
	x.r = a->r;
	x.i = a->i;
	}

for( ; ; )
	{
	if(n & 01)
		{
		t = p->r * x.r - p->i * x.i;
		p->i = p->r * x.i + p->i * x.r;
		p->r = t;
		}
	if(n >>= 1)
		{
		t = x.r * x.r - x.i * x.i;
		x.i = 2 * x.r * x.i;
		x.r = t;
		}
	else
		break;
	}
}
./ ADD NAME=libF77/pow_zz.c TIME=628437510
#include "f2c.h"

VOID pow_zz(r,a,b)
doublecomplex *r, *a, *b;
{
double logr, logi, x, y;
double log(), exp(), cos(), sin(), atan2(), cabs();

logr = log( 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;

r->r = x * cos(y);
r->i = x * sin(y);
}
./ ADD NAME=libF77/r_abs.c TIME=628437510
#include "f2c.h"

double r_abs(x)
real *x;
{
if(*x >= 0)
	return(*x);
return(- *x);
}
./ ADD NAME=libF77/r_acos.c TIME=628437510
#include "f2c.h"

double r_acos(x)
real *x;
{
double acos();
return( acos(*x) );
}
./ ADD NAME=libF77/r_asin.c TIME=628437510
#include "f2c.h"

double r_asin(x)
real *x;
{
double asin();
return( asin(*x) );
}
./ ADD NAME=libF77/r_atan.c TIME=628437510
#include "f2c.h"

double r_atan(x)
real *x;
{
double atan();
return( atan(*x) );
}
./ ADD NAME=libF77/r_atn2.c TIME=628437510
#include "f2c.h"

double r_atn2(x,y)
real *x, *y;
{
double atan2();
return( atan2(*x,*y) );
}
./ ADD NAME=libF77/r_cnjg.c TIME=628437511
#include "f2c.h"

VOID r_cnjg(r, z)
complex *r, *z;
{
r->r = z->r;
r->i = - z->i;
}
./ ADD NAME=libF77/r_cos.c TIME=628437511
#include "f2c.h"

double r_cos(x)
real *x;
{
double cos();
return( cos(*x) );
}
./ ADD NAME=libF77/r_cosh.c TIME=628437511
#include "f2c.h"

double r_cosh(x)
real *x;
{
double cosh();
return( cosh(*x) );
}
./ ADD NAME=libF77/r_dim.c TIME=628437511
#include "f2c.h"

double r_dim(a,b)
real *a, *b;
{
return( *a > *b ? *a - *b : 0);
}
./ ADD NAME=libF77/r_exp.c TIME=628437511
#include "f2c.h"

double r_exp(x)
real *x;
{
double exp();
return( exp(*x) );
}
./ ADD NAME=libF77/r_imag.c TIME=628437511
#include "f2c.h"

double r_imag(z)
complex *z;
{
return(z->i);
}
./ ADD NAME=libF77/r_int.c TIME=628437511
#include "f2c.h"

double r_int(x)
real *x;
{
double floor();

return( (*x>0) ? floor(*x) : -floor(- *x) );
}
./ ADD NAME=libF77/r_lg10.c TIME=628437511
#include "f2c.h"

#define log10e 0.43429448190325182765

double r_lg10(x)
real *x;
{
double log();

return( log10e * log(*x) );
}
./ ADD NAME=libF77/r_log.c TIME=628437511
#include "f2c.h"

double r_log(x)
real *x;
{
double log();
return( log(*x) );
}
./ ADD NAME=libF77/r_mod.c TIME=628437512
#include "f2c.h"

double r_mod(x,y)
real *x, *y;
{
double floor(), quotient;
if( (quotient = *x / *y) >= 0)
	quotient = floor(quotient);
else
	quotient = -floor(-quotient);
return(*x - (*y) * quotient );
}
./ ADD NAME=libF77/r_nint.c TIME=628437512
#include "f2c.h"

double r_nint(x)
real *x;
{
double floor();

return( (*x)>=0 ?
	floor(*x + .5) : -floor(.5 - *x) );
}
./ ADD NAME=libF77/r_sign.c TIME=628437512
#include "f2c.h"

double r_sign(a,b)
real *a, *b;
{
double x;
x = (*a >= 0 ? *a : - *a);
return( *b >= 0 ? x : -x);
}
./ ADD NAME=libF77/r_sin.c TIME=628437512
#include "f2c.h"

double r_sin(x)
real *x;
{
double sin();
return( sin(*x) );
}
./ ADD NAME=libF77/r_sinh.c TIME=628437512
#include "f2c.h"

double r_sinh(x)
real *x;
{
double sinh();
return( sinh(*x) );
}
./ ADD NAME=libF77/r_sqrt.c TIME=628437512
#include "f2c.h"

double r_sqrt(x)
real *x;
{
double sqrt();
return( sqrt(*x) );
}
./ ADD NAME=libF77/r_tan.c TIME=628437512
#include "f2c.h"

double r_tan(x)
real *x;
{
double tan();
return( tan(*x) );
}
./ ADD NAME=libF77/r_tanh.c TIME=628437512
#include "f2c.h"

double r_tanh(x)
real *x;
{
double tanh();
return( tanh(*x) );
}
./ ADD NAME=libF77/s_cat.c TIME=628437513
#include "f2c.h"

VOID s_cat(lp, rpp, rnp, np, ll)
char *lp, *rpp[];
#ifdef f2c_i2
short int rnp[], *np, ll;
#else
long int rnp[], *np, ll;
#endif
{
int i, n, nc;
char *rp;

n = *np;
for(i = 0 ; i < n ; ++i)
	{
	nc = ll;
	if(rnp[i] < nc)
		nc = rnp[i];
	ll -= nc;
	rp = rpp[i];
	while(--nc >= 0)
		*lp++ = *rp++;
	}
while(--ll >= 0)
	*lp++ = ' ';
}
./ ADD NAME=libF77/s_cmp.c TIME=628437513
#include "f2c.h"

integer s_cmp(a, b, la, lb)	/* compare two strings */
register char *a, *b;
long int la, lb;
{
register char *aend, *bend;
aend = a + la;
bend = b + lb;

if(la <= lb)
	{
	while(a < aend)
		if(*a != *b)
			return( *a - *b );
		else
			{ ++a; ++b; }

	while(b < bend)
		if(*b != ' ')
			return( ' ' - *b );
		else	++b;
	}

else
	{
	while(b < bend)
		if(*a == *b)
			{ ++a; ++b; }
		else
			return( *a - *b );
	while(a < aend)
		if(*a != ' ')
			return(*a - ' ');
		else	++a;
	}
return(0);
}
./ ADD NAME=libF77/s_copy.c TIME=628437513
#include "f2c.h"

VOID s_copy(a, b, la, lb)	/* assign strings:  a = b */
char *a, *b;
long int la, lb;
{
char *aend, *bend;

aend = a + la;

if(la <= lb)
	while(a < aend)
		*a++ = *b++;

else
	{
	bend = b + lb;
	while(b < bend)
		*a++ = *b++;
	while(a < aend)
		*a++ = ' ';
	}
}
./ ADD NAME=libF77/s_paus.c TIME=628474922
#include "stdio.h"
#include "f2c.h"
#define PAUSESIG 15

static waitpause()
{
return;
}

VOID s_paus(s, n)
char *s;
long int n;
{
int i;

fprintf(stderr, "PAUSE ");
if(n > 0)
	for(i = 0; i<n ; ++i)
		putc(*s++, stderr);
fprintf(stderr, " statement executed\n");
if( isatty(fileno(stdin)) )
	{
	fprintf(stderr, "To resume execution, type go.  Any other input will terminate job.\n");
	fflush(stderr);
	if( getchar()!='g' || getchar()!='o' || getchar()!='\n' )
		{
		fprintf(stderr, "STOP\n");
		f_exit();
		exit(0);
		}
	}
else
	{
	fprintf(stderr, "To resume execution, execute a   kill -%d %d   command\n",
		PAUSESIG, getpid() );
	signal(PAUSESIG, waitpause);
	fflush(stderr);
	pause();
	}
fprintf(stderr, "Execution resumes after PAUSE.\n");
}
./ ADD NAME=libF77/s_rnge.c TIME=626022810
#include <stdio.h>

/* called when a subscript is out of range */

s_rnge(varn, offset, procn, line)
char *varn, *procn;
long int offset;
int line;
{
register int i;

fprintf(stderr, "Subscript out of range on file line %d, procedure ", line);
for(i = 0 ; i < 8 && *procn!='_' ; ++i)
	putc(*procn++, stderr);
fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
for(i = 0 ; i < 8  && *varn!=' ' ; ++i)
	putc(*varn++, stderr);
fprintf(stderr, ".\n");
_cleanup();
abort();
}
./ ADD NAME=libF77/s_stop.c TIME=628474936
#include "stdio.h"
#include "f2c.h"

VOID s_stop(s, n)
char *s;
long int n;
{
int i;

if(n > 0)
	{
	fprintf(stderr, "STOP ");
	for(i = 0; i<n ; ++i)
		putc(*s++, stderr);
	fprintf(stderr, " statement executed\n");
	}
f_exit();
exit(0);
}
./ ADD NAME=libF77/signal_.c TIME=628437513
#include "f2c.h"

typedef int (*sig_type)();
extern sig_type signal();

integer signal_(sigp, procp)
integer *sigp, *procp;
{
	int sig;
	sig_type proc;
	sig = *sigp;
	proc = *(sig_type *)procp;

	return (integer)signal(sig, proc);
	}
./ ADD NAME=libF77/system_.c TIME=628437513
/* f77 interface to system routine */

#include "f2c.h"

system_(s, n)
register char *s;
long int n;
{
char buff[1000];
register char *bp, *blast;

blast = buff + (n < 1000 ? n : 1000);

for(bp = buff ; bp<blast && *s!='\0' ; )
	*bp++ = *s++;
*bp = '\0';
system(buff);
}
./ ADD NAME=libF77/z_abs.c TIME=628438260
#include "f2c.h"

double z_abs(z)
doublecomplex *z;
{
double cabs();

return( cabs( z->r, z->i ) );
}
./ ADD NAME=libF77/z_cos.c TIME=628437514
#include "f2c.h"

VOID z_cos(r, z)
doublecomplex *r, *z;
{
double sin(), cos(), sinh(), cosh();

r->r = cos(z->r) * cosh(z->i);
r->i = - sin(z->r) * sinh(z->i);
}
./ ADD NAME=libF77/z_div.c TIME=628437514
#include "f2c.h"

VOID z_div(c, a, b)
doublecomplex *a, *b, *c;
{
double ratio, den;
double abr, abi;

if( (abr = b->r) < 0.)
	abr = - abr;
if( (abi = b->i) < 0.)
	abi = - abi;
if( abr <= abi )
	{
	if(abi == 0)
		abort(); /* fatal("complex division by zero"); */
	ratio = b->r / b->i ;
	den = b->i * (1 + ratio*ratio);
	c->r = (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);
	c->r = (a->r + a->i*ratio) / den;
	c->i = (a->i - a->r*ratio) / den;
	}

}
./ ADD NAME=libF77/z_exp.c TIME=628437514
#include "f2c.h"

VOID z_exp(r, z)
doublecomplex *r, *z;
{
double expx;
double exp(), cos(), sin();

expx = exp(z->r);
r->r = expx * cos(z->i);
r->i = expx * sin(z->i);
}
./ ADD NAME=libF77/z_log.c TIME=628437514
#include "f2c.h"

VOID z_log(r, z)
doublecomplex *r, *z;
{
double log(), cabs(), atan2();

r->i = atan2(z->i, z->r);
r->r = log( cabs( z->r, z->i ) );
}
./ ADD NAME=libF77/z_sin.c TIME=628437514
#include "f2c.h"

VOID z_sin(r, z)
doublecomplex *r, *z;
{
double sin(), cos(), sinh(), cosh();

r->r = sin(z->r) * cosh(z->i);
r->i = cos(z->r) * sinh(z->i);
}
./ ADD NAME=libF77/z_sqrt.c TIME=628437514
#include "f2c.h"

VOID z_sqrt(r, z)
doublecomplex *r, *z;
{
double mag, sqrt(), cabs();

if( (mag = cabs(z->r, z->i)) == 0.)
	r->r = r->i = 0.;
else if(z->r > 0)
	{
	r->r = sqrt(0.5 * (mag + z->r) );
	r->i = z->i / r->r / 2;
	}
else
	{
	r->i = sqrt(0.5 * (mag - z->r) );
	if(z->i < 0)
		z->i = - z->i;
	r->r = z->i / r->i / 2;
	}
}
./ ENDUP

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.