diff options
| author | L Jonas Olsson <ljo@FreeBSD.org> | 1994-10-26 18:17:41 +0000 | 
|---|---|---|
| committer | L Jonas Olsson <ljo@FreeBSD.org> | 1994-10-26 18:17:41 +0000 | 
| commit | 09c656ca68c8876f0dddec7eda2626d8dc897f2e (patch) | |
| tree | acab27bd987cb8ba603a6389fb43d9b4df06310b /lib/libF77 | |
| parent | 876f9d834708020dda68772a4812b6143bbbc16e (diff) | |
Notes
Diffstat (limited to 'lib/libF77')
120 files changed, 2749 insertions, 0 deletions
| diff --git a/lib/libF77/Notice b/lib/libF77/Notice new file mode 100644 index 000000000000..64af9f12dc4e --- /dev/null +++ b/lib/libF77/Notice @@ -0,0 +1,23 @@ +/**************************************************************** +Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. + +Permission to use, copy, modify, and distribute this software +and its documentation for any purpose and without fee is hereby +granted, provided that the above copyright notice appear in all +copies and that both that the copyright notice and this +permission notice and warranty disclaimer appear in supporting +documentation, and that the names of AT&T Bell Laboratories or +Bellcore or any of their entities not be used in advertising or +publicity pertaining to distribution of the software without +specific, written prior permission. + +AT&T and Bellcore disclaim all warranties with regard to this +software, including all implied warranties of merchantability +and fitness.  In no event shall AT&T or Bellcore be liable for +any special, indirect or consequential damages or any damages +whatsoever resulting from loss of use, data or profits, whether +in an action of contract, negligence or other tortious action, +arising out of or in connection with the use or performance of +this software. +****************************************************************/ + diff --git a/lib/libF77/README b/lib/libF77/README new file mode 100644 index 000000000000..b5b0b811036c --- /dev/null +++ b/lib/libF77/README @@ -0,0 +1,94 @@ +If your compiler does not recognize ANSI C headers, +compile with KR_headers defined:  either add -DKR_headers +to the definition of CFLAGS in the makefile, or insert + +#define KR_headers + +at the top of f2c.h , cabs.c , main.c , and sig_die.c . + +Under MS-DOS, compile s_paus.c with -DMSDOS. + +If you have a really ancient K&R C compiler that does not understand +void, add -Dvoid=int to the definition of CFLAGS in the makefile. + +If you use a C++ compiler, first create a local f2c.h by appending +f2ch.add to the usual f2c.h, e.g., by issuing the command +	make f2c.h +which assumes f2c.h is installed in /usr/include . + +If your system lacks onexit() and you are not using an ANSI C +compiler, then you should compile main.c, s_paus.c, s_stop.c, and +sig_die.c with NO_ONEXIT defined.  See the comments about onexit in +the makefile. + +If your system has a double drem() function such that drem(a,b) +is the IEEE remainder function (with double a, b), then you may +wish to compile r_mod.c and d_mod.c with IEEE_drem defined. +On some systems, you may also need to compile with -Ddrem=remainder . + +To check for transmission errors, issue the command +	make check +This assumes you have the xsum program whose source, xsum.c, +is distributed as part of "all from f2c/src".  If you do not +have xsum, you can obtain xsum.c by sending the following E-mail +message to netlib@research.att.com +	send xsum.c from f2c/src + +The makefile assumes you have installed f2c.h in a standard +place (and does not cause recompilation when f2c.h is changed); +f2c.h comes with "all from f2c" (the source for f2c) and is +available separately ("f2c.h from f2c"). + +Most of the routines in libF77 are support routines for Fortran +intrinsic functions or for operations that f2c chooses not +to do "in line".  There are a few exceptions, summarized below -- +functions and subroutines that appear to your program as ordinary +external Fortran routines. + +1.	CALL ABORT prints a message and causes a core dump. + +2.	ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION +	error functions (with x REAL and d DOUBLE PRECISION); +	DERF must be declared DOUBLE PRECISION in your program. +	Both ERF and DERF assume your C library provides the +	underlying erf() function (which not all systems do). + +3.	ERFC(r) and DERFC(d) are the complementary error functions: +	ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d) +	(except that their results may be more accurate than +	explicitly evaluating the above formulae would give). +	Again, ERFC and r are REAL, and DERFC and d are DOUBLE +	PRECISION (and must be declared as such in your program), +	and ERFC and DERFC rely on your system's erfc(). + +4.	CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER +	variable, sets s to the n-th command-line argument (or to +	all blanks if there are fewer than n command-line arguments); +	CALL GETARG(0,s) sets s to the name of the program (on systems +	that support this feature).  See IARGC below. + +5.	CALL GETENV(name, value), where name and value are of type +	CHARACTER, sets value to the environment value, $name, of +	name (or to blanks if $name has not been set). + +6.	NARGS = IARGC() sets NARGS to the number of command-line +	arguments (an INTEGER value). + +7.	CALL SIGNAL(n,func), where n is an INTEGER and func is an +	EXTERNAL procedure, arranges for func to be invoked when +	signal n occurs (on systems where this makes sense). + +8.	CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes +	cmd to the system's command processor (on systems where +	this can be done). + +The makefile does not attempt to compile pow_qq.c, which is meant +for use with INTEGER*8.  To use it, you must modify f2c.h to +declare longint appropriately; then add pow_qq.o to the POW = +line in the makefile. + +If you wish to allow the target of a (character string) concatenation +to be appear on its right-hand (at the cost of extra overhead for +all run-time concatenations), change "s_cat.o" to "s_catow.o" in +the makefile.  Note that the Fortran 77 Standard explicitly forbids +the target of a concatenation from appearing on its right-hand side. diff --git a/lib/libF77/Version.c b/lib/libF77/Version.c new file mode 100644 index 000000000000..bbc611008778 --- /dev/null +++ b/lib/libF77/Version.c @@ -0,0 +1,30 @@ +static char junk[] = "\n@(#)LIBF77 VERSION 2.01 19 Sept. 1994\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 f2c.h +	12 Dec. 1989: s_rnge allows long names +	19 Dec. 1989: getenv_ allows unsorted environment +	28 Mar. 1990: add exit(0) to end of main() +	 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main +	17 Oct. 1990: abort() calls changed to sig_die(...,1) +	22 Oct. 1990: separate sig_die from main +	25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die +	31 May  1991: make system_ return status +	18 Dec. 1991: change long to ftnlen (for -i2) many places +	28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer) +	18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c +			and m**n in pow_hh.c and pow_ii.c; +			catch SIGTRAP in main() for error msg before abort +	23 July 1992: switch to ANSI prototypes unless KR_headers is #defined +	23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg); +			change Cabs to f__cabs. +	12 March 1993: various tweaks for C++ +	 2 June 1994: adjust so abnormal terminations invoke f_exit just once +	16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons. +	19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS +*/ diff --git a/lib/libF77/abort_.c b/lib/libF77/abort_.c new file mode 100644 index 000000000000..9d4a0568ec74 --- /dev/null +++ b/lib/libF77/abort_.c @@ -0,0 +1,18 @@ +#include "stdio.h" +#include "f2c.h" + +#ifdef KR_headers +extern VOID sig_die(); + +int abort_() +#else +extern void sig_die(char*,int); + +int abort_(void) +#endif +{ +sig_die("Fortran abort routine called", 1); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/lib/libF77/c_abs.c b/lib/libF77/c_abs.c new file mode 100644 index 000000000000..041fbd3d8bb0 --- /dev/null +++ b/lib/libF77/c_abs.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double f__cabs(); + +double c_abs(z) complex *z; +#else +extern double f__cabs(double, double); + +double c_abs(complex *z) +#endif +{ +return( f__cabs( z->r, z->i ) ); +} diff --git a/lib/libF77/c_cos.c b/lib/libF77/c_cos.c new file mode 100644 index 000000000000..d5fadd43b18e --- /dev/null +++ b/lib/libF77/c_cos.c @@ -0,0 +1,16 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sin(), cos(), sinh(), cosh(); + +VOID c_cos(r, z) complex *r, *z; +#else +#undef abs +#include "math.h" + +void c_cos(complex *r, complex *z) +#endif +{ +r->r = cos(z->r) * cosh(z->i); +r->i = - sin(z->r) * sinh(z->i); +} diff --git a/lib/libF77/c_div.c b/lib/libF77/c_div.c new file mode 100644 index 000000000000..0bb56b485e1e --- /dev/null +++ b/lib/libF77/c_div.c @@ -0,0 +1,36 @@ +#include "f2c.h" + +#ifdef KR_headers +extern VOID sig_die(); +VOID c_div(c, a, b) +complex *a, *b, *c; +#else +extern void sig_die(char*,int); +void c_div(complex *c, complex *a, complex *b) +#endif +{ +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) +		sig_die("complex division by zero", 1); +	ratio = (double)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 = (double)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; +	} +} diff --git a/lib/libF77/c_exp.c b/lib/libF77/c_exp.c new file mode 100644 index 000000000000..8252c7f7012b --- /dev/null +++ b/lib/libF77/c_exp.c @@ -0,0 +1,19 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double exp(), cos(), sin(); + + VOID c_exp(r, z) complex *r, *z; +#else +#undef abs +#include "math.h" + +void c_exp(complex *r, complex *z) +#endif +{ +double expx; + +expx = exp(z->r); +r->r = expx * cos(z->i); +r->i = expx * sin(z->i); +} diff --git a/lib/libF77/c_log.c b/lib/libF77/c_log.c new file mode 100644 index 000000000000..a77521aee548 --- /dev/null +++ b/lib/libF77/c_log.c @@ -0,0 +1,16 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double log(), f__cabs(), atan2(); +VOID c_log(r, z) complex *r, *z; +#else +#undef abs +#include "math.h" +extern double f__cabs(double, double); + +void c_log(complex *r, complex *z) +#endif +{ +r->i = atan2(z->i, z->r); +r->r = log( f__cabs(z->r, z->i) ); +} diff --git a/lib/libF77/c_sin.c b/lib/libF77/c_sin.c new file mode 100644 index 000000000000..ffdef1d171fc --- /dev/null +++ b/lib/libF77/c_sin.c @@ -0,0 +1,16 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sin(), cos(), sinh(), cosh(); + +VOID c_sin(r, z) complex *r, *z; +#else +#undef abs +#include "math.h" + +void c_sin(complex *r, complex *z) +#endif +{ +r->r = sin(z->r) * cosh(z->i); +r->i = cos(z->r) * sinh(z->i); +} diff --git a/lib/libF77/c_sqrt.c b/lib/libF77/c_sqrt.c new file mode 100644 index 000000000000..3b7342f4a49f --- /dev/null +++ b/lib/libF77/c_sqrt.c @@ -0,0 +1,34 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sqrt(), f__cabs(); + +VOID c_sqrt(r, z) complex *r, *z; +#else +#undef abs +#include "math.h" +extern double f__cabs(double, double); + +void c_sqrt(complex *r, complex *z) +#endif +{ +double mag, t; + +if( (mag = f__cabs(z->r, z->i)) == 0.) +	r->r = r->i = 0.; +else if(z->r > 0) +	{ +	r->r = t = sqrt(0.5 * (mag + z->r) ); +	t = z->i / t; +	r->i = 0.5 * t; +	} +else +	{ +	t = sqrt(0.5 * (mag - z->r) ); +	if(z->i < 0) +		t = -t; +	r->i = t; +	t = z->i / t; +	r->r = 0.5 * t; +	} +} diff --git a/lib/libF77/cabs.c b/lib/libF77/cabs.c new file mode 100644 index 000000000000..09e90af86391 --- /dev/null +++ b/lib/libF77/cabs.c @@ -0,0 +1,27 @@ +#ifdef KR_headers +extern double sqrt(); +double f__cabs(real, imag) double real, imag; +#else +#undef abs +#include "math.h" +double f__cabs(double real, double imag) +#endif +{ +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); + +temp = imag/real; +temp = real*sqrt(1.0 + temp*temp);  /*overflow!!*/ +return(temp); +} diff --git a/lib/libF77/d_abs.c b/lib/libF77/d_abs.c new file mode 100644 index 000000000000..cb157e067b73 --- /dev/null +++ b/lib/libF77/d_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_abs(x) doublereal *x; +#else +double d_abs(doublereal *x) +#endif +{ +if(*x >= 0) +	return(*x); +return(- *x); +} diff --git a/lib/libF77/d_acos.c b/lib/libF77/d_acos.c new file mode 100644 index 000000000000..ecb56e87f540 --- /dev/null +++ b/lib/libF77/d_acos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double acos(); +double d_acos(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_acos(doublereal *x) +#endif +{ +return( acos(*x) ); +} diff --git a/lib/libF77/d_asin.c b/lib/libF77/d_asin.c new file mode 100644 index 000000000000..045e73301c81 --- /dev/null +++ b/lib/libF77/d_asin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double asin(); +double d_asin(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_asin(doublereal *x) +#endif +{ +return( asin(*x) ); +} diff --git a/lib/libF77/d_atan.c b/lib/libF77/d_atan.c new file mode 100644 index 000000000000..03530a1857c3 --- /dev/null +++ b/lib/libF77/d_atan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan(); +double d_atan(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_atan(doublereal *x) +#endif +{ +return( atan(*x) ); +} diff --git a/lib/libF77/d_atn2.c b/lib/libF77/d_atn2.c new file mode 100644 index 000000000000..7c25ac046081 --- /dev/null +++ b/lib/libF77/d_atn2.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan2(); +double d_atn2(x,y) doublereal *x, *y; +#else +#undef abs +#include "math.h" +double d_atn2(doublereal *x, doublereal *y) +#endif +{ +return( atan2(*x,*y) ); +} diff --git a/lib/libF77/d_cnjg.c b/lib/libF77/d_cnjg.c new file mode 100644 index 000000000000..c778c38758cb --- /dev/null +++ b/lib/libF77/d_cnjg.c @@ -0,0 +1,12 @@ +#include "f2c.h" + + VOID +#ifdef KR_headers +d_cnjg(r, z) doublecomplex *r, *z; +#else +d_cnjg(doublecomplex *r, doublecomplex *z) +#endif +{ +r->r = z->r; +r->i = - z->i; +} diff --git a/lib/libF77/d_cos.c b/lib/libF77/d_cos.c new file mode 100644 index 000000000000..45c4838baee7 --- /dev/null +++ b/lib/libF77/d_cos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cos(); +double d_cos(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_cos(doublereal *x) +#endif +{ +return( cos(*x) ); +} diff --git a/lib/libF77/d_cosh.c b/lib/libF77/d_cosh.c new file mode 100644 index 000000000000..1181833cc1fa --- /dev/null +++ b/lib/libF77/d_cosh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cosh(); +double d_cosh(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_cosh(doublereal *x) +#endif +{ +return( cosh(*x) ); +} diff --git a/lib/libF77/d_dim.c b/lib/libF77/d_dim.c new file mode 100644 index 000000000000..1d0ecb7bbb64 --- /dev/null +++ b/lib/libF77/d_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_dim(a,b) doublereal *a, *b; +#else +double d_dim(doublereal *a, doublereal *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/lib/libF77/d_exp.c b/lib/libF77/d_exp.c new file mode 100644 index 000000000000..3f2b6ffcc45e --- /dev/null +++ b/lib/libF77/d_exp.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(); +double d_exp(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_exp(doublereal *x) +#endif +{ +return( exp(*x) ); +} diff --git a/lib/libF77/d_imag.c b/lib/libF77/d_imag.c new file mode 100644 index 000000000000..793a3f9c4059 --- /dev/null +++ b/lib/libF77/d_imag.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_imag(z) doublecomplex *z; +#else +double d_imag(doublecomplex *z) +#endif +{ +return(z->i); +} diff --git a/lib/libF77/d_int.c b/lib/libF77/d_int.c new file mode 100644 index 000000000000..6c0e64215d8d --- /dev/null +++ b/lib/libF77/d_int.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double d_int(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_int(doublereal *x) +#endif +{ +return( (*x>0) ? floor(*x) : -floor(- *x) ); +} diff --git a/lib/libF77/d_lg10.c b/lib/libF77/d_lg10.c new file mode 100644 index 000000000000..f03ff0043f86 --- /dev/null +++ b/lib/libF77/d_lg10.c @@ -0,0 +1,15 @@ +#include "f2c.h" + +#define log10e 0.43429448190325182765 + +#ifdef KR_headers +double log(); +double d_lg10(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_lg10(doublereal *x) +#endif +{ +return( log10e * log(*x) ); +} diff --git a/lib/libF77/d_log.c b/lib/libF77/d_log.c new file mode 100644 index 000000000000..d7a1941d56a5 --- /dev/null +++ b/lib/libF77/d_log.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(); +double d_log(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_log(doublereal *x) +#endif +{ +return( log(*x) ); +} diff --git a/lib/libF77/d_mod.c b/lib/libF77/d_mod.c new file mode 100644 index 000000000000..0d3ffbff9eb5 --- /dev/null +++ b/lib/libF77/d_mod.c @@ -0,0 +1,40 @@ +#include "f2c.h" + +#ifdef KR_headers +#ifdef IEEE_drem +double drem(); +#else +double floor(); +#endif +double d_mod(x,y) doublereal *x, *y; +#else +#ifdef IEEE_drem +double drem(double, double); +#else +#undef abs +#include "math.h" +#endif +double d_mod(doublereal *x, doublereal *y) +#endif +{ +#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; +#else +	double quotient; +	if( (quotient = *x / *y) >= 0) +		quotient = floor(quotient); +	else +		quotient = -floor(-quotient); +	return(*x - (*y) * quotient ); +#endif +} diff --git a/lib/libF77/d_nint.c b/lib/libF77/d_nint.c new file mode 100644 index 000000000000..2ead3df200ae --- /dev/null +++ b/lib/libF77/d_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double d_nint(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_nint(doublereal *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/d_prod.c b/lib/libF77/d_prod.c new file mode 100644 index 000000000000..3d4cef7835c2 --- /dev/null +++ b/lib/libF77/d_prod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_prod(x,y) real *x, *y; +#else +double d_prod(real *x, real *y) +#endif +{ +return( (*x) * (*y) ); +} diff --git a/lib/libF77/d_sign.c b/lib/libF77/d_sign.c new file mode 100644 index 000000000000..514ff0bbff82 --- /dev/null +++ b/lib/libF77/d_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_sign(a,b) doublereal *a, *b; +#else +double d_sign(doublereal *a, doublereal *b) +#endif +{ +double x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/lib/libF77/d_sin.c b/lib/libF77/d_sin.c new file mode 100644 index 000000000000..0013af03496f --- /dev/null +++ b/lib/libF77/d_sin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(); +double d_sin(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_sin(doublereal *x) +#endif +{ +return( sin(*x) ); +} diff --git a/lib/libF77/d_sinh.c b/lib/libF77/d_sinh.c new file mode 100644 index 000000000000..1ccd02ead97e --- /dev/null +++ b/lib/libF77/d_sinh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sinh(); +double d_sinh(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_sinh(doublereal *x) +#endif +{ +return( sinh(*x) ); +} diff --git a/lib/libF77/d_sqrt.c b/lib/libF77/d_sqrt.c new file mode 100644 index 000000000000..bee10a3a551f --- /dev/null +++ b/lib/libF77/d_sqrt.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(); +double d_sqrt(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_sqrt(doublereal *x) +#endif +{ +return( sqrt(*x) ); +} diff --git a/lib/libF77/d_tan.c b/lib/libF77/d_tan.c new file mode 100644 index 000000000000..23fa423188e3 --- /dev/null +++ b/lib/libF77/d_tan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tan(); +double d_tan(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_tan(doublereal *x) +#endif +{ +return( tan(*x) ); +} diff --git a/lib/libF77/d_tanh.c b/lib/libF77/d_tanh.c new file mode 100644 index 000000000000..0363a49b1be3 --- /dev/null +++ b/lib/libF77/d_tanh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tanh(); +double d_tanh(x) doublereal *x; +#else +#undef abs +#include "math.h" +double d_tanh(doublereal *x) +#endif +{ +return( tanh(*x) ); +} diff --git a/lib/libF77/derf_.c b/lib/libF77/derf_.c new file mode 100644 index 000000000000..6afaccdaa3ed --- /dev/null +++ b/lib/libF77/derf_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erf(); +double derf_(x) doublereal *x; +#else +extern double erf(double); +double derf_(doublereal *x) +#endif +{ +return( erf(*x) ); +} diff --git a/lib/libF77/derfc_.c b/lib/libF77/derfc_.c new file mode 100644 index 000000000000..e199f916058e --- /dev/null +++ b/lib/libF77/derfc_.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double erfc(); + +double derfc_(x) doublereal *x; +#else +extern double erfc(double); + +double derfc_(doublereal *x) +#endif +{ +return( erfc(*x) ); +} diff --git a/lib/libF77/ef1asc_.c b/lib/libF77/ef1asc_.c new file mode 100644 index 000000000000..b2b8d72a7811 --- /dev/null +++ b/lib/libF77/ef1asc_.c @@ -0,0 +1,21 @@ +/* EFL support routine to copy string b to string a */ + +#include "f2c.h" + + +#define M	( (long) (sizeof(long) - 1) ) +#define EVEN(x)	( ( (x)+ M) & (~M) ) + +#ifdef KR_headers +extern VOID s_copy(); +ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; +#else +extern void s_copy(char*,char*,ftnlen,ftnlen); +int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +#endif +{ +s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/lib/libF77/ef1cmc_.c b/lib/libF77/ef1cmc_.c new file mode 100644 index 000000000000..8239a6ba2e1f --- /dev/null +++ b/lib/libF77/ef1cmc_.c @@ -0,0 +1,14 @@ +/* EFL support routine to compare two character strings */ + +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; +#else +extern integer s_cmp(char*,char*,ftnlen,ftnlen); +integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +#endif +{ +return( s_cmp( (char *)a, (char *)b, *la, *lb) ); +} diff --git a/lib/libF77/erf_.c b/lib/libF77/erf_.c new file mode 100644 index 000000000000..f7565ae6ae39 --- /dev/null +++ b/lib/libF77/erf_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erf(); +double erf_(x) real *x; +#else +extern double erf(double); +double erf_(real *x) +#endif +{ +return( erf(*x) ); +} diff --git a/lib/libF77/erfc_.c b/lib/libF77/erfc_.c new file mode 100644 index 000000000000..56adb2f910b7 --- /dev/null +++ b/lib/libF77/erfc_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erfc(); +double erfc_(x) real *x; +#else +extern double erfc(double); +double erfc_(real *x) +#endif +{ +return( erfc(*x) ); +} diff --git a/lib/libF77/f2ch.add b/lib/libF77/f2ch.add new file mode 100644 index 000000000000..4ab0d8078c65 --- /dev/null +++ b/lib/libF77/f2ch.add @@ -0,0 +1,162 @@ +/* If you are using a C++ compiler, append the following to f2c.h +   for compiling libF77 and libI77. */ + +#ifdef __cplusplus +extern "C" { +extern int abort_(void); +extern double c_abs(complex *); +extern void c_cos(complex *, complex *); +extern void c_div(complex *, complex *, complex *); +extern void c_exp(complex *, complex *); +extern void c_log(complex *, complex *); +extern void c_sin(complex *, complex *); +extern void c_sqrt(complex *, complex *); +extern double d_abs(double *); +extern double d_acos(double *); +extern double d_asin(double *); +extern double d_atan(double *); +extern double d_atn2(double *, double *); +extern void d_cnjg(doublecomplex *, doublecomplex *); +extern double d_cos(double *); +extern double d_cosh(double *); +extern double d_dim(double *, double *); +extern double d_exp(double *); +extern double d_imag(doublecomplex *); +extern double d_int(double *); +extern double d_lg10(double *); +extern double d_log(double *); +extern double d_mod(double *, double *); +extern double d_nint(double *); +extern double d_prod(float *, float *); +extern double d_sign(double *, double *); +extern double d_sin(double *); +extern double d_sinh(double *); +extern double d_sqrt(double *); +extern double d_tan(double *); +extern double d_tanh(double *); +extern double derf_(double *); +extern double derfc_(double *); +extern integer do_fio(ftnint *, char *, ftnlen); +extern integer do_lio(ftnint *, ftnint *, char *, ftnlen); +extern integer do_uio(ftnint *, char *, ftnlen); +extern integer e_rdfe(void); +extern integer e_rdue(void); +extern integer e_rsfe(void); +extern integer e_rsfi(void); +extern integer e_rsle(void); +extern integer e_rsli(void); +extern integer e_rsue(void); +extern integer e_wdfe(void); +extern integer e_wdue(void); +extern integer e_wsfe(void); +extern integer e_wsfi(void); +extern integer e_wsle(void); +extern integer e_wsli(void); +extern integer e_wsue(void); +extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern double erf(double); +extern double erf_(float *); +extern double erfc(double); +extern double erfc_(float *); +extern integer f_back(alist *); +extern integer f_clos(cllist *); +extern integer f_end(alist *); +extern void f_exit(void); +extern integer f_inqu(inlist *); +extern integer f_open(olist *); +extern integer f_rew(alist *); +extern int flush_(void); +extern void getarg_(integer *, char *, ftnlen); +extern void getenv_(char *, char *, ftnlen, ftnlen); +extern short h_abs(short *); +extern short h_dim(short *, short *); +extern short h_dnnt(double *); +extern short h_indx(char *, char *, ftnlen, ftnlen); +extern short h_len(char *, ftnlen); +extern short h_mod(short *, short *); +extern short h_nint(float *); +extern short h_sign(short *, short *); +extern short hl_ge(char *, char *, ftnlen, ftnlen); +extern short hl_gt(char *, char *, ftnlen, ftnlen); +extern short hl_le(char *, char *, ftnlen, ftnlen); +extern short hl_lt(char *, char *, ftnlen, ftnlen); +extern integer i_abs(integer *); +extern integer i_dim(integer *, integer *); +extern integer i_dnnt(double *); +extern integer i_indx(char *, char *, ftnlen, ftnlen); +extern integer i_len(char *, ftnlen); +extern integer i_mod(integer *, integer *); +extern integer i_nint(float *); +extern integer i_sign(integer *, integer *); +extern integer iargc_(void); +extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); +extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); +extern ftnlen l_le(char *, char *, ftnlen, ftnlen); +extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); +extern void pow_ci(complex *, complex *, integer *); +extern double pow_dd(double *, double *); +extern double pow_di(double *, integer *); +extern short pow_hh(short *, shortint *); +extern integer pow_ii(integer *, integer *); +extern double pow_ri(float *, integer *); +extern void pow_zi(doublecomplex *, doublecomplex *, integer *); +extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *); +extern double r_abs(float *); +extern double r_acos(float *); +extern double r_asin(float *); +extern double r_atan(float *); +extern double r_atn2(float *, float *); +extern void r_cnjg(complex *, complex *); +extern double r_cos(float *); +extern double r_cosh(float *); +extern double r_dim(float *, float *); +extern double r_exp(float *); +extern double r_imag(complex *); +extern double r_int(float *); +extern double r_lg10(float *); +extern double r_log(float *); +extern double r_mod(float *, float *); +extern double r_nint(float *); +extern double r_sign(float *, float *); +extern double r_sin(float *); +extern double r_sinh(float *); +extern double r_sqrt(float *); +extern double r_tan(float *); +extern double r_tanh(float *); +extern void s_cat(char *, char **, integer *, integer *, ftnlen); +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +extern void s_copy(char *, char *, ftnlen, ftnlen); +extern int s_paus(char *, ftnlen); +extern integer s_rdfe(cilist *); +extern integer s_rdue(cilist *); +extern integer s_rnge(char *, integer, char *, integer); +extern integer s_rsfe(cilist *); +extern integer s_rsfi(icilist *); +extern integer s_rsle(cilist *); +extern integer s_rsli(icilist *); +extern integer s_rsne(cilist *); +extern integer s_rsni(icilist *); +extern integer s_rsue(cilist *); +extern int s_stop(char *, ftnlen); +extern integer s_wdfe(cilist *); +extern integer s_wdue(cilist *); +extern integer s_wsfe(cilist *); +extern integer s_wsfi(icilist *); +extern integer s_wsle(cilist *); +extern integer s_wsli(icilist *); +extern integer s_wsne(cilist *); +extern integer s_wsni(icilist *); +extern integer s_wsue(cilist *); +extern void sig_die(char *, int); +extern integer signal_(integer *, void (*)(int)); +extern int system_(char *, ftnlen); +extern double z_abs(doublecomplex *); +extern void z_cos(doublecomplex *, doublecomplex *); +extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); +extern void z_exp(doublecomplex *, doublecomplex *); +extern void z_log(doublecomplex *, doublecomplex *); +extern void z_sin(doublecomplex *, doublecomplex *); +extern void z_sqrt(doublecomplex *, doublecomplex *); +	} +#endif diff --git a/lib/libF77/getarg_.c b/lib/libF77/getarg_.c new file mode 100644 index 000000000000..fef0da7b1d5f --- /dev/null +++ b/lib/libF77/getarg_.c @@ -0,0 +1,28 @@ +#include "f2c.h" + +/* + * subroutine getarg(k, c) + * returns the kth unix command argument in fortran character + * variable argument c +*/ + +#ifdef KR_headers +VOID getarg_(n, s, ls) ftnint *n; register char *s; ftnlen ls; +#else +void getarg_(ftnint *n, register char *s, ftnlen ls) +#endif +{ +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++ = ' '; +} diff --git a/lib/libF77/getenv_.c b/lib/libF77/getenv_.c new file mode 100644 index 000000000000..2a035ea9a6bb --- /dev/null +++ b/lib/libF77/getenv_.c @@ -0,0 +1,51 @@ +#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 + */ + +#ifdef KR_headers +VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; +#else +void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) +#endif +{ +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++ = ' '; +} diff --git a/lib/libF77/h_abs.c b/lib/libF77/h_abs.c new file mode 100644 index 000000000000..73b82151ac1d --- /dev/null +++ b/lib/libF77/h_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_abs(x) shortint *x; +#else +shortint h_abs(shortint *x) +#endif +{ +if(*x >= 0) +	return(*x); +return(- *x); +} diff --git a/lib/libF77/h_dim.c b/lib/libF77/h_dim.c new file mode 100644 index 000000000000..ceff660e26cd --- /dev/null +++ b/lib/libF77/h_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_dim(a,b) shortint *a, *b; +#else +shortint h_dim(shortint *a, shortint *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/lib/libF77/h_dnnt.c b/lib/libF77/h_dnnt.c new file mode 100644 index 000000000000..9fbeb5ce6244 --- /dev/null +++ b/lib/libF77/h_dnnt.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +shortint h_dnnt(x) doublereal *x; +#else +#undef abs +#include "math.h" +shortint h_dnnt(doublereal *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/h_indx.c b/lib/libF77/h_indx.c new file mode 100644 index 000000000000..a211cc7fa0fb --- /dev/null +++ b/lib/libF77/h_indx.c @@ -0,0 +1,26 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; +#else +shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +ftnlen 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((shortint)i+1); +	no: ; +	} +return(0); +} diff --git a/lib/libF77/h_len.c b/lib/libF77/h_len.c new file mode 100644 index 000000000000..00a2151bfa11 --- /dev/null +++ b/lib/libF77/h_len.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_len(s, n) char *s; ftnlen n; +#else +shortint h_len(char *s, ftnlen n) +#endif +{ +return(n); +} diff --git a/lib/libF77/h_mod.c b/lib/libF77/h_mod.c new file mode 100644 index 000000000000..43431c1c503c --- /dev/null +++ b/lib/libF77/h_mod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_mod(a,b) short *a, *b; +#else +shortint h_mod(short *a, short *b) +#endif +{ +return( *a % *b); +} diff --git a/lib/libF77/h_nint.c b/lib/libF77/h_nint.c new file mode 100644 index 000000000000..bf63df128d89 --- /dev/null +++ b/lib/libF77/h_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +shortint h_nint(x) real *x; +#else +#undef abs +#include "math.h" +shortint h_nint(real *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/h_sign.c b/lib/libF77/h_sign.c new file mode 100644 index 000000000000..7b06c157a74e --- /dev/null +++ b/lib/libF77/h_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_sign(a,b) shortint *a, *b; +#else +shortint h_sign(shortint *a, shortint *b) +#endif +{ +shortint x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/lib/libF77/hl_ge.c b/lib/libF77/hl_ge.c new file mode 100644 index 000000000000..4c29527065a2 --- /dev/null +++ b/lib/libF77/hl_ge.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) >= 0); +} diff --git a/lib/libF77/hl_gt.c b/lib/libF77/hl_gt.c new file mode 100644 index 000000000000..c4f345a0859e --- /dev/null +++ b/lib/libF77/hl_gt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) > 0); +} diff --git a/lib/libF77/hl_le.c b/lib/libF77/hl_le.c new file mode 100644 index 000000000000..a9cce596c715 --- /dev/null +++ b/lib/libF77/hl_le.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) <= 0); +} diff --git a/lib/libF77/hl_lt.c b/lib/libF77/hl_lt.c new file mode 100644 index 000000000000..162d919c3b48 --- /dev/null +++ b/lib/libF77/hl_lt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) < 0); +} diff --git a/lib/libF77/i_abs.c b/lib/libF77/i_abs.c new file mode 100644 index 000000000000..be21295aaa12 --- /dev/null +++ b/lib/libF77/i_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_abs(x) integer *x; +#else +integer i_abs(integer *x) +#endif +{ +if(*x >= 0) +	return(*x); +return(- *x); +} diff --git a/lib/libF77/i_dim.c b/lib/libF77/i_dim.c new file mode 100644 index 000000000000..6e1b1707b555 --- /dev/null +++ b/lib/libF77/i_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_dim(a,b) integer *a, *b; +#else +integer i_dim(integer *a, integer *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/lib/libF77/i_dnnt.c b/lib/libF77/i_dnnt.c new file mode 100644 index 000000000000..9d46c4b6ad9d --- /dev/null +++ b/lib/libF77/i_dnnt.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +integer i_dnnt(x) doublereal *x; +#else +#undef abs +#include "math.h" +integer i_dnnt(doublereal *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/i_indx.c b/lib/libF77/i_indx.c new file mode 100644 index 000000000000..96e7bc51ba85 --- /dev/null +++ b/lib/libF77/i_indx.c @@ -0,0 +1,26 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; +#else +integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +ftnlen 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); +} diff --git a/lib/libF77/i_len.c b/lib/libF77/i_len.c new file mode 100644 index 000000000000..4020fee46183 --- /dev/null +++ b/lib/libF77/i_len.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_len(s, n) char *s; ftnlen n; +#else +integer i_len(char *s, ftnlen n) +#endif +{ +return(n); +} diff --git a/lib/libF77/i_mod.c b/lib/libF77/i_mod.c new file mode 100644 index 000000000000..6937c4213570 --- /dev/null +++ b/lib/libF77/i_mod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_mod(a,b) integer *a, *b; +#else +integer i_mod(integer *a, integer *b) +#endif +{ +return( *a % *b); +} diff --git a/lib/libF77/i_nint.c b/lib/libF77/i_nint.c new file mode 100644 index 000000000000..ccde78548880 --- /dev/null +++ b/lib/libF77/i_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +integer i_nint(x) real *x; +#else +#undef abs +#include "math.h" +integer i_nint(real *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/i_sign.c b/lib/libF77/i_sign.c new file mode 100644 index 000000000000..94009b86e6fa --- /dev/null +++ b/lib/libF77/i_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_sign(a,b) integer *a, *b; +#else +integer i_sign(integer *a, integer *b) +#endif +{ +integer x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/lib/libF77/iargc_.c b/lib/libF77/iargc_.c new file mode 100644 index 000000000000..29614ec6595d --- /dev/null +++ b/lib/libF77/iargc_.c @@ -0,0 +1,11 @@ +#include "f2c.h" + +#ifdef KR_headers +ftnint iargc_() +#else +ftnint iargc_(void) +#endif +{ +extern int xargc; +return ( xargc - 1 ); +} diff --git a/lib/libF77/l_ge.c b/lib/libF77/l_ge.c new file mode 100644 index 000000000000..86b4a1f5a7f5 --- /dev/null +++ b/lib/libF77/l_ge.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) >= 0); +} diff --git a/lib/libF77/l_gt.c b/lib/libF77/l_gt.c new file mode 100644 index 000000000000..c4b52f5bf7dd --- /dev/null +++ b/lib/libF77/l_gt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) > 0); +} diff --git a/lib/libF77/l_le.c b/lib/libF77/l_le.c new file mode 100644 index 000000000000..f2740a238143 --- /dev/null +++ b/lib/libF77/l_le.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_le(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) <= 0); +} diff --git a/lib/libF77/l_lt.c b/lib/libF77/l_lt.c new file mode 100644 index 000000000000..c48dc946f9a7 --- /dev/null +++ b/lib/libF77/l_lt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) < 0); +} diff --git a/lib/libF77/libF77.xsum b/lib/libF77/libF77.xsum new file mode 100644 index 000000000000..faf4a24ac01c --- /dev/null +++ b/lib/libF77/libF77.xsum @@ -0,0 +1,119 @@ +Notice	1211689a	1195 +README	1c4c3814	4053 +Version.c	10d0f4c6	1447 +abort_.c	eaf90dc0	239 +c_abs.c	ecce7a47	205 +c_cos.c	f2338a46	260 +c_div.c	f780c50e	665 +c_exp.c	e1b005d5	270 +c_log.c	4050533	292 +c_sin.c	f19855c9	258 +c_sqrt.c	4e1ad71	505 +cabs.c	abac46c	427 +d_abs.c	ed70186c	151 +d_acos.c	e5d8cdee	178 +d_asin.c	f1c92f52	178 +d_atan.c	fe8cfd3f	178 +d_atn2.c	fa5f66a9	204 +d_cnjg.c	16aaf72f	165 +d_cos.c	f37be16	174 +d_cosh.c	a2f7dcf	178 +d_dim.c	1dfe4b39	165 +d_exp.c	fb0efb6d	174 +d_imag.c	ff9da248	134 +d_int.c	e10c5fc2	202 +d_lg10.c	1381342c	224 +d_log.c	ec2a8447	174 +d_mod.c	e30684f1	621 +d_nint.c	ffa7895c	214 +d_prod.c	e3b5d46a	140 +d_sign.c	1782063b	199 +d_sin.c	ef24638e	174 +d_sinh.c	e0ec938a	178 +d_sqrt.c	1ff988eb	178 +d_tan.c	ffc9a88e	174 +d_tanh.c	e5e0cbbd	178 +derf_.c	fdf1917c	172 +derfc_.c	4cb5ea3	186 +ef1asc_.c	f14b3469	453 +ef1cmc_.c	1e0b86e3	360 +erf_.c	7a407d	158 +erfc_.c	fb488e22	163 +f2ch.add	fed3bb7b	6056 +getarg_.c	edcf61f8	495 +getenv_.c	eaafcc11	975 +h_abs.c	8383aa6	151 +h_dim.c	9f9a693	163 +h_dnnt.c	d754cc8	218 +h_indx.c	145ff2e8	375 +h_len.c	e85aa13f	138 +h_mod.c	feacad2a	140 +h_nint.c	eb54a855	206 +h_sign.c	e7d69d03	199 +hl_ge.c	26bca46	279 +hl_gt.c	f5426c57	278 +hl_le.c	ff67a970	279 +hl_lt.c	f8842102	278 +i_abs.c	f6c3045e	147 +i_dim.c	ae23de2	158 +i_dnnt.c	e0c7e5e4	216 +i_indx.c	19177d0c	363 +i_len.c	e32e1f92	136 +i_mod.c	8bb577c	144 +i_nint.c	e0a366e8	204 +i_sign.c	1f26e421	193 +iargc_.c	324b252	129 +l_ge.c	5b7cb55	267 +l_gt.c	ad1b388	266 +l_le.c	f5407149	267 +l_lt.c	f81a93f8	266 +main.c	ec7fc5ad	2012 +makefile	1f2ebd87	3036 +pow_ci.c	f593b0b9	345 +pow_dd.c	e451857d	209 +pow_di.c	f5c04524	360 +pow_hh.c	feb3b910	401 +pow_ii.c	fe444c9b	395 +pow_qq.c	fdf1dc33	395 +pow_ri.c	ea06b62d	348 +pow_zi.c	f21e1934	694 +pow_zz.c	f0e5f141	482 +r_abs.c	1a4e3da	139 +r_acos.c	ca67f96	166 +r_asin.c	188a2306	166 +r_atan.c	fadda9d5	166 +r_atn2.c	e97a5392	186 +r_cnjg.c	f1c1fd80	151 +r_cos.c	f19d771e	162 +r_cosh.c	e20187a0	166 +r_dim.c	ef5e869	147 +r_exp.c	18979beb	162 +r_imag.c	e45086cf	122 +r_int.c	f2c2f39c	190 +r_lg10.c	1279226d	212 +r_log.c	2682a0d	162 +r_mod.c	f28ec59a	611 +r_nint.c	69d11bb	202 +r_sign.c	eddb76f9	181 +r_sin.c	10007227	162 +r_sinh.c	f21a38b8	166 +r_sqrt.c	f24b8aa4	166 +r_tan.c	e60b7778	162 +r_tanh.c	f22ec5c	166 +s_cat.c	e53641	408 +s_catow.c	538ae5a	1222 +s_cmp.c	ff4f2982	655 +s_copy.c	f50c7ec9	397 +s_paus.c	e726a719	1552 +s_rnge.c	1d6cada2	680 +s_stop.c	1f5aaac8	511 +sig_die.c	e934624a	634 +signal_.c	1b0b75f3	327 +system_.c	c910b8a	396 +z_abs.c	f71a28c1	201 +z_cos.c	110bc444	269 +z_div.c	ff56b823	675 +z_exp.c	ced892b	278 +z_log.c	4ea97f4	305 +z_sin.c	1215f0b4	267 +z_sqrt.c	e8d24b0	492 diff --git a/lib/libF77/main.c b/lib/libF77/main.c new file mode 100644 index 000000000000..24c2f22d3699 --- /dev/null +++ b/lib/libF77/main.c @@ -0,0 +1,128 @@ +/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ + +#include "stdio.h" +#include "signal.h" + +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + +#ifndef KR_headers +#include "stdlib.h" +#endif +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef NO__STDC +#define ONEXIT onexit +extern void f_exit(); +#else +#ifndef KR_headers +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 + +#ifdef KR_headers +extern void f_init(), sig_die(); +extern int MAIN__(); +#define Int /* int */ +#else +extern void f_init(void), sig_die(char*, int); +extern int MAIN__(void); +#define Int int +#endif + +static void sigfdie(Int n) +{ +sig_die("Floating Exception", 1); +} + + +static void sigidie(Int n) +{ +sig_die("IOT Trap", 1); +} + +#ifdef SIGQUIT +static void sigqdie(Int n) +{ +sig_die("Quit signal", 1); +} +#endif + + +static void sigindie(Int n) +{ +sig_die("Interrupt", 0); +} + +static void sigtdie(Int n) +{ +sig_die("Killed", 0); +} + +#ifdef SIGTRAP +static void sigtrdie(Int n) +{ +sig_die("Trace trap", 1); +} +#endif + + +int xargc; +char **xargv; + +#ifdef KR_headers +main(argc, argv) int argc; char **argv; +#else +main(int argc, char **argv) +#endif +{ +xargc = argc; +xargv = argv; +signal(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */ +#ifdef SIGIOT +signal(SIGIOT, sigidie); +#endif +#ifdef SIGTRAP +signal(SIGTRAP, sigtrdie); +#endif +#ifdef SIGQUIT +if(signal(SIGQUIT,sigqdie) == SIG_IGN) +	signal(SIGQUIT, SIG_IGN); +#endif +if(signal(SIGINT, sigindie) == SIG_IGN) +	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 +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. */ +} +#ifdef __cplusplus +	} +#endif diff --git a/lib/libF77/makefile b/lib/libF77/makefile new file mode 100644 index 000000000000..405128d2a572 --- /dev/null +++ b/lib/libF77/makefile @@ -0,0 +1,78 @@ +.SUFFIXES: .c .o +CC = cc +SHELL = /bin/sh +CFLAGS = -O + +# If your system lacks onexit() and you are not using an +# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS, +# e.g., by changing the above "CFLAGS =" line to +# CFLAGS = -O -DNO_ONEXIT + +# On at least some Sun systems, it is more appropriate to change the +# "CFLAGS =" line to +# CFLAGS = -O -Donexit=on_exit + +# compile, then strip unnecessary symbols +.c.o: +	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c +	ld -r -x -o $*.xxx $*.o +	mv $*.xxx $*.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 sig_die.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 + +# To compile with C++, first "make f2c.h" +f2c.h: f2ch.add +	cat /usr/include/f2c.h f2ch.add >f2c.h + +install:	libF77.a +	mv libF77.a /usr/lib + +clean: +	rm -f libF77.a *.o + +check: +	xsum Notice README Version.c abort_.c c_abs.c c_cos.c c_div.c \ +	c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \ +	d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \ +	d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \ +	d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \ +	derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c f2ch.add \ +	getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ +	h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ +	i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \ +	i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c main.c makefile \ +	pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c pow_qq.c pow_ri.c \ +	pow_zi.c pow_zz.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ +	r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ +	r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ +	r_tan.c r_tanh.c s_cat.c s_catow.c s_cmp.c s_copy.c s_paus.c s_rnge.c \ +	s_stop.c sig_die.c signal_.c system_.c z_abs.c z_cos.c z_div.c \ +	z_exp.c z_log.c z_sin.c z_sqrt.c >zap +	cmp zap libF77.xsum && rm zap || diff libF77.xsum zap diff --git a/lib/libF77/pow_ci.c b/lib/libF77/pow_ci.c new file mode 100644 index 000000000000..37e2ce0f2eb9 --- /dev/null +++ b/lib/libF77/pow_ci.c @@ -0,0 +1,20 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID pow_ci(p, a, b) 	/* p = a**b  */ + complex *p, *a; integer *b; +#else +extern void pow_zi(doublecomplex*, doublecomplex*, integer*); +void pow_ci(complex *p, complex *a, integer *b) 	/* p = a**b  */ +#endif +{ +doublecomplex p1, a1; + +a1.r = a->r; +a1.i = a->i; + +pow_zi(&p1, &a1, b); + +p->r = p1.r; +p->i = p1.i; +} diff --git a/lib/libF77/pow_dd.c b/lib/libF77/pow_dd.c new file mode 100644 index 000000000000..d2bb0e39bfdc --- /dev/null +++ b/lib/libF77/pow_dd.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow(); +double pow_dd(ap, bp) doublereal *ap, *bp; +#else +#undef abs +#include "math.h" +double pow_dd(doublereal *ap, doublereal *bp) +#endif +{ +return(pow(*ap, *bp) ); +} diff --git a/lib/libF77/pow_di.c b/lib/libF77/pow_di.c new file mode 100644 index 000000000000..7af69a71259b --- /dev/null +++ b/lib/libF77/pow_di.c @@ -0,0 +1,34 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow_di(ap, bp) doublereal *ap; integer *bp; +#else +double pow_di(doublereal *ap, integer *bp) +#endif +{ +double pow, x; +integer n; + +pow = 1; +x = *ap; +n = *bp; + +if(n != 0) +	{ +	if(n < 0) +		{ +		n = -n; +		x = 1/x; +		} +	for( ; ; ) +		{ +		if(n & 01) +			pow *= x; +		if(n >>= 1) +			x *= x; +		else +			break; +		} +	} +return(pow); +} diff --git a/lib/libF77/pow_hh.c b/lib/libF77/pow_hh.c new file mode 100644 index 000000000000..e1a503c5ca82 --- /dev/null +++ b/lib/libF77/pow_hh.c @@ -0,0 +1,31 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint pow_hh(ap, bp) shortint *ap, *bp; +#else +shortint pow_hh(shortint *ap, shortint *bp) +#endif +{ +	shortint pow, x, n; + +	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; +		} +	for(pow = 1; ; ) +		{ +		if(n & 01) +			pow *= x; +		if(n >>= 1) +			x *= x; +		else +			break; +		} +	return(pow); +	} diff --git a/lib/libF77/pow_ii.c b/lib/libF77/pow_ii.c new file mode 100644 index 000000000000..e7948776e6c7 --- /dev/null +++ b/lib/libF77/pow_ii.c @@ -0,0 +1,31 @@ +#include "f2c.h" + +#ifdef KR_headers +integer pow_ii(ap, bp) integer *ap, *bp; +#else +integer pow_ii(integer *ap, integer *bp) +#endif +{ +	integer pow, x, n; + +	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; +		} +	for(pow = 1; ; ) +		{ +		if(n & 01) +			pow *= x; +		if(n >>= 1) +			x *= x; +		else +			break; +		} +	return(pow); +	} diff --git a/lib/libF77/pow_qq.c b/lib/libF77/pow_qq.c new file mode 100644 index 000000000000..d80c40a9a697 --- /dev/null +++ b/lib/libF77/pow_qq.c @@ -0,0 +1,31 @@ +#include "f2c.h" + +#ifdef KR_headers +longint pow_qq(ap, bp) longint *ap, *bp; +#else +longint pow_qq(longint *ap, longint *bp) +#endif +{ +	longint pow, x, n; + +	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; +		} +	for(pow = 1; ; ) +		{ +		if(n & 01) +			pow *= x; +		if(n >>= 1) +			x *= x; +		else +			break; +		} +	return(pow); +	} diff --git a/lib/libF77/pow_ri.c b/lib/libF77/pow_ri.c new file mode 100644 index 000000000000..3a3c4cf1ca4e --- /dev/null +++ b/lib/libF77/pow_ri.c @@ -0,0 +1,34 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow_ri(ap, bp) real *ap; integer *bp; +#else +double pow_ri(real *ap, integer *bp) +#endif +{ +double pow, x; +integer n; + +pow = 1; +x = *ap; +n = *bp; + +if(n != 0) +	{ +	if(n < 0) +		{ +		n = -n; +		x = 1/x; +		} +	for( ; ; ) +		{ +		if(n & 01) +			pow *= x; +		if(n >>= 1) +			x *= x; +		else +			break; +		} +	} +return(pow); +} diff --git a/lib/libF77/pow_zi.c b/lib/libF77/pow_zi.c new file mode 100644 index 000000000000..8dd60069bfe0 --- /dev/null +++ b/lib/libF77/pow_zi.c @@ -0,0 +1,50 @@ +#include "f2c.h" + +#ifdef KR_headers +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 *p, doublecomplex *a, integer *b) 	/* p = a**b  */ +#endif +{ +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; +	} +} diff --git a/lib/libF77/pow_zz.c b/lib/libF77/pow_zz.c new file mode 100644 index 000000000000..55785dffbe6b --- /dev/null +++ b/lib/libF77/pow_zz.c @@ -0,0 +1,23 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(), exp(), cos(), sin(), atan2(), f__cabs(); +VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; +#else +#undef abs +#include "math.h" +extern double f__cabs(double,double); +void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) +#endif +{ +double logr, logi, x, y; + +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; + +r->r = x * cos(y); +r->i = x * sin(y); +} diff --git a/lib/libF77/r_abs.c b/lib/libF77/r_abs.c new file mode 100644 index 000000000000..7b222961d16d --- /dev/null +++ b/lib/libF77/r_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_abs(x) real *x; +#else +double r_abs(real *x) +#endif +{ +if(*x >= 0) +	return(*x); +return(- *x); +} diff --git a/lib/libF77/r_acos.c b/lib/libF77/r_acos.c new file mode 100644 index 000000000000..328812ab6aa2 --- /dev/null +++ b/lib/libF77/r_acos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double acos(); +double r_acos(x) real *x; +#else +#undef abs +#include "math.h" +double r_acos(real *x) +#endif +{ +return( acos(*x) ); +} diff --git a/lib/libF77/r_asin.c b/lib/libF77/r_asin.c new file mode 100644 index 000000000000..a30c6706b06d --- /dev/null +++ b/lib/libF77/r_asin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double asin(); +double r_asin(x) real *x; +#else +#undef abs +#include "math.h" +double r_asin(real *x) +#endif +{ +return( asin(*x) ); +} diff --git a/lib/libF77/r_atan.c b/lib/libF77/r_atan.c new file mode 100644 index 000000000000..1e3817bdf661 --- /dev/null +++ b/lib/libF77/r_atan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan(); +double r_atan(x) real *x; +#else +#undef abs +#include "math.h" +double r_atan(real *x) +#endif +{ +return( atan(*x) ); +} diff --git a/lib/libF77/r_atn2.c b/lib/libF77/r_atn2.c new file mode 100644 index 000000000000..3832a27f3e3c --- /dev/null +++ b/lib/libF77/r_atn2.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan2(); +double r_atn2(x,y) real *x, *y; +#else +#undef abs +#include "math.h" +double r_atn2(real *x, real *y) +#endif +{ +return( atan2(*x,*y) ); +} diff --git a/lib/libF77/r_cnjg.c b/lib/libF77/r_cnjg.c new file mode 100644 index 000000000000..e127ca969c4f --- /dev/null +++ b/lib/libF77/r_cnjg.c @@ -0,0 +1,11 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID r_cnjg(r, z) complex *r, *z; +#else +VOID r_cnjg(complex *r, complex *z) +#endif +{ +r->r = z->r; +r->i = - z->i; +} diff --git a/lib/libF77/r_cos.c b/lib/libF77/r_cos.c new file mode 100644 index 000000000000..cf5c8eb4af29 --- /dev/null +++ b/lib/libF77/r_cos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cos(); +double r_cos(x) real *x; +#else +#undef abs +#include "math.h" +double r_cos(real *x) +#endif +{ +return( cos(*x) ); +} diff --git a/lib/libF77/r_cosh.c b/lib/libF77/r_cosh.c new file mode 100644 index 000000000000..5756c172427b --- /dev/null +++ b/lib/libF77/r_cosh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cosh(); +double r_cosh(x) real *x; +#else +#undef abs +#include "math.h" +double r_cosh(real *x) +#endif +{ +return( cosh(*x) ); +} diff --git a/lib/libF77/r_dim.c b/lib/libF77/r_dim.c new file mode 100644 index 000000000000..baca95cd9e47 --- /dev/null +++ b/lib/libF77/r_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_dim(a,b) real *a, *b; +#else +double r_dim(real *a, real *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/lib/libF77/r_exp.c b/lib/libF77/r_exp.c new file mode 100644 index 000000000000..a95f4bc7f2b2 --- /dev/null +++ b/lib/libF77/r_exp.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(); +double r_exp(x) real *x; +#else +#undef abs +#include "math.h" +double r_exp(real *x) +#endif +{ +return( exp(*x) ); +} diff --git a/lib/libF77/r_imag.c b/lib/libF77/r_imag.c new file mode 100644 index 000000000000..d51252bbb791 --- /dev/null +++ b/lib/libF77/r_imag.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_imag(z) complex *z; +#else +double r_imag(complex *z) +#endif +{ +return(z->i); +} diff --git a/lib/libF77/r_int.c b/lib/libF77/r_int.c new file mode 100644 index 000000000000..11264bf19247 --- /dev/null +++ b/lib/libF77/r_int.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double r_int(x) real *x; +#else +#undef abs +#include "math.h" +double r_int(real *x) +#endif +{ +return( (*x>0) ? floor(*x) : -floor(- *x) ); +} diff --git a/lib/libF77/r_lg10.c b/lib/libF77/r_lg10.c new file mode 100644 index 000000000000..4ea02f451003 --- /dev/null +++ b/lib/libF77/r_lg10.c @@ -0,0 +1,15 @@ +#include "f2c.h" + +#define log10e 0.43429448190325182765 + +#ifdef KR_headers +double log(); +double r_lg10(x) real *x; +#else +#undef abs +#include "math.h" +double r_lg10(real *x) +#endif +{ +return( log10e * log(*x) ); +} diff --git a/lib/libF77/r_log.c b/lib/libF77/r_log.c new file mode 100644 index 000000000000..aec6726ef5b6 --- /dev/null +++ b/lib/libF77/r_log.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(); +double r_log(x) real *x; +#else +#undef abs +#include "math.h" +double r_log(real *x) +#endif +{ +return( log(*x) ); +} diff --git a/lib/libF77/r_mod.c b/lib/libF77/r_mod.c new file mode 100644 index 000000000000..7adb44cdbec0 --- /dev/null +++ b/lib/libF77/r_mod.c @@ -0,0 +1,40 @@ +#include "f2c.h" + +#ifdef KR_headers +#ifdef IEEE_drem +double drem(); +#else +double floor(); +#endif +double r_mod(x,y) real *x, *y; +#else +#ifdef IEEE_drem +double drem(double, double); +#else +#undef abs +#include "math.h" +#endif +double r_mod(real *x, real *y) +#endif +{ +#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; +#else +	double quotient; +	if( (quotient = (double)*x / *y) >= 0) +		quotient = floor(quotient); +	else +		quotient = -floor(-quotient); +	return(*x - (*y) * quotient ); +#endif +} diff --git a/lib/libF77/r_nint.c b/lib/libF77/r_nint.c new file mode 100644 index 000000000000..c45bac6458f0 --- /dev/null +++ b/lib/libF77/r_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double r_nint(x) real *x; +#else +#undef abs +#include "math.h" +double r_nint(real *x) +#endif +{ +return( (*x)>=0 ? +	floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/lib/libF77/r_sign.c b/lib/libF77/r_sign.c new file mode 100644 index 000000000000..df6d02af00a7 --- /dev/null +++ b/lib/libF77/r_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_sign(a,b) real *a, *b; +#else +double r_sign(real *a, real *b) +#endif +{ +double x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/lib/libF77/r_sin.c b/lib/libF77/r_sin.c new file mode 100644 index 000000000000..d2a3dac8581e --- /dev/null +++ b/lib/libF77/r_sin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(); +double r_sin(x) real *x; +#else +#undef abs +#include "math.h" +double r_sin(real *x) +#endif +{ +return( sin(*x) ); +} diff --git a/lib/libF77/r_sinh.c b/lib/libF77/r_sinh.c new file mode 100644 index 000000000000..00cba0cb07f9 --- /dev/null +++ b/lib/libF77/r_sinh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sinh(); +double r_sinh(x) real *x; +#else +#undef abs +#include "math.h" +double r_sinh(real *x) +#endif +{ +return( sinh(*x) ); +} diff --git a/lib/libF77/r_sqrt.c b/lib/libF77/r_sqrt.c new file mode 100644 index 000000000000..26b45458aac9 --- /dev/null +++ b/lib/libF77/r_sqrt.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(); +double r_sqrt(x) real *x; +#else +#undef abs +#include "math.h" +double r_sqrt(real *x) +#endif +{ +return( sqrt(*x) ); +} diff --git a/lib/libF77/r_tan.c b/lib/libF77/r_tan.c new file mode 100644 index 000000000000..736b37893c44 --- /dev/null +++ b/lib/libF77/r_tan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tan(); +double r_tan(x) real *x; +#else +#undef abs +#include "math.h" +double r_tan(real *x) +#endif +{ +return( tan(*x) ); +} diff --git a/lib/libF77/r_tanh.c b/lib/libF77/r_tanh.c new file mode 100644 index 000000000000..044255a08cc0 --- /dev/null +++ b/lib/libF77/r_tanh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tanh(); +double r_tanh(x) real *x; +#else +#undef abs +#include "math.h" +double r_tanh(real *x) +#endif +{ +return( tanh(*x) ); +} diff --git a/lib/libF77/s_cat.c b/lib/libF77/s_cat.c new file mode 100644 index 000000000000..7f55cd561188 --- /dev/null +++ b/lib/libF77/s_cat.c @@ -0,0 +1,25 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; +#else +VOID s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) +#endif +{ +ftnlen i, n, nc; +char *f__rp; + +n = *np; +for(i = 0 ; i < n ; ++i) +	{ +	nc = ll; +	if(rnp[i] < nc) +		nc = rnp[i]; +	ll -= nc; +	f__rp = rpp[i]; +	while(--nc >= 0) +		*lp++ = *f__rp++; +	} +while(--ll >= 0) +	*lp++ = ' '; +} diff --git a/lib/libF77/s_catow.c b/lib/libF77/s_catow.c new file mode 100644 index 000000000000..6dd641c0b875 --- /dev/null +++ b/lib/libF77/s_catow.c @@ -0,0 +1,69 @@ +/* Variant of s_cat that allows the target of a concatenation to */ +/* appear on its right-hand side (contrary to the Fortran 77 Standard). */ + +#include "f2c.h" +#undef abs +#ifdef KR_headers + extern char *malloc(); + extern void free(); +#else +#include "stdlib.h" +#endif +#include "string.h" + + static VOID +#ifdef KR_headers +s_cat0(lp, rpp, rnp, n, ll) char *lp, *rpp[]; ftnlen rnp[], n, ll; +#else +s_cat0(char *lp, char *rpp[], ftnlen rnp[], ftnlen n, ftnlen ll) +#endif +{ +	ftnlen i, nc; +	char *rp; + +	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++ = ' '; +	} + + VOID +#ifdef KR_headers +s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; +#else +s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) +#endif +{ +	ftnlen i, L, m, n; +	char *lpe, *rp; + +	n = *np; +	lpe = lp; +	L = ll; +	i = 0; +	while(i < n) { +		rp = rpp[i]; +		m = rnp[i++]; +		if (rp >= lpe || rp + m <= lp) { +			if ((L -= m) <= 0) { +				n = i; +				break; +				} +			lpe += m; +			continue; +			} +		lpe = malloc(ll); +		s_cat0(lpe, rpp, rnp, n, ll); +		memcpy(lp, lpe, ll); +		free(lpe); +		return; +		} +	s_cat0(lp, rpp, rnp, n, ll); +	} diff --git a/lib/libF77/s_cmp.c b/lib/libF77/s_cmp.c new file mode 100644 index 000000000000..1e052f286426 --- /dev/null +++ b/lib/libF77/s_cmp.c @@ -0,0 +1,44 @@ +#include "f2c.h" + +/* compare two strings */ + +#ifdef KR_headers +integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb; +#else +integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb) +#endif +{ +register unsigned char *a, *aend, *b, *bend; +a = (unsigned char *)a0; +b = (unsigned char *)b0; +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); +} diff --git a/lib/libF77/s_copy.c b/lib/libF77/s_copy.c new file mode 100644 index 000000000000..989f5dded9b0 --- /dev/null +++ b/lib/libF77/s_copy.c @@ -0,0 +1,27 @@ +#include "f2c.h" + +/* assign strings:  a = b */ + +#ifdef KR_headers +VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; +#else +void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) +#endif +{ +register 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++ = ' '; +	} +} diff --git a/lib/libF77/s_paus.c b/lib/libF77/s_paus.c new file mode 100644 index 000000000000..43bd32222379 --- /dev/null +++ b/lib/libF77/s_paus.c @@ -0,0 +1,88 @@ +#include "stdio.h" +#include "f2c.h" +#define PAUSESIG 15 + +#ifdef KR_headers +#define Void /* void */ +#define Int /* int */ +#else +#define Void void +#define Int int +#undef abs +#undef min +#undef max +#include "stdlib.h" +#include "signal.h" +#ifdef __cplusplus +extern "C" { +#endif +extern int getpid(void), isatty(int), pause(void); +#endif + +extern VOID f_exit(Void); + + static VOID +waitpause(Int n) +{	n = n; /* shut up compiler warning */ +	return; +	} + + static VOID +#ifdef KR_headers +s_1paus(fin) FILE *fin; +#else +s_1paus(FILE *fin) +#endif +{ +	fprintf(stderr, +	"To resume execution, type go.  Other input will terminate the job.\n"); +	fflush(stderr); +	if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) { +		fprintf(stderr, "STOP\n"); +#ifdef NO_ONEXIT +		f_exit(); +#endif +		exit(0); +		} +	} + + int +#ifdef KR_headers +s_paus(s, n) char *s; ftnlen n; +#else +s_paus(char *s, ftnlen n) +#endif +{ +	fprintf(stderr, "PAUSE "); +	if(n > 0) +		fprintf(stderr, " %.*s", (int)n, s); +	fprintf(stderr, " statement executed\n"); +	if( isatty(fileno(stdin)) ) +		s_1paus(stdin); +	else { +#ifdef MSDOS +		FILE *fin; +		fin = fopen("con", "r"); +		if (!fin) { +			fprintf(stderr, "s_paus: can't open con!\n"); +			fflush(stderr); +			exit(1); +			} +		s_1paus(fin); +		fclose(fin); +#else +		fprintf(stderr, +		"To resume execution, execute a   kill -%d %d   command\n", +			PAUSESIG, getpid() ); +		signal(PAUSESIG, waitpause); +		fflush(stderr); +		pause(); +#endif +		} +	fprintf(stderr, "Execution resumes after PAUSE.\n"); +	fflush(stderr); +	return 0; /* NOT REACHED */ +#ifdef __cplusplus +	} +#endif +} diff --git a/lib/libF77/s_rnge.c b/lib/libF77/s_rnge.c new file mode 100644 index 000000000000..b200fce1bf34 --- /dev/null +++ b/lib/libF77/s_rnge.c @@ -0,0 +1,26 @@ +#include "stdio.h" +#include "f2c.h" + +/* called when a subscript is out of range */ + +#ifdef KR_headers +extern VOID sig_die(); +integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; +#else +extern VOID sig_die(char*,int); +integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) +#endif +{ +register int i; + +fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line); +while((i = *procn) && i != '_' && i != ' ') +	putc(*procn++, stderr); +fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1); +while((i = *varn) && i != ' ') +	putc(*varn++, stderr); +sig_die(".", 1); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/lib/libF77/s_stop.c b/lib/libF77/s_stop.c new file mode 100644 index 000000000000..be3c28ba5e54 --- /dev/null +++ b/lib/libF77/s_stop.c @@ -0,0 +1,37 @@ +#include "stdio.h" +#include "f2c.h" + +#ifdef KR_headers +extern void f_exit(); +VOID s_stop(s, n) char *s; ftnlen n; +#else +#undef abs +#undef min +#undef max +#include "stdlib.h" +#ifdef __cplusplus +extern "C" { +#endif +void f_exit(void); + +int s_stop(char *s, ftnlen n) +#endif +{ +int i; + +if(n > 0) +	{ +	fprintf(stderr, "STOP "); +	for(i = 0; i<n ; ++i) +		putc(*s++, stderr); +	fprintf(stderr, " statement executed\n"); +	} +#ifdef NO_ONEXIT +f_exit(); +#endif +exit(0); +#ifdef __cplusplus +return 0; /* NOT REACHED */ +} +#endif +} diff --git a/lib/libF77/sig_die.c b/lib/libF77/sig_die.c new file mode 100644 index 000000000000..dba1521f81a0 --- /dev/null +++ b/lib/libF77/sig_die.c @@ -0,0 +1,45 @@ +#include "stdio.h" +#include "signal.h" + +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + +#ifdef KR_headers +void sig_die(s, kill) register char *s; int kill; +#else +#include "stdlib.h" +#ifdef __cplusplus +extern "C" { +#endif + extern void f_exit(void); + +void sig_die(register char *s, int kill) +#endif +{ +	/* print error message, then clear buffers */ +	fprintf(stderr, "%s\n", s); + +	if(kill) +		{ +		fflush(stderr); +		f_exit(); +		fflush(stderr); +		/* now get a core */ +#ifdef SIGIOT +		signal(SIGIOT, SIG_DFL); +#endif +		abort(); +		} +	else { +#ifdef NO_ONEXIT +		f_exit(); +#endif +		exit(1); +		} +	} +#ifdef __cplusplus +} +#endif diff --git a/lib/libF77/signal_.c b/lib/libF77/signal_.c new file mode 100644 index 000000000000..90ec7ea39af2 --- /dev/null +++ b/lib/libF77/signal_.c @@ -0,0 +1,19 @@ +#include "f2c.h" + +#ifdef KR_headers +typedef int (*sig_type)(); +extern sig_type signal(); + +ftnint signal_(sigp, proc) integer *sigp; sig_type proc; +#else +#include "signal.h" +typedef void (*sig_type)(int); + +ftnint signal_(integer *sigp, sig_type proc) +#endif +{ +	int sig; +	sig = (int)*sigp; + +	return (ftnint)signal(sig, proc); +	} diff --git a/lib/libF77/system_.c b/lib/libF77/system_.c new file mode 100644 index 000000000000..6f8a71d2e7a0 --- /dev/null +++ b/lib/libF77/system_.c @@ -0,0 +1,24 @@ +/* f77 interface to system routine */ + +#include "f2c.h" + +#ifdef KR_headers +system_(s, n) register char *s; ftnlen n; +#else +#undef abs +#undef min +#undef max +#include "stdlib.h" +system_(register char *s, ftnlen n) +#endif +{ +char buff[1000]; +register char *bp, *blast; + +blast = buff + (n < 1000 ? n : 1000); + +for(bp = buff ; bp<blast && *s!='\0' ; ) +	*bp++ = *s++; +*bp = '\0'; +return system(buff); +} diff --git a/lib/libF77/z_abs.c b/lib/libF77/z_abs.c new file mode 100644 index 000000000000..7e67ad2957fb --- /dev/null +++ b/lib/libF77/z_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double f__cabs(); +double z_abs(z) doublecomplex *z; +#else +double f__cabs(double, double); +double z_abs(doublecomplex *z) +#endif +{ +return( f__cabs( z->r, z->i ) ); +} diff --git a/lib/libF77/z_cos.c b/lib/libF77/z_cos.c new file mode 100644 index 000000000000..bc9e23e18a72 --- /dev/null +++ b/lib/libF77/z_cos.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(), cos(), sinh(), cosh(); +VOID z_cos(r, z) doublecomplex *r, *z; +#else +#undef abs +#include "math.h" +void z_cos(doublecomplex *r, doublecomplex *z) +#endif +{ +r->r = cos(z->r) * cosh(z->i); +r->i = - sin(z->r) * sinh(z->i); +} diff --git a/lib/libF77/z_div.c b/lib/libF77/z_div.c new file mode 100644 index 000000000000..fd53733e8827 --- /dev/null +++ b/lib/libF77/z_div.c @@ -0,0 +1,36 @@ +#include "f2c.h" + +#ifdef KR_headers +extern void sig_die(); +VOID z_div(c, a, b) doublecomplex *a, *b, *c; +#else +extern void sig_die(char*, int); +void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) +#endif +{ +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) +		sig_die("complex division by zero", 1); +	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; +	} + +} diff --git a/lib/libF77/z_exp.c b/lib/libF77/z_exp.c new file mode 100644 index 000000000000..56138f3d34b4 --- /dev/null +++ b/lib/libF77/z_exp.c @@ -0,0 +1,17 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(), cos(), sin(); +VOID z_exp(r, z) doublecomplex *r, *z; +#else +#undef abs +#include "math.h" +void z_exp(doublecomplex *r, doublecomplex *z) +#endif +{ +double expx; + +expx = exp(z->r); +r->r = expx * cos(z->i); +r->i = expx * sin(z->i); +} diff --git a/lib/libF77/z_log.c b/lib/libF77/z_log.c new file mode 100644 index 000000000000..fa1ac803eb3a --- /dev/null +++ b/lib/libF77/z_log.c @@ -0,0 +1,16 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(), f__cabs(), atan2(); +VOID z_log(r, z) doublecomplex *r, *z; +#else +#undef abs +#include "math.h" +extern double f__cabs(double, double); +void z_log(doublecomplex *r, doublecomplex *z) +#endif +{ + +r->i = atan2(z->i, z->r); +r->r = log( f__cabs( z->r, z->i ) ); +} diff --git a/lib/libF77/z_sin.c b/lib/libF77/z_sin.c new file mode 100644 index 000000000000..bd908046f394 --- /dev/null +++ b/lib/libF77/z_sin.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(), cos(), sinh(), cosh(); +VOID z_sin(r, z) doublecomplex *r, *z; +#else +#undef abs +#include "math.h" +void z_sin(doublecomplex *r, doublecomplex *z) +#endif +{ +r->r = sin(z->r) * cosh(z->i); +r->i = cos(z->r) * sinh(z->i); +} diff --git a/lib/libF77/z_sqrt.c b/lib/libF77/z_sqrt.c new file mode 100644 index 000000000000..eed38d0cef85 --- /dev/null +++ b/lib/libF77/z_sqrt.c @@ -0,0 +1,29 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(), f__cabs(); +VOID z_sqrt(r, z) doublecomplex *r, *z; +#else +#undef abs +#include "math.h" +extern double f__cabs(double, double); +void z_sqrt(doublecomplex *r, doublecomplex *z) +#endif +{ +double mag; + +if( (mag = f__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; +	} +} | 
