First commit of f2c library directory

ext/f2c_libs/.cvsignore

@@ -0,0 +1,4 @@
+Makefile
+arith.h
+signal1.h
+sysdep1.h

ext/f2c_libs/Makefile.in

@@ -0,0 +1,189 @@
+#
+# $Source$
+# $Author$
+# $Revision$
+# $Date$
+#
+# Unix makefile: see README.
+# For C++, first "make hadd".
+# If your compiler does not recognize ANSI C, add
+#	-DKR_headers
+# to the CFLAGS = line below.
+# On Sun and other BSD systems that do not provide an ANSI sprintf, add
+#	-DUSE_STRLEN
+# to the CFLAGS = line below.
+# On Linux systems, add
+#	-DNON_UNIX_STDIO
+# to the CFLAGS = line below.  For libf2c.so under Linux, also add
+#	-fPIC
+# to the CFLAGS = line below.
+
+.SUFFIXES: .c .o
+
+# the C compiler
+CC = @CC@
+SHELL = /bin/sh
+
+CFLAGS = @CXXFLAGS@ $(CXX_OPT)
+
+# Destination f2c lib located in Cantera's build directory
+# -> Calling it ctf2c
+F2C_LIB = @buildlib@/libctf2c.a
+
+# compile, then strip unnecessary symbols
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
+	ld -r -x -o $*.xxx $*.o
+	mv $*.xxx $*.o
+
+## Under Solaris (and other systems that do not understand ld -x),
+## omit -x in the ld line above.
+## If your system does not have the ld command, comment out
+## or remove both the ld and mv lines above.
+
+MISC =	f77vers.o i77vers.o main.o s_rnge.o abort_.o exit_.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 uninit.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\
+	lbitbits.o lbitshft.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 =	f77_aloc.o s_cat.o s_cmp.o s_copy.o
+I77 =	backspac.o close.o dfe.o dolio.o due.o endfile.o err.o\
+	fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o\
+	open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o\
+	typesize.o uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o
+QINT =	pow_qq.o qbitbits.o qbitshft.o ftell64_.o
+TIME =	dtime_.o etime_.o
+
+# If you get an error compiling dtime_.c or etime_.c, try adding
+# -DUSE_CLOCK to the CFLAGS assignment above; if that does not work,
+# omit $(TIME) from OFILES = assignment below.
+
+# To get signed zeros in write statements on IEEE-arithmetic systems,
+# add -DSIGNED_ZEROS to the CFLAGS assignment below and add signbit.o
+# to the end of the OFILES = assignment below.
+
+# For INTEGER*8 support (which requires system-dependent adjustments to
+# f2c.h), add $(QINT) to the OFILES = assignment below...
+
+OFILES = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
+	$(HALF) $(CMP) $(EFL) $(CHAR) $(I77) $(TIME)
+
+all: f2c.h signal1.h sysdep1.h $(F2C_LIB)
+
+$(F2C_LIB): $(OFILES)
+	ar r $(F2C_LIB) $?
+	-ranlib  $(F2C_LIB)
+
+### If your system lacks ranlib, you don't need it; see README.
+
+f77vers.o: f77vers.c
+	$(CC) -c f77vers.c
+
+i77vers.o: i77vers.c
+	$(CC) -c i77vers.c
+
+# To get an "f2c.h" for use with "f2c -C++", first "make hadd"
+hadd: f2c.h0 f2ch.add
+	cat f2c.h0 f2ch.add >f2c.h
+
+# For use with "f2c" and "f2c -A":
+f2c.h: f2c.h0
+	cp f2c.h0 f2c.h
+
+# You may need to adjust signal1.h and sysdep1.h suitably for your system...
+signal1.h: signal1.h0
+	cp signal1.h0 signal1.h
+
+sysdep1.h: sysdep1.h0
+	cp sysdep1.h0 sysdep1.h
+
+# 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 -DSkip_f2c_Undefs 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 -DSkip_f2c_Undefs main.c
+
+
+
+clean:
+	$(RM) $(F2C_LIB) *.o arith.h signal1.h sysdep1.h
+
+backspac.o:	fio.h
+close.o:	fio.h
+dfe.o:		fio.h
+dfe.o:		fmt.h
+due.o:		fio.h
+endfile.o:	fio.h rawio.h
+err.o:		fio.h rawio.h
+fmt.o:		fio.h
+fmt.o:		fmt.h
+iio.o:		fio.h
+iio.o:		fmt.h
+ilnw.o:		fio.h
+ilnw.o:		lio.h
+inquire.o:	fio.h
+lread.o:	fio.h
+lread.o:	fmt.h
+lread.o:	lio.h
+lread.o:	fp.h
+lwrite.o:	fio.h
+lwrite.o:	fmt.h
+lwrite.o:	lio.h
+open.o:		fio.h rawio.h
+rdfmt.o:	fio.h
+rdfmt.o:	fmt.h
+rdfmt.o:	fp.h
+rewind.o:	fio.h
+rsfe.o:		fio.h
+rsfe.o:		fmt.h
+rsli.o:		fio.h
+rsli.o:		lio.h
+rsne.o:		fio.h
+rsne.o:		lio.h
+sfe.o:		fio.h
+signbit.o:	arith.h
+sue.o:		fio.h
+uio.o:		fio.h
+uninit.o:	arith.h
+util.o:		fio.h
+wref.o:		fio.h
+wref.o:		fmt.h
+wref.o:		fp.h
+wrtfmt.o:	fio.h
+wrtfmt.o:	fmt.h
+wsfe.o:		fio.h
+wsfe.o:		fmt.h
+wsle.o:		fio.h
+wsle.o:		fmt.h
+wsle.o:		lio.h
+wsne.o:		fio.h
+wsne.o:		lio.h
+xwsne.o:	fio.h
+xwsne.o:	lio.h
+xwsne.o:	fmt.h
+
+arith.h: arithchk.c
+	$(CC) $(CFLAGS) -DNO_FPINIT arithchk.c -lm ||\
+	 $(CC) -DNO_LONG_LONG $(CFLAGS) -DNO_FPINIT arithchk.c -lm
+	./a.out >arith.h
+	rm -f a.out arithchk.o
+

ext/f2c_libs/abort_.c

@@ -0,0 +1,22 @@
+#include "stdio.h"
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+return 0;	/* not reached */
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/arithchk.c

@@ -0,0 +1,225 @@
+/****************************************************************
+Copyright (C) 1997, 1998, 2000 Lucent Technologies
+All Rights Reserved
+
+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 name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES 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.
+****************************************************************/
+
+/* Try to deduce arith.h from arithmetic properties. */
+
+#include <stdio.h>
+#include <math.h>
+#include <errno.h>
+
+#ifdef NO_FPINIT
+#define fpinit_ASL()
+#else
+#ifndef KR_headers
+extern
+#ifdef __cplusplus
+	"C"
+#endif
+	void fpinit_ASL(void);
+#endif /*KR_headers*/
+#endif /*NO_FPINIT*/
+
+ static int dalign;
+ typedef struct
+Akind {
+	char *name;
+	int   kind;
+	} Akind;
+
+ static Akind
+IEEE_8087	= { "IEEE_8087", 1 },
+IEEE_MC68k	= { "IEEE_MC68k", 2 },
+IBM		= { "IBM", 3 },
+VAX		= { "VAX", 4 },
+CRAY		= { "CRAY", 5};
+
+ static double t_nan;
+
+ static Akind *
+Lcheck()
+{
+	union {
+		double d;
+		long L[2];
+		} u;
+	struct {
+		double d;
+		long L;
+		} x[2];
+
+	if (sizeof(x) > 2*(sizeof(double) + sizeof(long)))
+		dalign = 1;
+	u.L[0] = u.L[1] = 0;
+	u.d = 1e13;
+	if (u.L[0] == 1117925532 && u.L[1] == -448790528)
+		return &IEEE_MC68k;
+	if (u.L[1] == 1117925532 && u.L[0] == -448790528)
+		return &IEEE_8087;
+	if (u.L[0] == -2065213935 && u.L[1] == 10752)
+		return &VAX;
+	if (u.L[0] == 1267827943 && u.L[1] == 704643072)
+		return &IBM;
+	return 0;
+	}
+
+ static Akind *
+icheck()
+{
+	union {
+		double d;
+		int L[2];
+		} u;
+	struct {
+		double d;
+		int L;
+		} x[2];
+
+	if (sizeof(x) > 2*(sizeof(double) + sizeof(int)))
+		dalign = 1;
+	u.L[0] = u.L[1] = 0;
+	u.d = 1e13;
+	if (u.L[0] == 1117925532 && u.L[1] == -448790528)
+		return &IEEE_MC68k;
+	if (u.L[1] == 1117925532 && u.L[0] == -448790528)
+		return &IEEE_8087;
+	if (u.L[0] == -2065213935 && u.L[1] == 10752)
+		return &VAX;
+	if (u.L[0] == 1267827943 && u.L[1] == 704643072)
+		return &IBM;
+	return 0;
+	}
+
+char *emptyfmt = "";	/* avoid possible warning message with printf("") */
+
+ static Akind *
+ccheck()
+{
+	union {
+		double d;
+		long L;
+		} u;
+	long Cray1;
+
+	/* Cray1 = 4617762693716115456 -- without overflow on non-Crays */
+	Cray1 = printf(emptyfmt) < 0 ? 0 : 4617762;
+	if (printf(emptyfmt, Cray1) >= 0)
+		Cray1 = 1000000*Cray1 + 693716;
+	if (printf(emptyfmt, Cray1) >= 0)
+		Cray1 = 1000000*Cray1 + 115456;
+	u.d = 1e13;
+	if (u.L == Cray1)
+		return &CRAY;
+	return 0;
+	}
+
+ static int
+fzcheck()
+{
+	double a, b;
+	int i;
+
+	a = 1.;
+	b = .1;
+	for(i = 155;; b *= b, i >>= 1) {
+		if (i & 1) {
+			a *= b;
+			if (i == 1)
+				break;
+			}
+		}
+	b = a * a;
+	return b == 0.;
+	}
+
+ static int
+need_nancheck()
+{
+	double t;
+
+	errno = 0;
+	t = log(t_nan);
+	if (errno == 0)
+		return 1;
+	errno = 0;
+	t = sqrt(t_nan);
+	return errno == 0;
+	}
+
+main()
+{
+	FILE *f;
+	Akind *a = 0;
+	int Ldef = 0;
+
+	fpinit_ASL();
+#ifdef WRITE_ARITH_H	/* for Symantec's buggy "make" */
+	f = fopen("arith.h", "w");
+	if (!f) {
+		printf("Cannot open arith.h\n");
+		return 1;
+		}
+#else
+	f = stdout;
+#endif
+
+	if (sizeof(double) == 2*sizeof(long))
+		a = Lcheck();
+	else if (sizeof(double) == 2*sizeof(int)) {
+		Ldef = 1;
+		a = icheck();
+		}
+	else if (sizeof(double) == sizeof(long))
+		a = ccheck();
+	if (a) {
+		fprintf(f, "#define %s\n#define Arith_Kind_ASL %d\n",
+			a->name, a->kind);
+		if (Ldef)
+			fprintf(f, "#define Long int\n#define Intcast (int)(long)\n");
+		if (dalign)
+			fprintf(f, "#define Double_Align\n");
+		if (sizeof(char*) == 8)
+			fprintf(f, "#define X64_bit_pointers\n");
+#ifndef NO_LONG_LONG
+		if (sizeof(long long) < 8)
+#endif
+			fprintf(f, "#define NO_LONG_LONG\n");
+		if (a->kind <= 2) {
+			if (fzcheck())
+				fprintf(f, "#define Sudden_Underflow\n");
+			t_nan = -a->kind;
+			if (need_nancheck())
+				fprintf(f, "#define NANCHECK\n");
+			}
+		return 0;
+		}
+	fprintf(f, "/* Unknown arithmetic */\n");
+	return 1;
+	}
+
+#ifdef __sun
+#ifdef __i386
+/* kludge for Intel Solaris */
+void fpsetprec(int x) { }
+#endif
+#endif

ext/f2c_libs/backspac.c

@@ -0,0 +1,76 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef KR_headers
+integer f_back(a) alist *a;
+#else
+integer f_back(alist *a)
+#endif
+{	unit *b;
+	OFF_T v, w, x, y, z;
+	uiolen n;
+	FILE *f;
+
+	f__curunit = b = &f__units[a->aunit];	/* curunit for error messages */
+	if(a->aunit >= MXUNIT || a->aunit < 0)
+		err(a->aerr,101,"backspace")
+	if(b->useek==0) err(a->aerr,106,"backspace")
+	if(b->ufd == NULL) {
+		fk_open(1, 1, a->aunit);
+		return(0);
+		}
+	if(b->uend==1)
+	{	b->uend=0;
+		return(0);
+	}
+	if(b->uwrt) {
+		t_runc(a);
+		if (f__nowreading(b))
+			err(a->aerr,errno,"backspace")
+		}
+	f = b->ufd;	/* may have changed in t_runc() */
+	if(b->url>0)
+	{
+		x=FTELL(f);
+		y = x % b->url;
+		if(y == 0) x--;
+		x /= b->url;
+		x *= b->url;
+		(void) FSEEK(f,x,SEEK_SET);
+		return(0);
+	}
+
+	if(b->ufmt==0)
+	{	FSEEK(f,-(OFF_T)sizeof(uiolen),SEEK_CUR);
+		fread((char *)&n,sizeof(uiolen),1,f);
+		FSEEK(f,-(OFF_T)n-2*sizeof(uiolen),SEEK_CUR);
+		return(0);
+	}
+	w = x = FTELL(f);
+	z = 0;
+ loop:
+	while(x) {
+		x -= x < 64 ? x : 64;
+		FSEEK(f,x,SEEK_SET);
+		for(y = x; y < w; y++) {
+			if (getc(f) != '\n')
+				continue;
+			v = FTELL(f);
+			if (v == w) {
+				if (z)
+					goto break2;
+				goto loop;
+				}
+			z = v;
+			}
+		err(a->aerr,(EOF),"backspace")
+		}
+ break2:
+	FSEEK(f, z, SEEK_SET);
+	return 0;
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_abs.c

@@ -0,0 +1,20 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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 ) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_cos.c

@@ -0,0 +1,23 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void c_cos(complex *r, complex *z)
+#endif
+{
+	double zi = z->i, zr = z->r;
+	r->r =   cos(zr) * cosh(zi);
+	r->i = - sin(zr) * sinh(zi);
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_div.c

@@ -0,0 +1,53 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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, cr;
+
+	if( (abr = b->r) < 0.)
+		abr = - abr;
+	if( (abi = b->i) < 0.)
+		abi = - abi;
+	if( abr <= abi )
+		{
+		if(abi == 0) {
+#ifdef IEEE_COMPLEX_DIVIDE
+			float af, bf;
+			af = bf = abr;
+			if (a->i != 0 || a->r != 0)
+				af = 1.;
+			c->i = c->r = af / bf;
+			return;
+#else
+			sig_die("complex division by zero", 1);
+#endif
+			}
+		ratio = (double)b->r / b->i ;
+		den = b->i * (1 + ratio*ratio);
+		cr = (a->r*ratio + a->i) / den;
+		c->i = (a->i*ratio - a->r) / den;
+		}
+
+	else
+		{
+		ratio = (double)b->i / b->r ;
+		den = b->r * (1 + ratio*ratio);
+		cr = (a->r + a->i*ratio) / den;
+		c->i = (a->i - a->r*ratio) / den;
+		}
+	c->r = cr;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_exp.c

@@ -0,0 +1,25 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void c_exp(complex *r, complex *z)
+#endif
+{
+	double expx, zi = z->i;
+
+	expx = exp(z->r);
+	r->r = expx * cos(zi);
+	r->i = expx * sin(zi);
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_log.c

@@ -0,0 +1,23 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern double f__cabs(double, double);
+
+void c_log(complex *r, complex *z)
+#endif
+{
+	double zi, zr;
+	r->i = atan2(zi = z->i, zr = z->r);
+	r->r = log( f__cabs(zr, zi) );
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_sin.c

@@ -0,0 +1,23 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void c_sin(complex *r, complex *z)
+#endif
+{
+	double zi = z->i, zr = z->r;
+	r->r = sin(zr) * cosh(zi);
+	r->i = cos(zr) * sinh(zi);
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/c_sqrt.c

@@ -0,0 +1,41 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern double f__cabs(double, double);
+
+void c_sqrt(complex *r, complex *z)
+#endif
+{
+	double mag, t;
+	double zi = z->i, zr = z->r;
+
+	if( (mag = f__cabs(zr, zi)) == 0.)
+		r->r = r->i = 0.;
+	else if(zr > 0)
+		{
+		r->r = t = sqrt(0.5 * (mag + zr) );
+		t = zi / t;
+		r->i = 0.5 * t;
+		}
+	else
+		{
+		t = sqrt(0.5 * (mag - zr) );
+		if(zi < 0)
+			t = -t;
+		r->i = t;
+		t = zi / t;
+		r->r = 0.5 * t;
+		}
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/cabs.c

@@ -0,0 +1,33 @@
+#ifdef KR_headers
+extern double sqrt();
+double f__cabs(real, imag) double real, imag;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/close.c

@@ -0,0 +1,101 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_clos(a) cllist *a;
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#ifdef NON_UNIX_STDIO
+#ifndef unlink
+#define unlink remove
+#endif
+#else
+#ifdef MSDOS
+#include "io.h"
+#else
+#ifdef __cplusplus
+extern "C" int unlink(const char*);
+#else
+extern int unlink(const char*);
+#endif
+#endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+integer f_clos(cllist *a)
+#endif
+{	unit *b;
+
+	if(a->cunit >= MXUNIT) return(0);
+	b= &f__units[a->cunit];
+	if(b->ufd==NULL)
+		goto done;
+	if (b->uscrtch == 1)
+		goto Delete;
+	if (!a->csta)
+		goto Keep;
+	switch(*a->csta) {
+		default:
+	 	Keep:
+		case 'k':
+		case 'K':
+			if(b->uwrt == 1)
+				t_runc((alist *)a);
+			if(b->ufnm) {
+				fclose(b->ufd);
+				free(b->ufnm);
+				}
+			break;
+		case 'd':
+		case 'D':
+		Delete:
+			fclose(b->ufd);
+			if(b->ufnm) {
+				unlink(b->ufnm); /*SYSDEP*/
+				free(b->ufnm);
+				}
+		}
+	b->ufd=NULL;
+ done:
+	b->uend=0;
+	b->ufnm=NULL;
+	return(0);
+	}
+ void
+#ifdef KR_headers
+f_exit()
+#else
+f_exit(void)
+#endif
+{	int i;
+	static cllist xx;
+	if (!xx.cerr) {
+		xx.cerr=1;
+		xx.csta=NULL;
+		for(i=0;i<MXUNIT;i++)
+		{
+			xx.cunit=i;
+			(void) f_clos(&xx);
+		}
+	}
+}
+ int
+#ifdef KR_headers
+flush_()
+#else
+flush_(void)
+#endif
+{	int i;
+	for(i=0;i<MXUNIT;i++)
+		if(f__units[i].ufd != NULL && f__units[i].uwrt)
+			fflush(f__units[i].ufd);
+return 0;
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_abs.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double d_abs(x) doublereal *x;
+#else
+double d_abs(doublereal *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_acos.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double acos();
+double d_acos(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_acos(doublereal *x)
+#endif
+{
+return( acos(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_asin.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double asin();
+double d_asin(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_asin(doublereal *x)
+#endif
+{
+return( asin(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_atan.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan();
+double d_atan(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_atan(doublereal *x)
+#endif
+{
+return( atan(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_atn2.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan2();
+double d_atn2(x,y) doublereal *x, *y;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_atn2(doublereal *x, doublereal *y)
+#endif
+{
+return( atan2(*x,*y) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_cnjg.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ VOID
+#ifdef KR_headers
+d_cnjg(r, z) doublecomplex *r, *z;
+#else
+d_cnjg(doublecomplex *r, doublecomplex *z)
+#endif
+{
+	doublereal zi = z->i;
+	r->r = z->r;
+	r->i = -zi;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_cos.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cos();
+double d_cos(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_cos(doublereal *x)
+#endif
+{
+return( cos(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_cosh.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cosh();
+double d_cosh(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_cosh(doublereal *x)
+#endif
+{
+return( cosh(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_dim.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_exp.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double exp();
+double d_exp(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_exp(doublereal *x)
+#endif
+{
+return( exp(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_imag.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double d_imag(z) doublecomplex *z;
+#else
+double d_imag(doublecomplex *z)
+#endif
+{
+return(z->i);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_int.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double d_int(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_int(doublereal *x)
+#endif
+{
+return( (*x>0) ? floor(*x) : -floor(- *x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_lg10.c

@@ -0,0 +1,21 @@
+#include "f2c.h"
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double d_lg10(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_lg10(doublereal *x)
+#endif
+{
+return( log10e * log(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_log.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double log();
+double d_log(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_log(doublereal *x)
+#endif
+{
+return( log(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_mod.c

@@ -0,0 +1,46 @@
+#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"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#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
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_nint.c

@@ -0,0 +1,20 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double d_nint(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_nint(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_prod.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double d_prod(x,y) real *x, *y;
+#else
+double d_prod(real *x, real *y)
+#endif
+{
+return( (*x) * (*y) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_sign.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_sin.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sin();
+double d_sin(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_sin(doublereal *x)
+#endif
+{
+return( sin(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_sinh.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sinh();
+double d_sinh(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_sinh(doublereal *x)
+#endif
+{
+return( sinh(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_sqrt.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sqrt();
+double d_sqrt(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_sqrt(doublereal *x)
+#endif
+{
+return( sqrt(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_tan.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tan();
+double d_tan(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_tan(doublereal *x)
+#endif
+{
+return( tan(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/d_tanh.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tanh();
+double d_tanh(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_tanh(doublereal *x)
+#endif
+{
+return( tanh(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/derf_.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double erf();
+double derf_(x) doublereal *x;
+#else
+extern double erf(double);
+double derf_(doublereal *x)
+#endif
+{
+return( erf(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/derfc_.c

@@ -0,0 +1,20 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+extern double erfc();
+
+double derfc_(x) doublereal *x;
+#else
+extern double erfc(double);
+
+double derfc_(doublereal *x)
+#endif
+{
+return( erfc(*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/dfe.c

@@ -0,0 +1,151 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ int
+y_rsk(Void)
+{
+	if(f__curunit->uend || f__curunit->url <= f__recpos
+		|| f__curunit->url == 1) return 0;
+	do {
+		getc(f__cf);
+	} while(++f__recpos < f__curunit->url);
+	return 0;
+}
+
+ int
+y_getc(Void)
+{
+	int ch;
+	if(f__curunit->uend) return(-1);
+	if((ch=getc(f__cf))!=EOF)
+	{
+		f__recpos++;
+		if(f__curunit->url>=f__recpos ||
+			f__curunit->url==1)
+			return(ch);
+		else	return(' ');
+	}
+	if(feof(f__cf))
+	{
+		f__curunit->uend=1;
+		errno=0;
+		return(-1);
+	}
+	err(f__elist->cierr,errno,"readingd");
+}
+
+ static int
+y_rev(Void)
+{
+	if (f__recpos < f__hiwater)
+		f__recpos = f__hiwater;
+	if (f__curunit->url > 1)
+		while(f__recpos < f__curunit->url)
+			(*f__putn)(' ');
+	if (f__recpos)
+		f__putbuf(0);
+	f__recpos = 0;
+	return(0);
+}
+
+ static int
+y_err(Void)
+{
+	err(f__elist->cierr, 110, "dfe");
+}
+
+ static int
+y_newrec(Void)
+{
+	y_rev();
+	f__hiwater = f__cursor = 0;
+	return(1);
+}
+
+ int
+#ifdef KR_headers
+c_dfe(a) cilist *a;
+#else
+c_dfe(cilist *a)
+#endif
+{
+	f__sequential=0;
+	f__formatted=f__external=1;
+	f__elist=a;
+	f__cursor=f__scale=f__recpos=0;
+	f__curunit = &f__units[a->ciunit];
+	if(a->ciunit>MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"startchk");
+	if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
+		err(a->cierr,104,"dfe");
+	f__cf=f__curunit->ufd;
+	if(!f__curunit->ufmt) err(a->cierr,102,"dfe")
+	if(!f__curunit->useek) err(a->cierr,104,"dfe")
+	f__fmtbuf=a->cifmt;
+	if(a->cirec <= 0)
+		err(a->cierr,130,"dfe")
+	FSEEK(f__cf,(OFF_T)f__curunit->url * (a->cirec-1),SEEK_SET);
+	f__curunit->uend = 0;
+	return(0);
+}
+#ifdef KR_headers
+integer s_rdfe(a) cilist *a;
+#else
+integer s_rdfe(cilist *a)
+#endif
+{
+	int n;
+	if(!f__init) f_init();
+	f__reading=1;
+	if(n=c_dfe(a))return(n);
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	f__getn = y_getc;
+	f__doed = rd_ed;
+	f__doned = rd_ned;
+	f__dorevert = f__donewrec = y_err;
+	f__doend = y_rsk;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->cierr,100,"read start");
+	fmt_bg();
+	return(0);
+}
+#ifdef KR_headers
+integer s_wdfe(a) cilist *a;
+#else
+integer s_wdfe(cilist *a)
+#endif
+{
+	int n;
+	if(!f__init) f_init();
+	f__reading=0;
+	if(n=c_dfe(a)) return(n);
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr,errno,"startwrt");
+	f__putn = x_putc;
+	f__doed = w_ed;
+	f__doned= w_ned;
+	f__dorevert = y_err;
+	f__donewrec = y_newrec;
+	f__doend = y_rev;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->cierr,100,"startwrt");
+	fmt_bg();
+	return(0);
+}
+integer e_rdfe(Void)
+{
+	en_fio();
+	return 0;
+}
+integer e_wdfe(Void)
+{
+	return en_fio();
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/dolio.c

@@ -0,0 +1,26 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef KR_headers
+extern int (*f__lioproc)();
+
+integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len;
+#else
+extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint);
+
+integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len)
+#endif
+{
+	return((*f__lioproc)(number,ptr,len,*type));
+}
+#ifdef __cplusplus
+	}
+#endif
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/dtime_.c

@@ -0,0 +1,63 @@
+#include "time.h"
+
+#ifdef MSDOS
+#undef USE_CLOCK
+#define USE_CLOCK
+#endif
+
+#ifndef REAL
+#define REAL double
+#endif
+
+#ifndef USE_CLOCK
+#define _INCLUDE_POSIX_SOURCE	/* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE	/* for HP-UX */
+#include "sys/types.h"
+#include "sys/times.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+#undef Hz
+#ifdef CLK_TCK
+#define Hz CLK_TCK
+#else
+#ifdef HZ
+#define Hz HZ
+#else
+#define Hz 60
+#endif
+#endif
+
+ REAL
+#ifdef KR_headers
+dtime_(tarray) float *tarray;
+#else
+dtime_(float *tarray)
+#endif
+{
+#ifdef USE_CLOCK
+#ifndef CLOCKS_PER_SECOND
+#define CLOCKS_PER_SECOND Hz
+#endif
+	static double t0;
+	double t = clock();
+	tarray[1] = 0;
+	tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
+	t0 = t;
+	return tarray[0];
+#else
+	struct tms t;
+	static struct tms t0;
+
+	times(&t);
+	tarray[0] = (double)(t.tms_utime - t0.tms_utime) / Hz;
+	tarray[1] = (double)(t.tms_stime - t0.tms_stime) / Hz;
+	t0 = t;
+	return tarray[0] + tarray[1];
+#endif
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/due.c

@@ -0,0 +1,77 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ int
+#ifdef KR_headers
+c_due(a) cilist *a;
+#else
+c_due(cilist *a)
+#endif
+{
+	if(!f__init) f_init();
+	f__sequential=f__formatted=f__recpos=0;
+	f__external=1;
+	f__curunit = &f__units[a->ciunit];
+	if(a->ciunit>=MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"startio");
+	f__elist=a;
+	if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
+	f__cf=f__curunit->ufd;
+	if(f__curunit->ufmt) err(a->cierr,102,"cdue")
+	if(!f__curunit->useek) err(a->cierr,104,"cdue")
+	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")
+	if(a->cirec <= 0)
+		err(a->cierr,130,"due")
+	FSEEK(f__cf,(OFF_T)(a->cirec-1)*f__curunit->url,SEEK_SET);
+	f__curunit->uend = 0;
+	return(0);
+}
+#ifdef KR_headers
+integer s_rdue(a) cilist *a;
+#else
+integer s_rdue(cilist *a)
+#endif
+{
+	int n;
+	f__reading=1;
+	if(n=c_due(a)) return(n);
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	return(0);
+}
+#ifdef KR_headers
+integer s_wdue(a) cilist *a;
+#else
+integer s_wdue(cilist *a)
+#endif
+{
+	int n;
+	f__reading=0;
+	if(n=c_due(a)) return(n);
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr,errno,"write start");
+	return(0);
+}
+integer e_rdue(Void)
+{
+	if(f__curunit->url==1 || f__recpos==f__curunit->url)
+		return(0);
+	FSEEK(f__cf,(OFF_T)(f__curunit->url-f__recpos),SEEK_CUR);
+	if(FTELL(f__cf)%f__curunit->url)
+		err(f__elist->cierr,200,"syserr");
+	return(0);
+}
+integer e_wdue(Void)
+{
+#ifdef ALWAYS_FLUSH
+	if (fflush(f__cf))
+		err(f__elist->cierr,errno,"write end");
+#endif
+	return(e_rdue());
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/ef1asc_.c

@@ -0,0 +1,25 @@
+/* EFL support routine to copy string b to string a */
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#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 );
+return 0;	/* ignored return value */
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/ef1cmc_.c

@@ -0,0 +1,20 @@
+/* EFL support routine to compare two character strings */
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/endfile.c

@@ -0,0 +1,160 @@
+#include "f2c.h"
+#include "fio.h"
+
+/* Compile this with -DNO_TRUNCATE if unistd.h does not exist or */
+/* if it does not define int truncate(const char *name, off_t). */
+
+#ifdef MSDOS
+#undef NO_TRUNCATE
+#define NO_TRUNCATE
+#endif
+
+#ifndef NO_TRUNCATE
+#include "unistd.h"
+#endif
+
+#ifdef KR_headers
+extern char *strcpy();
+extern FILE *tmpfile();
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#include "string.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+extern char *f__r_mode[], *f__w_mode[];
+
+#ifdef KR_headers
+integer f_end(a) alist *a;
+#else
+integer f_end(alist *a)
+#endif
+{
+	unit *b;
+	FILE *tf;
+
+	if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
+	b = &f__units[a->aunit];
+	if(b->ufd==NULL) {
+		char nbuf[10];
+		sprintf(nbuf,"fort.%ld",(long)a->aunit);
+		if (tf = FOPEN(nbuf, f__w_mode[0]))
+			fclose(tf);
+		return(0);
+		}
+	b->uend=1;
+	return(b->useek ? t_runc(a) : 0);
+}
+
+#ifdef NO_TRUNCATE
+ static int
+#ifdef KR_headers
+copy(from, len, to) FILE *from, *to; register long len;
+#else
+copy(FILE *from, register long len, FILE *to)
+#endif
+{
+	int len1;
+	char buf[BUFSIZ];
+
+	while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
+		if (!fwrite(buf, len1, 1, to))
+			return 1;
+		if ((len -= len1) <= 0)
+			break;
+		}
+	return 0;
+	}
+#endif /* NO_TRUNCATE */
+
+ int
+#ifdef KR_headers
+t_runc(a) alist *a;
+#else
+t_runc(alist *a)
+#endif
+{
+	OFF_T loc, len;
+	unit *b;
+	int rc;
+	FILE *bf;
+#ifdef NO_TRUNCATE
+	FILE *tf;
+#endif
+
+	b = &f__units[a->aunit];
+	if(b->url)
+		return(0);	/*don't truncate direct files*/
+	loc=FTELL(bf = b->ufd);
+	FSEEK(bf,(OFF_T)0,SEEK_END);
+	len=FTELL(bf);
+	if (loc >= len || b->useek == 0)
+		return(0);
+#ifdef NO_TRUNCATE
+	if (b->ufnm == NULL)
+		return 0;
+	rc = 0;
+	fclose(b->ufd);
+	if (!loc) {
+		if (!(bf = FOPEN(b->ufnm, f__w_mode[b->ufmt])))
+			rc = 1;
+		if (b->uwrt)
+			b->uwrt = 1;
+		goto done;
+		}
+	if (!(bf = FOPEN(b->ufnm, f__r_mode[0]))
+	 || !(tf = tmpfile())) {
+#ifdef NON_UNIX_STDIO
+ bad:
+#endif
+		rc = 1;
+		goto done;
+		}
+	if (copy(bf, (long)loc, tf)) {
+ bad1:
+		rc = 1;
+		goto done1;
+		}
+	if (!(bf = FREOPEN(b->ufnm, f__w_mode[0], bf)))
+		goto bad1;
+	rewind(tf);
+	if (copy(tf, (long)loc, bf))
+		goto bad1;
+	b->uwrt = 1;
+	b->urw = 2;
+#ifdef NON_UNIX_STDIO
+	if (b->ufmt) {
+		fclose(bf);
+		if (!(bf = FOPEN(b->ufnm, f__w_mode[3])))
+			goto bad;
+		FSEEK(bf,(OFF_T)0,SEEK_END);
+		b->urw = 3;
+		}
+#endif
+done1:
+	fclose(tf);
+done:
+	f__cf = b->ufd = bf;
+#else /* NO_TRUNCATE */
+	if (b->urw & 2)
+		fflush(b->ufd); /* necessary on some Linux systems */
+#ifndef FTRUNCATE
+#define FTRUNCATE ftruncate
+#endif
+	rc = FTRUNCATE(fileno(b->ufd), loc);
+	/* The following FSEEK is unnecessary on some systems, */
+	/* but should be harmless. */
+	FSEEK(b->ufd, (OFF_T)0, SEEK_END);
+#endif /* NO_TRUNCATE */
+	if (rc)
+		err(a->aerr,111,"endfile");
+	return 0;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/erf_.c

@@ -0,0 +1,22 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef REAL
+#define REAL double
+#endif
+
+#ifdef KR_headers
+double erf();
+REAL erf_(x) real *x;
+#else
+extern double erf(double);
+REAL erf_(real *x)
+#endif
+{
+return( erf((double)*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/erfc_.c

@@ -0,0 +1,22 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef REAL
+#define REAL double
+#endif
+
+#ifdef KR_headers
+double erfc();
+REAL erfc_(x) real *x;
+#else
+extern double erfc(double);
+REAL erfc_(real *x)
+#endif
+{
+return( erfc((double)*x) );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/err.c

@@ -0,0 +1,282 @@
+#include "sysdep1.h"	/* here to get stat64 on some badly designed Linux systems */
+#include "f2c.h"
+#ifdef KR_headers
+extern char *malloc();
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#endif
+#include "fio.h"
+#include "fmt.h"	/* for struct syl */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*global definitions*/
+unit f__units[MXUNIT];	/*unit table*/
+flag f__init;	/*0 on entry, 1 after initializations*/
+cilist *f__elist;	/*active external io list*/
+icilist *f__svic;	/*active internal io list*/
+flag f__reading;	/*1 if reading, 0 if writing*/
+flag f__cplus,f__cblank;
+char *f__fmtbuf;
+flag f__external;	/*1 if external io, 0 if internal */
+#ifdef KR_headers
+int (*f__doed)(),(*f__doned)();
+int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
+int (*f__getn)();	/* for formatted input */
+void (*f__putn)();	/* for formatted output */
+#else
+int (*f__getn)(void);	/* for formatted input */
+void (*f__putn)(int);	/* for formatted output */
+int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
+#endif
+flag f__sequential;	/*1 if sequential io, 0 if direct*/
+flag f__formatted;	/*1 if formatted io, 0 if unformatted*/
+FILE *f__cf;	/*current file*/
+unit *f__curunit;	/*current unit*/
+int f__recpos;	/*place in current record*/
+OFF_T f__cursor, f__hiwater;
+int f__scale;
+char *f__icptr;
+
+/*error messages*/
+char *F_err[] =
+{
+	"error in format",				/* 100 */
+	"illegal unit number",				/* 101 */
+	"formatted io not allowed",			/* 102 */
+	"unformatted io not allowed",			/* 103 */
+	"direct io not allowed",			/* 104 */
+	"sequential io not allowed",			/* 105 */
+	"can't backspace file",				/* 106 */
+	"null file name",				/* 107 */
+	"can't stat file",				/* 108 */
+	"unit not connected",				/* 109 */
+	"off end of record",				/* 110 */
+	"truncation failed in endfile",			/* 111 */
+	"incomprehensible list input",			/* 112 */
+	"out of free space",				/* 113 */
+	"unit not connected",				/* 114 */
+	"read unexpected character",			/* 115 */
+	"bad logical input field",			/* 116 */
+	"bad variable type",				/* 117 */
+	"bad namelist name",				/* 118 */
+	"variable not in namelist",			/* 119 */
+	"no end record",				/* 120 */
+	"variable count incorrect",			/* 121 */
+	"subscript for scalar variable",		/* 122 */
+	"invalid array section",			/* 123 */
+	"substring out of bounds",			/* 124 */
+	"subscript out of bounds",			/* 125 */
+	"can't read file",				/* 126 */
+	"can't write file",				/* 127 */
+	"'new' file exists",				/* 128 */
+	"can't append to file",				/* 129 */
+	"non-positive record number",			/* 130 */
+	"nmLbuf overflow"				/* 131 */
+};
+#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
+
+ int
+#ifdef KR_headers
+f__canseek(f) FILE *f; /*SYSDEP*/
+#else
+f__canseek(FILE *f) /*SYSDEP*/
+#endif
+{
+#ifdef NON_UNIX_STDIO
+	return !isatty(fileno(f));
+#else
+	struct STAT_ST x;
+
+	if (FSTAT(fileno(f),&x) < 0)
+		return(0);
+#ifdef S_IFMT
+	switch(x.st_mode & S_IFMT) {
+	case S_IFDIR:
+	case S_IFREG:
+		if(x.st_nlink > 0)	/* !pipe */
+			return(1);
+		else
+			return(0);
+	case S_IFCHR:
+		if(isatty(fileno(f)))
+			return(0);
+		return(1);
+#ifdef S_IFBLK
+	case S_IFBLK:
+		return(1);
+#endif
+	}
+#else
+#ifdef S_ISDIR
+	/* POSIX version */
+	if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
+		if(x.st_nlink > 0)	/* !pipe */
+			return(1);
+		else
+			return(0);
+		}
+	if (S_ISCHR(x.st_mode)) {
+		if(isatty(fileno(f)))
+			return(0);
+		return(1);
+		}
+	if (S_ISBLK(x.st_mode))
+		return(1);
+#else
+	Help! How does fstat work on this system?
+#endif
+#endif
+	return(0);	/* who knows what it is? */
+#endif
+}
+
+ void
+#ifdef KR_headers
+f__fatal(n,s) char *s;
+#else
+f__fatal(int n, char *s)
+#endif
+{
+	if(n<100 && n>=0) perror(s); /*SYSDEP*/
+	else if(n >= (int)MAXERR || n < -1)
+	{	fprintf(stderr,"%s: illegal error number %d\n",s,n);
+	}
+	else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
+	else
+		fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
+	if (f__curunit) {
+		fprintf(stderr,"apparent state: unit %d ",
+			(int)(f__curunit-f__units));
+		fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
+			f__curunit->ufnm);
+		}
+	else
+		fprintf(stderr,"apparent state: internal I/O\n");
+	if (f__fmtbuf)
+		fprintf(stderr,"last format: %s\n",f__fmtbuf);
+	fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
+		f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
+		f__external?"external":"internal");
+	sig_die(" IO", 1);
+}
+/*initialization routine*/
+ VOID
+f_init(Void)
+{	unit *p;
+
+	f__init=1;
+	p= &f__units[0];
+	p->ufd=stderr;
+	p->useek=f__canseek(stderr);
+	p->ufmt=1;
+	p->uwrt=1;
+	p = &f__units[5];
+	p->ufd=stdin;
+	p->useek=f__canseek(stdin);
+	p->ufmt=1;
+	p->uwrt=0;
+	p= &f__units[6];
+	p->ufd=stdout;
+	p->useek=f__canseek(stdout);
+	p->ufmt=1;
+	p->uwrt=1;
+}
+
+ int
+#ifdef KR_headers
+f__nowreading(x) unit *x;
+#else
+f__nowreading(unit *x)
+#endif
+{
+	OFF_T loc;
+	int ufmt, urw;
+	extern char *f__r_mode[], *f__w_mode[];
+
+	if (x->urw & 1)
+		goto done;
+	if (!x->ufnm)
+		goto cantread;
+	ufmt = x->url ? 0 : x->ufmt;
+	loc = FTELL(x->ufd);
+	urw = 3;
+	if (!FREOPEN(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
+		urw = 1;
+		if(!FREOPEN(x->ufnm, f__r_mode[ufmt], x->ufd)) {
+ cantread:
+			errno = 126;
+			return 1;
+			}
+		}
+	FSEEK(x->ufd,loc,SEEK_SET);
+	x->urw = urw;
+ done:
+	x->uwrt = 0;
+	return 0;
+}
+
+ int
+#ifdef KR_headers
+f__nowwriting(x) unit *x;
+#else
+f__nowwriting(unit *x)
+#endif
+{
+	OFF_T loc;
+	int ufmt;
+	extern char *f__w_mode[];
+
+	if (x->urw & 2) {
+		if (x->urw & 1)
+			FSEEK(x->ufd, (OFF_T)0, SEEK_CUR);
+		goto done;
+		}
+	if (!x->ufnm)
+		goto cantwrite;
+	ufmt = x->url ? 0 : x->ufmt;
+	if (x->uwrt == 3) { /* just did write, rewind */
+		if (!(f__cf = x->ufd =
+				FREOPEN(x->ufnm,f__w_mode[ufmt],x->ufd)))
+			goto cantwrite;
+		x->urw = 2;
+		}
+	else {
+		loc=FTELL(x->ufd);
+		if (!(f__cf = x->ufd =
+			FREOPEN(x->ufnm, f__w_mode[ufmt | 2], x->ufd)))
+			{
+			x->ufd = NULL;
+ cantwrite:
+			errno = 127;
+			return(1);
+			}
+		x->urw = 3;
+		FSEEK(x->ufd,loc,SEEK_SET);
+		}
+ done:
+	x->uwrt = 1;
+	return 0;
+}
+
+ int
+#ifdef KR_headers
+err__fl(f, m, s) int f, m; char *s;
+#else
+err__fl(int f, int m, char *s)
+#endif
+{
+	if (!f)
+		f__fatal(m, s);
+	if (f__doend)
+		(*f__doend)();
+	return errno = m;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/etime_.c

@@ -0,0 +1,57 @@
+#include "time.h"
+
+#ifdef MSDOS
+#undef USE_CLOCK
+#define USE_CLOCK
+#endif
+
+#ifndef REAL
+#define REAL double
+#endif
+
+#ifndef USE_CLOCK
+#define _INCLUDE_POSIX_SOURCE	/* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE	/* for HP-UX */
+#include "sys/types.h"
+#include "sys/times.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+#undef Hz
+#ifdef CLK_TCK
+#define Hz CLK_TCK
+#else
+#ifdef HZ
+#define Hz HZ
+#else
+#define Hz 60
+#endif
+#endif
+
+ REAL
+#ifdef KR_headers
+etime_(tarray) float *tarray;
+#else
+etime_(float *tarray)
+#endif
+{
+#ifdef USE_CLOCK
+#ifndef CLOCKS_PER_SECOND
+#define CLOCKS_PER_SECOND Hz
+#endif
+	double t = clock();
+	tarray[1] = 0;
+	return tarray[0] = t / CLOCKS_PER_SECOND;
+#else
+	struct tms t;
+
+	times(&t);
+	return	  (tarray[0] = (double)t.tms_utime/Hz)
+		+ (tarray[1] = (double)t.tms_stime/Hz);
+#endif
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/exit_.c

@@ -0,0 +1,43 @@
+/* This gives the effect of
+
+	subroutine exit(rc)
+	integer*4 rc
+	stop
+	end
+
+ * with the added side effect of supplying rc as the program's exit code.
+ */
+
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#ifndef KR_headers
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void f_exit(void);
+#endif
+
+ void
+#ifdef KR_headers
+exit_(rc) integer *rc;
+#else
+exit_(integer *rc)
+#endif
+{
+#ifdef NO_ONEXIT
+	f_exit();
+#endif
+	exit(*rc);
+	}
+#ifdef __cplusplus
+}
+#endif
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/f2c.h

@@ -0,0 +1,385 @@
+/* f2c.h  --  Standard Fortran to C header file */
+
+/**  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
+
+	- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef long int integer;
+typedef unsigned long int uinteger;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef long int logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+#ifdef INTEGER_STAR_8	/* Adjust for integer*8. */
+typedef long long longint;		/* system-dependent */
+typedef unsigned long long ulongint;	/* system-dependent */
+#define qbit_clear(a,b)	((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b)	((a) |  ((ulongint)1 << (b)))
+#endif
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef long int flag;
+typedef long int ftnlen;
+typedef long int ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{	flag cierr;
+	ftnint ciunit;
+	flag ciend;
+	char *cifmt;
+	ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{	flag icierr;
+	char *iciunit;
+	flag iciend;
+	char *icifmt;
+	ftnint icirlen;
+	ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{	flag oerr;
+	ftnint ounit;
+	char *ofnm;
+	ftnlen ofnmlen;
+	char *osta;
+	char *oacc;
+	char *ofm;
+	ftnint orl;
+	char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{	flag cerr;
+	ftnint cunit;
+	char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{	flag aerr;
+	ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{	flag inerr;
+	ftnint inunit;
+	char *infile;
+	ftnlen infilen;
+	ftnint	*inex;	/*parameters in standard's order*/
+	ftnint	*inopen;
+	ftnint	*innum;
+	ftnint	*innamed;
+	char	*inname;
+	ftnlen	innamlen;
+	char	*inacc;
+	ftnlen	inacclen;
+	char	*inseq;
+	ftnlen	inseqlen;
+	char 	*indir;
+	ftnlen	indirlen;
+	char	*infmt;
+	ftnlen	infmtlen;
+	char	*inform;
+	ftnint	informlen;
+	char	*inunf;
+	ftnlen	inunflen;
+	ftnint	*inrecl;
+	ftnint	*innrec;
+	char	*inblank;
+	ftnlen	inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype {	/* for multiple entry points */
+	integer1 g;
+	shortint h;
+	integer i;
+	/* longint j; */
+	real r;
+	doublereal d;
+	complex c;
+	doublecomplex z;
+	};
+
+typedef union Multitype Multitype;
+
+/*typedef long int Long;*/	/* No longer used; formerly in Namelist */
+
+struct Vardesc {	/* for Namelist */
+	char *name;
+	char *addr;
+	ftnlen *dims;
+	int  type;
+	};
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+	char *name;
+	Vardesc **vars;
+	int nvars;
+	};
+typedef struct Namelist Namelist;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b)	((a) >> (b) & 1)
+#define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef int /* Unknown procedure type */ (*U_fp)();
+typedef shortint (*J_fp)();
+typedef integer (*I_fp)();
+typedef real (*R_fp)();
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef /* Complex */ VOID (*C_fp)();
+typedef /* Double Complex */ VOID (*Z_fp)();
+typedef logical (*L_fp)();
+typedef shortlogical (*K_fp)();
+typedef /* Character */ VOID (*H_fp)();
+typedef /* Subroutine */ int (*S_fp)();
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f;	/* complex function */
+typedef VOID H_f;	/* character function */
+typedef VOID Z_f;	/* double complex function */
+typedef doublereal E_f;	/* real function with -R not specified */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif
+/* 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 integer 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

ext/f2c_libs/f2c.h0

@@ -0,0 +1,223 @@
+/* f2c.h  --  Standard Fortran to C header file */
+
+/**  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
+
+	- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef long int integer;
+typedef unsigned long int uinteger;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef long int logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+#ifdef INTEGER_STAR_8	/* Adjust for integer*8. */
+typedef long long longint;		/* system-dependent */
+typedef unsigned long long ulongint;	/* system-dependent */
+#define qbit_clear(a,b)	((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b)	((a) |  ((ulongint)1 << (b)))
+#endif
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef long int flag;
+typedef long int ftnlen;
+typedef long int ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{	flag cierr;
+	ftnint ciunit;
+	flag ciend;
+	char *cifmt;
+	ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{	flag icierr;
+	char *iciunit;
+	flag iciend;
+	char *icifmt;
+	ftnint icirlen;
+	ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{	flag oerr;
+	ftnint ounit;
+	char *ofnm;
+	ftnlen ofnmlen;
+	char *osta;
+	char *oacc;
+	char *ofm;
+	ftnint orl;
+	char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{	flag cerr;
+	ftnint cunit;
+	char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{	flag aerr;
+	ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{	flag inerr;
+	ftnint inunit;
+	char *infile;
+	ftnlen infilen;
+	ftnint	*inex;	/*parameters in standard's order*/
+	ftnint	*inopen;
+	ftnint	*innum;
+	ftnint	*innamed;
+	char	*inname;
+	ftnlen	innamlen;
+	char	*inacc;
+	ftnlen	inacclen;
+	char	*inseq;
+	ftnlen	inseqlen;
+	char 	*indir;
+	ftnlen	indirlen;
+	char	*infmt;
+	ftnlen	infmtlen;
+	char	*inform;
+	ftnint	informlen;
+	char	*inunf;
+	ftnlen	inunflen;
+	ftnint	*inrecl;
+	ftnint	*innrec;
+	char	*inblank;
+	ftnlen	inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype {	/* for multiple entry points */
+	integer1 g;
+	shortint h;
+	integer i;
+	/* longint j; */
+	real r;
+	doublereal d;
+	complex c;
+	doublecomplex z;
+	};
+
+typedef union Multitype Multitype;
+
+/*typedef long int Long;*/	/* No longer used; formerly in Namelist */
+
+struct Vardesc {	/* for Namelist */
+	char *name;
+	char *addr;
+	ftnlen *dims;
+	int  type;
+	};
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+	char *name;
+	Vardesc **vars;
+	int nvars;
+	};
+typedef struct Namelist Namelist;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b)	((a) >> (b) & 1)
+#define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef int /* Unknown procedure type */ (*U_fp)();
+typedef shortint (*J_fp)();
+typedef integer (*I_fp)();
+typedef real (*R_fp)();
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef /* Complex */ VOID (*C_fp)();
+typedef /* Double Complex */ VOID (*Z_fp)();
+typedef logical (*L_fp)();
+typedef shortlogical (*K_fp)();
+typedef /* Character */ VOID (*H_fp)();
+typedef /* Subroutine */ int (*S_fp)();
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f;	/* complex function */
+typedef VOID H_f;	/* character function */
+typedef VOID Z_f;	/* double complex function */
+typedef doublereal E_f;	/* real function with -R not specified */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif

ext/f2c_libs/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 integer 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

ext/f2c_libs/f77_aloc.c

@@ -0,0 +1,44 @@
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#include "stdio.h"
+
+static integer memfailure = 3;
+
+#ifdef KR_headers
+extern char *malloc();
+extern void exit_();
+
+ char *
+F77_aloc(Len, whence) integer Len; char *whence;
+#else
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void exit_(integer*);
+#ifdef __cplusplus
+	}
+#endif
+
+ char *
+F77_aloc(integer Len, char *whence)
+#endif
+{
+	char *rv;
+	unsigned int uLen = (unsigned int) Len;	/* for K&R C */
+
+	if (!(rv = (char*)malloc(uLen))) {
+		fprintf(stderr, "malloc(%u) failure in %s\n",
+			uLen, whence);
+		exit_(&memfailure);
+		}
+	return rv;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/f77vers.c

@@ -0,0 +1,93 @@
+ char 
+_libf77_version_f2c[] = "\n@(#) LIBF77 VERSION (f2c) 20021004\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
+	12 Jan. 1995:	pow_[dhiqrz][hiq]: adjust x**i to work on machines
+			that sign-extend right shifts when i is the most
+			negative integer.
+	26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
+			of character assignments to appear on the right-hand
+			side (unless compiled with -DNO_OVERWRITE).
+	27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
+			possible (for better cache behavior).
+	30 May 1995:  added subroutine exit(rc) integer rc. Version not changed.
+	29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
+	6 Sept. 1995: fix return type of system_ under -DKR_headers.
+	19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
+	19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
+	13 May 1996:  add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
+	19 June 1996: add casts to unsigned in [lq]bitshft.c.
+	26 Feb. 1997: adjust functions with a complex output argument
+			to permit aliasing it with input arguments.
+			(For now, at least, this is just for possible
+			benefit of g77.)
+	4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
+			affect systems using gratuitous extra precision).
+	19 Sept. 1997: [de]time_.c (Unix systems only): change return
+			type to double.
+	2 May 1999:	getenv_.c: omit environ in favor of getenv().
+			c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c,
+			z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with
+			overlapping arguments caused by equivalence.
+	3 May 1999:	"invisible" tweaks to omit compiler warnings in
+			abort_.c, ef1asc_.c, s_rnge.c, s_stop.c.
+
+	7 Sept. 1999: [cz]_div.c: arrange for compilation under
+			-DIEEE_COMPLEX_DIVIDE to make these routines
+			avoid calling sig_die when the denominator
+			vanishes; instead, they return pairs of NaNs
+			or Infinities, depending whether the numerator
+			also vanishes or not.  VERSION not changed.
+	15 Nov. 1999: s_rnge.c: add casts for the case of
+			sizeof(ftnint) == sizeof(int) < sizeof(long).
+	10 March 2000: z_log.c: improve accuracy of Real(log(z)) for, e.g.,
+			z near (+-1,eps) with |eps| small.  For the old
+			evaluation, compile with -DPre20000310 .
+	20 April 2000: s_cat.c: tweak argument types to accord with
+			calls by f2c when ftnint and ftnlen are of
+			different sizes (different numbers of bits).
+	4 July 2000: adjustments to permit compilation by C++ compilers;
+			VERSION string remains unchanged.
+	29 Sept. 2000: dtime_.c, etime_.c: use floating-point divide.
+			dtime_.d, erf_.c, erfc_.c, etime.c: for use with
+			"f2c -R", compile with -DREAL=float.
+	23 June 2001: add uninit.c; [fi]77vers.c: make version strings
+			visible as extern char _lib[fi]77_version_f2c[].
+	5 July 2001: modify uninit.c for __mc68k__ under Linux.
+	16 Nov. 2001: uninit.c: Linux Power PC logic supplied by Alan Bain.
+	18 Jan. 2002: fix glitches in qbit_bits(): wrong return type,
+			missing ~ on y in return value.
+	14 March 2002: z_log.c: add code to cope with buggy compilers
+			(e.g., some versions of gcc under -O2 or -O3)
+			that do floating-point comparisons against values
+			computed into extended-precision registers on some
+			systems (such as Intel IA32 systems).  Compile with
+			-DNO_DOUBLE_EXTENDED to omit the new logic.
+	4 Oct. 2002: uninit.c: on IRIX systems, omit use of shell variables.
+*/

ext/f2c_libs/fio.h

@@ -0,0 +1,142 @@
+#ifndef SYSDEP_H_INCLUDED
+#include "sysdep1.h"
+#endif
+#include "stdio.h"
+#include "errno.h"
+#ifndef NULL
+/* ANSI C */
+#include "stddef.h"
+#endif
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+#ifndef FOPEN
+#define FOPEN fopen
+#endif
+
+#ifndef FREOPEN
+#define FREOPEN freopen
+#endif
+
+#ifndef FSEEK
+#define FSEEK fseek
+#endif
+
+#ifndef FSTAT
+#define FSTAT fstat
+#endif
+
+#ifndef FTELL
+#define FTELL ftell
+#endif
+
+#ifndef OFF_T
+#define OFF_T long
+#endif
+
+#ifndef STAT_ST
+#define STAT_ST stat
+#endif
+
+#ifndef STAT
+#define STAT stat
+#endif
+
+#ifdef MSDOS
+#ifndef NON_UNIX_STDIO
+#define NON_UNIX_STDIO
+#endif
+#endif
+
+#ifdef UIOLEN_int
+typedef int uiolen;
+#else
+typedef long uiolen;
+#endif
+
+/*units*/
+typedef struct
+{	FILE *ufd;	/*0=unconnected*/
+	char *ufnm;
+#ifndef MSDOS
+	long uinode;
+	int udev;
+#endif
+	int url;	/*0=sequential*/
+	flag useek;	/*true=can backspace, use dir, ...*/
+	flag ufmt;
+	flag urw;	/* (1 for can read) | (2 for can write) */
+	flag ublnk;
+	flag uend;
+	flag uwrt;	/*last io was write*/
+	flag uscrtch;
+} unit;
+
+extern flag f__init;
+extern cilist *f__elist;	/*active external io list*/
+extern flag f__reading,f__external,f__sequential,f__formatted;
+#undef Void
+#ifdef KR_headers
+#define Void /*void*/
+extern int (*f__getn)();	/* for formatted input */
+extern void (*f__putn)();	/* for formatted output */
+extern void x_putc();
+extern long f__inode();
+extern VOID sig_die();
+extern int (*f__donewrec)(), t_putc(), x_wSL();
+extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf();
+#else
+#define Void void
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__getn)(void);	/* for formatted input */
+extern void (*f__putn)(int);	/* for formatted output */
+extern void x_putc(int);
+extern long f__inode(char*,int*);
+extern void sig_die(char*,int);
+extern void f__fatal(int,char*);
+extern int t_runc(alist*);
+extern int f__nowreading(unit*), f__nowwriting(unit*);
+extern int fk_open(int,int,ftnint);
+extern int en_fio(void);
+extern void f_init(void);
+extern int (*f__donewrec)(void), t_putc(int), x_wSL(void);
+extern void b_char(char*,char*,ftnlen), g_char(char*,ftnlen,char*);
+extern int c_sfe(cilist*), z_rnew(void);
+extern int isatty(int);
+extern int err__fl(int,int,char*);
+extern int xrd_SL(void);
+extern int f__putbuf(int);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern int (*f__doend)(Void);
+extern FILE *f__cf;	/*current file*/
+extern unit *f__curunit;	/*current unit*/
+extern unit f__units[];
+#define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);}
+#define errfl(f,m,s) return err__fl((int)f,m,s)
+
+/*Table sizes*/
+#define MXUNIT 100
+
+extern int f__recpos;	/*position in current record*/
+extern OFF_T f__cursor;	/* offset to move to */
+extern OFF_T f__hiwater;	/* so TL doesn't confuse us */
+
+#define WRITE	1
+#define READ	2
+#define SEQ	3
+#define DIR	4
+#define FMT	5
+#define UNF	6
+#define EXT	7
+#define INT	8
+
+#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)

ext/f2c_libs/fmt.c

@@ -0,0 +1,525 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#define skip(s) while(*s==' ') s++
+#ifdef interdata
+#define SYLMX 300
+#endif
+#ifdef pdp11
+#define SYLMX 300
+#endif
+#ifdef vax
+#define SYLMX 300
+#endif
+#ifndef SYLMX
+#define SYLMX 300
+#endif
+#define GLITCH '\2'
+	/* special quote character for stu */
+extern flag f__cblank,f__cplus;	/*blanks in I and compulsory plus*/
+static struct syl f__syl[SYLMX];
+int f__parenlvl,f__pc,f__revloc;
+
+ static
+#ifdef KR_headers
+char *ap_end(s) char *s;
+#else
+char *ap_end(char *s)
+#endif
+{	char quote;
+	quote= *s++;
+	for(;*s;s++)
+	{	if(*s!=quote) continue;
+		if(*++s!=quote) return(s);
+	}
+	if(f__elist->cierr) {
+		errno = 100;
+		return(NULL);
+	}
+	f__fatal(100, "bad string");
+	/*NOTREACHED*/ return 0;
+}
+ static int
+#ifdef KR_headers
+op_gen(a,b,c,d)
+#else
+op_gen(int a, int b, int c, int d)
+#endif
+{	struct syl *p= &f__syl[f__pc];
+	if(f__pc>=SYLMX)
+	{	fprintf(stderr,"format too complicated:\n");
+		sig_die(f__fmtbuf, 1);
+	}
+	p->op=a;
+	p->p1=b;
+	p->p2.i[0]=c;
+	p->p2.i[1]=d;
+	return(f__pc++);
+}
+#ifdef KR_headers
+static char *f_list();
+static char *gt_num(s,n,n1) char *s; int *n, n1;
+#else
+static char *f_list(char*);
+static char *gt_num(char *s, int *n, int n1)
+#endif
+{	int m=0,f__cnt=0;
+	char c;
+	for(c= *s;;c = *s)
+	{	if(c==' ')
+		{	s++;
+			continue;
+		}
+		if(c>'9' || c<'0') break;
+		m=10*m+c-'0';
+		f__cnt++;
+		s++;
+	}
+	if(f__cnt==0) {
+		if (!n1)
+			s = 0;
+		*n=n1;
+		}
+	else *n=m;
+	return(s);
+}
+
+ static
+#ifdef KR_headers
+char *f_s(s,curloc) char *s;
+#else
+char *f_s(char *s, int curloc)
+#endif
+{
+	skip(s);
+	if(*s++!='(')
+	{
+		return(NULL);
+	}
+	if(f__parenlvl++ ==1) f__revloc=curloc;
+	if(op_gen(RET1,curloc,0,0)<0 ||
+		(s=f_list(s))==NULL)
+	{
+		return(NULL);
+	}
+	skip(s);
+	return(s);
+}
+
+ static int
+#ifdef KR_headers
+ne_d(s,p) char *s,**p;
+#else
+ne_d(char *s, char **p)
+#endif
+{	int n,x,sign=0;
+	struct syl *sp;
+	switch(*s)
+	{
+	default:
+		return(0);
+	case ':': (void) op_gen(COLON,0,0,0); break;
+	case '$':
+		(void) op_gen(NONL, 0, 0, 0); break;
+	case 'B':
+	case 'b':
+		if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
+		else (void) op_gen(BN,0,0,0);
+		break;
+	case 'S':
+	case 's':
+		if(*(s+1)=='s' || *(s+1) == 'S')
+		{	x=SS;
+			s++;
+		}
+		else if(*(s+1)=='p' || *(s+1) == 'P')
+		{	x=SP;
+			s++;
+		}
+		else x=S;
+		(void) op_gen(x,0,0,0);
+		break;
+	case '/': (void) op_gen(SLASH,0,0,0); break;
+	case '-': sign=1;
+	case '+':	s++;	/*OUTRAGEOUS CODING TRICK*/
+	case '0': case '1': case '2': case '3': case '4':
+	case '5': case '6': case '7': case '8': case '9':
+		if (!(s=gt_num(s,&n,0))) {
+ bad:			*p = 0;
+			return 1;
+			}
+		switch(*s)
+		{
+		default:
+			return(0);
+		case 'P':
+		case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
+		case 'X':
+		case 'x': (void) op_gen(X,n,0,0); break;
+		case 'H':
+		case 'h':
+			sp = &f__syl[op_gen(H,n,0,0)];
+			sp->p2.s = s + 1;
+			s+=n;
+			break;
+		}
+		break;
+	case GLITCH:
+	case '"':
+	case '\'':
+		sp = &f__syl[op_gen(APOS,0,0,0)];
+		sp->p2.s = s;
+		if((*p = ap_end(s)) == NULL)
+			return(0);
+		return(1);
+	case 'T':
+	case 't':
+		if(*(s+1)=='l' || *(s+1) == 'L')
+		{	x=TL;
+			s++;
+		}
+		else if(*(s+1)=='r'|| *(s+1) == 'R')
+		{	x=TR;
+			s++;
+		}
+		else x=T;
+		if (!(s=gt_num(s+1,&n,0)))
+			goto bad;
+		s--;
+		(void) op_gen(x,n,0,0);
+		break;
+	case 'X':
+	case 'x': (void) op_gen(X,1,0,0); break;
+	case 'P':
+	case 'p': (void) op_gen(P,1,0,0); break;
+	}
+	s++;
+	*p=s;
+	return(1);
+}
+
+ static int
+#ifdef KR_headers
+e_d(s,p) char *s,**p;
+#else
+e_d(char *s, char **p)
+#endif
+{	int i,im,n,w,d,e,found=0,x=0;
+	char *sv=s;
+	s=gt_num(s,&n,1);
+	(void) op_gen(STACK,n,0,0);
+	switch(*s++)
+	{
+	default: break;
+	case 'E':
+	case 'e':	x=1;
+	case 'G':
+	case 'g':
+		found=1;
+		if (!(s=gt_num(s,&w,0))) {
+ bad:
+			*p = 0;
+			return 1;
+			}
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		if(*s!='E' && *s != 'e')
+			(void) op_gen(x==1?E:G,w,d,0);	/* default is Ew.dE2 */
+		else {
+			if (!(s=gt_num(s+1,&e,0)))
+				goto bad;
+			(void) op_gen(x==1?EE:GE,w,d,e);
+			}
+		break;
+	case 'O':
+	case 'o':
+		i = O;
+		im = OM;
+		goto finish_I;
+	case 'Z':
+	case 'z':
+		i = Z;
+		im = ZM;
+		goto finish_I;
+	case 'L':
+	case 'l':
+		found=1;
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		if(w==0) break;
+		(void) op_gen(L,w,0,0);
+		break;
+	case 'A':
+	case 'a':
+		found=1;
+		skip(s);
+		if(*s>='0' && *s<='9')
+		{	s=gt_num(s,&w,1);
+			if(w==0) break;
+			(void) op_gen(AW,w,0,0);
+			break;
+		}
+		(void) op_gen(A,0,0,0);
+		break;
+	case 'F':
+	case 'f':
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		found=1;
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		(void) op_gen(F,w,d,0);
+		break;
+	case 'D':
+	case 'd':
+		found=1;
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		(void) op_gen(D,w,d,0);
+		break;
+	case 'I':
+	case 'i':
+		i = I;
+		im = IM;
+ finish_I:
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		found=1;
+		if(w==0) break;
+		if(*s!='.')
+		{	(void) op_gen(i,w,0,0);
+			break;
+		}
+		if (!(s=gt_num(s+1,&d,0)))
+			goto bad;
+		(void) op_gen(im,w,d,0);
+		break;
+	}
+	if(found==0)
+	{	f__pc--; /*unSTACK*/
+		*p=sv;
+		return(0);
+	}
+	*p=s;
+	return(1);
+}
+ static
+#ifdef KR_headers
+char *i_tem(s) char *s;
+#else
+char *i_tem(char *s)
+#endif
+{	char *t;
+	int n,curloc;
+	if(*s==')') return(s);
+	if(ne_d(s,&t)) return(t);
+	if(e_d(s,&t)) return(t);
+	s=gt_num(s,&n,1);
+	if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
+	return(f_s(s,curloc));
+}
+
+ static
+#ifdef KR_headers
+char *f_list(s) char *s;
+#else
+char *f_list(char *s)
+#endif
+{
+	for(;*s!=0;)
+	{	skip(s);
+		if((s=i_tem(s))==NULL) return(NULL);
+		skip(s);
+		if(*s==',') s++;
+		else if(*s==')')
+		{	if(--f__parenlvl==0)
+			{
+				(void) op_gen(REVERT,f__revloc,0,0);
+				return(++s);
+			}
+			(void) op_gen(GOTO,0,0,0);
+			return(++s);
+		}
+	}
+	return(NULL);
+}
+
+ int
+#ifdef KR_headers
+pars_f(s) char *s;
+#else
+pars_f(char *s)
+#endif
+{
+	f__parenlvl=f__revloc=f__pc=0;
+	if(f_s(s,0) == NULL)
+	{
+		return(-1);
+	}
+	return(0);
+}
+#define STKSZ 10
+int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
+flag f__workdone, f__nonl;
+
+ static int
+#ifdef KR_headers
+type_f(n)
+#else
+type_f(int n)
+#endif
+{
+	switch(n)
+	{
+	default:
+		return(n);
+	case RET1:
+		return(RET1);
+	case REVERT: return(REVERT);
+	case GOTO: return(GOTO);
+	case STACK: return(STACK);
+	case X:
+	case SLASH:
+	case APOS: case H:
+	case T: case TL: case TR:
+		return(NED);
+	case F:
+	case I:
+	case IM:
+	case A: case AW:
+	case O: case OM:
+	case L:
+	case E: case EE: case D:
+	case G: case GE:
+	case Z: case ZM:
+		return(ED);
+	}
+}
+#ifdef KR_headers
+integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
+#else
+integer do_fio(ftnint *number, char *ptr, ftnlen len)
+#endif
+{	struct syl *p;
+	int n,i;
+	for(i=0;i<*number;i++,ptr+=len)
+	{
+loop:	switch(type_f((p= &f__syl[f__pc])->op))
+	{
+	default:
+		fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
+			p->op,f__fmtbuf);
+		err(f__elist->cierr,100,"do_fio");
+	case NED:
+		if((*f__doned)(p))
+		{	f__pc++;
+			goto loop;
+		}
+		f__pc++;
+		continue;
+	case ED:
+		if(f__cnt[f__cp]<=0)
+		{	f__cp--;
+			f__pc++;
+			goto loop;
+		}
+		if(ptr==NULL)
+			return((*f__doend)());
+		f__cnt[f__cp]--;
+		f__workdone=1;
+		if((n=(*f__doed)(p,ptr,len))>0)
+			errfl(f__elist->cierr,errno,"fmt");
+		if(n<0)
+			err(f__elist->ciend,(EOF),"fmt");
+		continue;
+	case STACK:
+		f__cnt[++f__cp]=p->p1;
+		f__pc++;
+		goto loop;
+	case RET1:
+		f__ret[++f__rp]=p->p1;
+		f__pc++;
+		goto loop;
+	case GOTO:
+		if(--f__cnt[f__cp]<=0)
+		{	f__cp--;
+			f__rp--;
+			f__pc++;
+			goto loop;
+		}
+		f__pc=1+f__ret[f__rp--];
+		goto loop;
+	case REVERT:
+		f__rp=f__cp=0;
+		f__pc = p->p1;
+		if(ptr==NULL)
+			return((*f__doend)());
+		if(!f__workdone) return(0);
+		if((n=(*f__dorevert)()) != 0) return(n);
+		goto loop;
+	case COLON:
+		if(ptr==NULL)
+			return((*f__doend)());
+		f__pc++;
+		goto loop;
+	case NONL:
+		f__nonl = 1;
+		f__pc++;
+		goto loop;
+	case S:
+	case SS:
+		f__cplus=0;
+		f__pc++;
+		goto loop;
+	case SP:
+		f__cplus = 1;
+		f__pc++;
+		goto loop;
+	case P:	f__scale=p->p1;
+		f__pc++;
+		goto loop;
+	case BN:
+		f__cblank=0;
+		f__pc++;
+		goto loop;
+	case BZ:
+		f__cblank=1;
+		f__pc++;
+		goto loop;
+	}
+	}
+	return(0);
+}
+
+ int
+en_fio(Void)
+{	ftnint one=1;
+	return(do_fio(&one,(char *)NULL,(ftnint)0));
+}
+
+ VOID
+fmt_bg(Void)
+{
+	f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
+	f__cnt[0]=f__ret[0]=0;
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/fmt.h

@@ -0,0 +1,104 @@
+struct syl
+{	int op;
+	int p1;
+	union { int i[2]; char *s;} p2;
+	};
+#define RET1 1
+#define REVERT 2
+#define GOTO 3
+#define X 4
+#define SLASH 5
+#define STACK 6
+#define I 7
+#define ED 8
+#define NED 9
+#define IM 10
+#define APOS 11
+#define H 12
+#define TL 13
+#define TR 14
+#define T 15
+#define COLON 16
+#define S 17
+#define SP 18
+#define SS 19
+#define P 20
+#define BN 21
+#define BZ 22
+#define F 23
+#define E 24
+#define EE 25
+#define D 26
+#define G 27
+#define GE 28
+#define L 29
+#define A 30
+#define AW 31
+#define O 32
+#define NONL 33
+#define OM 34
+#define Z 35
+#define ZM 36
+extern int f__pc,f__parenlvl,f__revloc;
+typedef union
+{	real pf;
+	doublereal pd;
+} ufloat;
+typedef union
+{	short is;
+#ifndef KR_headers
+	signed
+#endif
+		char ic;
+	integer il;
+#ifdef Allow_TYQUAD
+	longint ili;
+#endif
+} Uint;
+#ifdef KR_headers
+extern int (*f__doed)(),(*f__doned)();
+extern int (*f__dorevert)();
+extern int rd_ed(),rd_ned();
+extern int w_ed(),w_ned();
+extern int signbit_f2c();
+#else
+#ifdef __cplusplus
+extern "C" {
+#define Cextern extern "C"
+#else
+#define Cextern extern
+#endif
+extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+extern int (*f__dorevert)(void);
+extern void fmt_bg(void);
+extern int pars_f(char*);
+extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*);
+extern int signbit_f2c(double*);
+extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*);
+extern int wrt_E(ufloat*, int, int, int, ftnlen);
+extern int wrt_F(ufloat*, int, int, ftnlen);
+extern int wrt_L(Uint*, int, ftnlen);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern flag f__cblank,f__cplus,f__workdone, f__nonl;
+extern char *f__fmtbuf;
+extern int f__scale;
+#define GET(x) if((x=(*f__getn)())<0) return(x)
+#define VAL(x) (x!='\n'?x:' ')
+#define PUT(x) (*f__putn)(x)
+
+#undef TYQUAD
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#else
+#define TYQUAD 14
+#endif
+
+#ifdef KR_headers
+extern char *f__icvt();
+#else
+Cextern char *f__icvt(longint, int*, int*, int);
+#endif

ext/f2c_libs/fmtlib.c

@@ -0,0 +1,51 @@
+/*	@(#)fmtlib.c	1.2	*/
+#define MAXINTLENGTH 23
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#undef ulongint
+#define ulongint unsigned long
+#endif
+
+#ifdef KR_headers
+char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign;
+ register int base;
+#else
+char *f__icvt(longint value, int *ndigit, int *sign, int base)
+#endif
+{
+	static char buf[MAXINTLENGTH+1];
+	register int i;
+	ulongint uvalue;
+
+	if(value > 0) {
+		uvalue = value;
+		*sign = 0;
+		}
+	else if (value < 0) {
+		uvalue = -value;
+		*sign = 1;
+		}
+	else {
+		*sign = 0;
+		*ndigit = 1;
+		buf[MAXINTLENGTH-1] = '0';
+		return &buf[MAXINTLENGTH-1];
+		}
+	i = MAXINTLENGTH;
+	do {
+		buf[--i] = (uvalue%base) + '0';
+		uvalue /= base;
+		}
+		while(uvalue > 0);
+	*ndigit = MAXINTLENGTH - i;
+	return &buf[i];
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/fp.h

@@ -0,0 +1,28 @@
+#define FMAX 40
+#define EXPMAXDIGS 8
+#define EXPMAX 99999999
+/* FMAX = max number of nonzero digits passed to atof() */
+/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */
+
+#ifdef V10 /* Research Tenth-Edition Unix */
+#include "local.h"
+#endif
+
+/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily
+   tight) on the maximum number of digits to the right and left of
+ * the decimal point.
+ */
+
+#ifdef VAX
+#define MAXFRACDIGS 56
+#define MAXINTDIGS 38
+#else
+#ifdef CRAY
+#define MAXFRACDIGS 9880
+#define MAXINTDIGS 9864
+#else
+/* values that suffice for IEEE double */
+#define MAXFRACDIGS 344
+#define MAXINTDIGS 308
+#endif
+#endif

ext/f2c_libs/ftell64_.c

@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ static FILE *
+#ifdef KR_headers
+unit_chk(Unit, who) integer Unit; char *who;
+#else
+unit_chk(integer Unit, char *who)
+#endif
+{
+	if (Unit >= MXUNIT || Unit < 0)
+		f__fatal(101, who);
+	return f__units[Unit].ufd;
+	}
+
+ longint
+#ifdef KR_headers
+ftell64_(Unit) integer *Unit;
+#else
+ftell64_(integer *Unit)
+#endif
+{
+	FILE *f;
+	return (f = unit_chk(*Unit, "ftell")) ? FTELL(f) : -1L;
+	}
+
+ int
+#ifdef KR_headers
+fseek64_(Unit, offset, whence) integer *Unit, *whence; longint *offset;
+#else
+fseek64_(integer *Unit, longint *offset, integer *whence)
+#endif
+{
+	FILE *f;
+	int w = (int)*whence;
+#ifdef SEEK_SET
+	static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END };
+#endif
+	if (w < 0 || w > 2)
+		w = 0;
+#ifdef SEEK_SET
+	w = wohin[w];
+#endif
+	return	!(f = unit_chk(*Unit, "fseek"))
+		|| FSEEK(f, (OFF_T)*offset, w) ? 1 : 0;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/ftell_.c

@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ static FILE *
+#ifdef KR_headers
+unit_chk(Unit, who) integer Unit; char *who;
+#else
+unit_chk(integer Unit, char *who)
+#endif
+{
+	if (Unit >= MXUNIT || Unit < 0)
+		f__fatal(101, who);
+	return f__units[Unit].ufd;
+	}
+
+ integer
+#ifdef KR_headers
+ftell_(Unit) integer *Unit;
+#else
+ftell_(integer *Unit)
+#endif
+{
+	FILE *f;
+	return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L;
+	}
+
+ int
+#ifdef KR_headers
+fseek_(Unit, offset, whence) integer *Unit, *offset, *whence;
+#else
+fseek_(integer *Unit, integer *offset, integer *whence)
+#endif
+{
+	FILE *f;
+	int w = (int)*whence;
+#ifdef SEEK_SET
+	static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END };
+#endif
+	if (w < 0 || w > 2)
+		w = 0;
+#ifdef SEEK_SET
+	w = wohin[w];
+#endif
+	return	!(f = unit_chk(*Unit, "fseek"))
+		|| fseek(f, *offset, w) ? 1 : 0;
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/getarg_.c

@@ -0,0 +1,34 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * 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++ = ' ';
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/getenv_.c

@@ -0,0 +1,62 @@
+#include "f2c.h"
+#undef abs
+#ifdef KR_headers
+extern char *F77_aloc(), *getenv();
+#else
+#include <stdlib.h>
+#include <string.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern char *F77_aloc(ftnlen, char*);
+#endif
+
+/*
+ * 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
+{
+	char buf[256], *ep, *fp;
+	integer i;
+
+	if (flen <= 0)
+		goto add_blanks;
+	for(i = 0; i < sizeof(buf); i++) {
+		if (i == flen || (buf[i] = fname[i]) == ' ') {
+			buf[i] = 0;
+			ep = getenv(buf);
+			goto have_ep;
+			}
+		}
+	while(i < flen && fname[i] != ' ')
+		i++;
+	strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i);
+	fp[i] = 0;
+	ep = getenv(fp);
+	free(fp);
+ have_ep:
+	if (ep)
+		while(*ep && vlen-- > 0)
+			*value++ = *ep++;
+ add_blanks:
+	while(vlen-- > 0)
+		*value++ = ' ';
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_abs.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+shortint h_abs(x) shortint *x;
+#else
+shortint h_abs(shortint *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_dim.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_dnnt.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+shortint h_dnnt(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+shortint h_dnnt(doublereal *x)
+#endif
+{
+return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_indx.c

@@ -0,0 +1,32 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_len.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+shortint h_len(s, n) char *s; ftnlen n;
+#else
+shortint h_len(char *s, ftnlen n)
+#endif
+{
+return(n);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_mod.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+shortint h_mod(a,b) short *a, *b;
+#else
+shortint h_mod(short *a, short *b)
+#endif
+{
+return( *a % *b);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_nint.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+shortint h_nint(x) real *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+shortint h_nint(real *x)
+#endif
+{
+return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/h_sign.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/hl_ge.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/hl_gt.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/hl_le.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/hl_lt.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i77vers.c

@@ -0,0 +1,343 @@
+ char
+_libi77_version_f2c[] = "\n@(#) LIBI77 VERSION (f2c) pjw,dmg-mods 20030321\n";
+
+/*
+2.01	$ format added
+2.02	Coding bug in open.c repaired
+2.03	fixed bugs in lread.c (read * with negative f-format) and lio.c
+	and lio.h (e-format conforming to spec)
+2.04	changed open.c and err.c (fopen and freopen respectively) to
+	update to new c-library (append mode)
+2.05	added namelist capability
+2.06	allow internal list and namelist I/O
+*/
+
+/*
+close.c:
+	allow upper-case STATUS= values
+endfile.c
+	create fort.nnn if unit nnn not open;
+	else if (file length == 0) use creat() rather than copy;
+	use local copy() rather than forking /bin/cp;
+	rewind, fseek to clear buffer (for no reading past EOF)
+err.c
+	use neither setbuf nor setvbuf; make stderr buffered
+fio.h
+	#define _bufend
+inquire.c
+	upper case responses;
+	omit byfile test from SEQUENTIAL=
+	answer "YES" to DIRECT= for unopened file (open to debate)
+lio.c
+	flush stderr, stdout at end of each stmt
+	space before character strings in list output only at line start
+lio.h
+	adjust LEW, LED consistent with old libI77
+lread.c
+	use atof()
+	allow "nnn*," when reading complex constants
+open.c
+	try opening for writing when open for read fails, with
+	special uwrt value (2) delaying creat() to first write;
+	set curunit so error messages don't drop core;
+	no file name ==> fort.nnn except for STATUS='SCRATCH'
+rdfmt.c
+	use atof(); trust EOF == end-of-file (so don't read past
+	end-of-file after endfile stmt)
+sfe.c
+	flush stderr, stdout at end of each stmt
+wrtfmt.c:
+	use upper case
+	put wrt_E and wrt_F into wref.c, use sprintf()
+		rather than ecvt() and fcvt() [more accurate on VAX]
+*/
+
+/* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */
+
+/* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */
+
+/* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */
+/* 29 Nov. 1989: change various int return types to long for f2c */
+/* 30 Nov. 1989: various types from f2c.h */
+/*  6 Dec. 1989: types corrected various places */
+/* 19 Dec. 1989: make iostat= work right for internal I/O */
+/*  8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */
+/* 28 Jan. 1990: have NAMELIST read treat $ as &, general white
+		 space as blank */
+/* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads
+		 of logical values reject letters other than fFtT;
+		 have nowwriting reset cf */
+/* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */
+/* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as
+		 blank='z...' when reopening an open file */
+/* 30 Aug. 1990: prevent embedded blanks in list output of complex values;
+		 omit exponent field in list output of values of
+		 magnitude between 10 and 1e8; prevent writing stdin
+		 and reading stdout or stderr; don't close stdin, stdout,
+		 or stderr when reopening units 5, 6, 0. */
+/* 18 Sep. 1990: add component udev to unit and consider old == new file
+		 iff uinode and udev values agree; use stat rather than
+		 access to check existence of file (when STATUS='OLD')*/
+/* 2 Oct. 1990:  adjust rewind.c so two successive rewinds after a write
+		 don't clobber the file. */
+/* 9 Oct. 1990:  add #include "fcntl.h" to endfile.c, err.c, open.c;
+		 adjust g_char in util.c for segmented memories. */
+/* 17 Oct. 1990: replace abort() and _cleanup() with calls on
+		 sig_die(...,1) (defined in main.c). */
+/* 5 Nov. 1990:  changes to open.c: complain if new= is specified and the
+		 file already exists; allow file= to be omitted in open stmts
+		 and allow status='replace' (Fortran 90 extensions). */
+/* 11 Dec. 1990: adjustments for POSIX. */
+/* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from
+		 strings in read-only memory. */
+/* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */
+/* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */
+/* 16 May 1991:  increase LEFBL in lio.h to bypass NeXT bug */
+/* 17 Oct. 1991: change type of length field in sequential unformatted
+		 records from int to long (for systems where sizeof(int)
+		 can vary, depending on the compiler or compiler options). */
+/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */
+/* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to
+		 sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */
+/* 1 Dec. 1991:  uio.c: add test for read failure (seq. unformatted reads);
+		 adjust an error return from EOF to off end of record */
+/* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused
+		 the last character of each record to be ignored.
+		 iio.c: adjust error message in internal formatted
+		 input from "end-of-file" to "off end of record" if
+		 the format specifies more characters than the
+		 record contains. */
+/* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input,
+		 treat "r* ," and "r*," alike (where r is a
+		 positive integer constant), and fix a bug in
+		 handling null values following items with repeat
+		 counts (e.g., 2*1,,3); for namelist reading
+		 of a numeric array, allow a new name-value subsequence
+		 to terminate the current one (as though the current
+		 one ended with the right number of null values).
+		 lio.h, lwrite.c: omit insignificant zeros in
+		 list and namelist output. To get the old
+		 behavior, compile with -DOld_list_output . */
+/* 18 Jan. 1992: make list output consistent with F format by
+		 printing .1 rather than 0.1 (introduced yesterday). */
+/* 3 Feb. 1992:  rsne.c: fix namelist read bug that caused the
+		 character following a comma to be ignored. */
+/* 19 May 1992:  adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err=
+		 work with internal list and formatted I/O. */
+/* 18 July 1992: adjust rsne.c to allow namelist input to stop at
+		 an & (e.g. &end). */
+/* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ;
+		 recognize Z format (assuming 8-bit bytes). */
+/* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */
+/* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c
+		 (so end-of-file on other files won't confuse namelist
+		 reads of external files).  Prepend f__ to external
+		 names that are only of internal interest to lib[FI]77. */
+/* 1 Feb. 1993:  backspace.c: fix bug that bit when last char of 2nd
+		 buffer == '\n'.
+		 endfile.c: guard against tiny L_tmpnam; close and reopen
+		 files in t_runc().
+		 lio.h: lengthen LINTW (buffer size in lwrite.c).
+		 err.c, open.c: more prepending of f__ (to [rw]_mode). */
+/* 5 Feb. 1993:  tweaks to NAMELIST: rsne.c: ? prints the namelist being
+		 sought; namelists of the wrong name are skipped (after
+		 an error message; xwsne.c: namelist writes have a
+		 newline before each new variable.
+		 open.c: ACCESS='APPEND' positions sequential files
+		 at EOF (nonstandard extension -- that doesn't require
+		 changing data structures). */
+/* 9 Feb. 1993:  Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO.
+		 err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666))
+		 when the unit has another file descriptor for name. */
+/* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h;
+		 open.c: always give f__w_mode[] 4 elements for use
+		 in t_runc (in endfile.c -- for change of 1 Feb. 1993). */
+/* 6 March 1993: uio.c: adjust off-end-of-record test for sequential
+		 unformatted reads to respond to err= rather than end=. */
+/* 12 March 1993: various tweaks for C++ */
+/* 6 April 1993: adjust error returns for formatted inputs to flush
+		 the current input line when err=label is specified.
+		 To restore the old behavior (input left mid-line),
+		 either adjust the #definition of errfl in fio.h or
+		 omit the invocation of f__doend in err__fl (in err.c).	*/
+/* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */
+/* 5 Aug. 1993:  lread.c: fix bug in handling repetition counts for
+		 logical data (during list or namelist input).
+		 Change struct f__syl to struct syl (for buggy compilers). */
+/* 7 Aug. 1993:  lread.c: fix bug in namelist reading of incomplete
+		 logical arrays. */
+/* 9 Aug. 1993:  lread.c: fix bug in namelist reading of an incomplete
+		 array of numeric data followed by another namelist
+		 item whose name starts with 'd', 'D', 'e', or 'E'. */
+/* 8 Sept. 1993: open.c: protect #include "sys/..." with
+		 #ifndef NON_UNIX_STDIO; Version date not changed. */
+/* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */
+/* 8 Dec. 1993:  iio.c: adjust internal formatted reads to treat
+		 short records as though padded with blanks
+		 (rather than causing an "off end of record" error). */
+/* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */
+/* 6 June 1994:  Under NON_UNIX_STDIO, use binary mode for direct
+		 formatted files (avoiding any confusion regarding \n). */
+/* 5 July 1994:  Fix bug (introduced 6 June 1994?) in reopening files
+		 under NON_UNIX_STDIO. */
+/* 6 July 1994:  wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
+		 optimization that requires exponents to have 2 digits
+		 when 2 digits suffice.
+		 lwrite.c wsfe.c (list and formatted external output):
+		 omit ' ' carriage-control when compiled with
+		 -DOMIT_BLANK_CC .  Off-by-one bug fixed in character
+		 count for list output of character strings.
+		 Omit '.' in list-directed printing of Nan, Infinity. */
+/* 12 July 1994: wrtfmt.c: under G11.4, write 0. as "  .0000    " rather
+		 than "  .0000E+00". */
+/* 3 Aug. 1994:  lwrite.c: do not insert a newline when appending an
+		 oversize item to an empty line. */
+/* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept
+		 ERR= (in list- or format-directed input) from working
+		 after a NAMELIST READ. */
+/* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
+		 INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8
+		 in NAMELISTs. */
+/* 6 Oct. 1994:  util.c: omit f__mvgbt, as it is never used. */
+/* 2 Nov. 1994:  add #ifdef ALWAYS_FLUSH logic. */
+/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when
+		 GOOD_SPRINTF_EXPONENT is not #defined. */
+/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow
+		 internal reading of characters with high-bit set
+		 (on machines that sign-extend characters). */
+/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to
+		 check for end-of-file (to prevent infinite loops
+		 with empty read statements). */
+/* 26 May 1995:  iio.c: z_wnew: fix bug in handling T format items
+		 in internal writes whose last item is written to
+		 an earlier position than some previous item. */
+/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */
+/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name
+		 whose subscripts do not involve colons similarly
+		 to the name without a subscript: accept several
+		 values, stored in successive elements starting at
+		 the indicated subscript.  Adjust namelist output
+		 to quote character strings (avoiding confusion with
+		 arrays of character strings).  Adjust f_init calls
+		 for people who don't use libF77's main(); now open and
+		 namelist read statements invoke f_init if needed. */
+/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8).
+		 Add -DNo_Namelist_Comments lines to rsne.c. */
+/* 5 Oct. 1995:  wrtfmt.c: fix bug with t editing (f__cursor was not
+		 always zeroed in mv_cur). */
+/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
+		 to err.c */
+/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */
+
+/* 13 May 1996:  add ftell_.c and fseek_.c */
+/* 9 June 1996:  Adjust rsli.c and lread.c so internal list input with
+		 too few items in the input string will honor end= . */
+/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */
+/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values,
+		 make ic signed on ANSI systems.  If formatted writes of
+		 integer*1 values trouble you when using a K&R C compiler,
+		 switch to an ANSI compiler or use a compiler flag that
+		 makes characters signed. */
+/* 9 Dec. 1996:	 d[fu]e.c, err.c: complain about non-positive rec=
+		 in direct read and write statements.
+		 ftell_.c: change param "unit" to "Unit" for -DKR_headers. */
+/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use
+		 SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */
+/* 7 Apr. 1997:	 fmt.c: adjust to complain at missing numbers in formats
+		 (but still treat missing ".nnn" as ".0"). */
+/* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather
+		 than fully buffered.  (Buffering is needed for format
+		 items T and TR.) */
+/* 27 May 1997:  ftell_.c: fix typo (that caused the third argument to be
+		 treated as 2 on some systems). */
+/* 5 Aug. 1997:  lread.c: adjust to accord with a change to the Fortran 8X
+		 draft (in 1990 or 1991) that rescinded permission to elide
+		 quote marks in namelist input of character data; compile
+		 with -DF8X_NML_ELIDE_QUOTES to get the old behavior.
+		 wrtfmt.o: wrt_G: tweak to print the right number of 0's
+		 for zero under G format. */
+/* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character
+		 strings that sometimes caused one more array element than
+		 required by the format to be blank-filled.  Example:
+		 format(1x). */
+/* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
+		 with 64-bit pointers and 32-bit ints that did not 64-bit
+		 align struct syl (e.g., Linux on the DEC Alpha). */
+/* 19 Jan. 1998: backspace.c: for b->ufmt==0, change sizeof(int) to
+		 sizeof(uiolen).  On machines where this would make a
+		 difference, it is best for portability to compile libI77 with
+		 -DUIOLEN_int (which will render the change invisible). */
+/* 4 March 1998: open.c: fix glitch in comparing file names under
+		-DNON_UNIX_STDIO */
+/* 17 March 1998: endfile.c, open.c: acquire temporary files from tmpfile(),
+		 unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
+		 New buffering scheme independent of NON_UNIX_STDIO for
+		 handling T format items.  Now -DNON_UNIX_STDIO is no
+		 longer be necessary for Linux, and libf2c no longer
+		 causes stderr to be buffered -- the former setbuf or
+		 setvbuf call for stderr was to make T format items work.
+		 open.c: use the Posix access() function to check existence
+		 or nonexistence of files, except under -DNON_POSIX_STDIO,
+		 where trial fopen calls are used. */
+/* 5 April 1998: wsfe.c: make $ format item work: this was lost in the
+		 changes of 17 March 1998. */
+/* 28 May 1998:	 backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c:
+		 set f__curunit sooner so various error messages will
+		 correctly identify the I/O unit involved. */
+/* 17 June 1998: lread.c: unless compiled with
+		 ALLOW_FLOAT_IN_INTEGER_LIST_INPUT #defined, treat
+		 floating-point numbers (containing either a decimal point
+		 or an exponent field) as errors when they appear as list
+		 input for integer data. */
+/* 7 Sept. 1998: move e_wdfe from sfe.c to dfe.c, where it was originally.
+		 Why did it ever move to sfe.c? */
+/* 2 May 1999:	 open.c: set f__external (to get "external" versus "internal"
+		 right in the error message if we cannot open the file).
+		 err.c: cast a pointer difference to (int) for %d.
+		 rdfmt.c: omit fixed-length buffer that could be overwritten
+		 by formats Inn or Lnn with nn > 83. */
+/* 3 May 1999:	open.c: insert two casts for machines with 64-bit longs. */
+/* 18 June 1999: backspace.c: allow for b->ufd changing in t_runc */
+/* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */
+/*		 could cause wrong array elements to be assigned; e.g.,	*/
+/*		 "&input k(5)=10*1 &end" assigned k(5) and k(15..23)	*/
+/* 15 Nov. 1999: endfile.c: set state to writing (b->uwrt = 1) when an */
+/*		endfile statement requires copying the file. */
+/*		(Otherwise an immediately following rewind statement */
+/*		could make the file appear empty.)  Also, supply a */
+/*		missing (long) cast in the sprintf call. */
+/*		 sfe.c: add #ifdef ALWAYS_FLUSH logic, for formatted I/O: */
+/*		Compiling libf2c with -DALWAYS_FLUSH should prevent losing */
+/*		any data in buffers should the program fault.  It also */
+/*		makes the program run more slowly. */
+/* 20 April 2000: rsne.c, xwsne.c: tweaks that only matter if ftnint and */
+/*		ftnlen are of different fundamental types (different numbers */
+/*		of bits).  Since these files will not compile when this */
+/*		change matters, the above VERSION string remains unchanged. */
+/* 4 July 2000: adjustments to permit compilation by C++ compilers; */
+/*		VERSION string remains unchanged. */
+/* 5 Dec. 2000: lread.c: under namelist input, when reading a logical array, */
+/*		treat Tstuff= and Fstuff= as new assignments rather than as */
+/*		logical constants. */
+/* 22 Feb. 2001: endfile.c: adjust to use truncate() unless compiled with */
+/*		-DNO_TRUNCATE (or with -DMSDOS). */
+/* 1 March 2001: endfile.c:  switch to ftruncate (absent -DNO_TRUNCATE), */
+/*		thus permitting truncation of scratch files on true Unix */
+/*		systems, where scratch files have no name.  Add an fflush() */
+/*		(surprisingly) needed on some Linux systems. */
+/* 11 Oct. 2001: backspac.c dfe.c due.c endfile.c err.c fio.h fmt.c fmt.h */
+/*		inquire.c open.c rdfmt.c sue.c util.c: change fseek and */
+/*		ftell to FSEEK and FTELL (#defined to be fseek and ftell, */
+/*		respectively, in fio.h unless otherwise #defined), and use */
+/*		type OFF_T (#defined to be long unless otherwise #defined) */
+/*		to permit handling files over 2GB long where possible, */
+/*		with suitable -D options, provided for some systems in new */
+/*		header file sysdep1.h (copied from sysdep1.h0 by default). */
+/* 15 Nov. 2001: endfile.c: add FSEEK after FTRUNCATE. */
+/* 28 Nov. 2001: fmt.h lwrite.c wref.c and (new) signbit.c: on IEEE systems, */
+/*		print -0 as -0 when compiled with -DSIGNED_ZEROS.  See */
+/*		comments in makefile or (better) libf2c/makefile.* . */
+/* 6 Sept. 2002: rsne.c: fix bug with multiple repeat counts in reading */
+/*		namelists, e.g., &nl a(2) = 3*1.0, 2*2.0, 3*3.0 /  */
+/* 21 March 2003: err.c: before writing to a file after reading from it, */
+/*		f_seek(file, 0, SEEK_CUR) to make writing legal in ANSI C. */

ext/f2c_libs/i_abs.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+integer i_abs(x) integer *x;
+#else
+integer i_abs(integer *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_dim.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_dnnt.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+integer i_dnnt(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+integer i_dnnt(doublereal *x)
+#endif
+{
+return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_indx.c

@@ -0,0 +1,32 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_len.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+integer i_len(s, n) char *s; ftnlen n;
+#else
+integer i_len(char *s, ftnlen n)
+#endif
+{
+return(n);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_mod.c

@@ -0,0 +1,16 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+integer i_mod(a,b) integer *a, *b;
+#else
+integer i_mod(integer *a, integer *b)
+#endif
+{
+return( *a % *b);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_nint.c

@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+integer i_nint(x) real *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+integer i_nint(real *x)
+#endif
+{
+return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/i_sign.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/iargc_.c

@@ -0,0 +1,17 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+ftnint iargc_()
+#else
+ftnint iargc_(void)
+#endif
+{
+extern int xargc;
+return ( xargc - 1 );
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/iio.c

@@ -0,0 +1,159 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern char *f__icptr;
+char *f__icend;
+extern icilist *f__svic;
+int f__icnum;
+
+ int
+z_getc(Void)
+{
+	if(f__recpos++ < f__svic->icirlen) {
+		if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile");
+		return(*(unsigned char *)f__icptr++);
+		}
+	return '\n';
+}
+
+ void
+#ifdef KR_headers
+z_putc(c)
+#else
+z_putc(int c)
+#endif
+{
+	if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = c;
+}
+
+ int
+z_rnew(Void)
+{
+	f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
+	f__recpos = 0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	return 1;
+}
+
+ static int
+z_endp(Void)
+{
+	(*f__donewrec)();
+	return 0;
+	}
+
+ int
+#ifdef KR_headers
+c_si(a) icilist *a;
+#else
+c_si(icilist *a)
+#endif
+{
+	f__elist = (cilist *)a;
+	f__fmtbuf=a->icifmt;
+	f__curunit = 0;
+	f__sequential=f__formatted=1;
+	f__external=0;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->icierr,100,"startint");
+	fmt_bg();
+	f__cblank=f__cplus=f__scale=0;
+	f__svic=a;
+	f__icnum=f__recpos=0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	f__icptr = a->iciunit;
+	f__icend = f__icptr + a->icirlen*a->icirnum;
+	f__cf = 0;
+	return(0);
+}
+
+ int
+iw_rev(Void)
+{
+	if(f__workdone)
+		z_endp();
+	f__hiwater = f__recpos = f__cursor = 0;
+	return(f__workdone=0);
+	}
+
+#ifdef KR_headers
+integer s_rsfi(a) icilist *a;
+#else
+integer s_rsfi(icilist *a)
+#endif
+{	int n;
+	if(n=c_si(a)) return(n);
+	f__reading=1;
+	f__doed=rd_ed;
+	f__doned=rd_ned;
+	f__getn=z_getc;
+	f__dorevert = z_endp;
+	f__donewrec = z_rnew;
+	f__doend = z_endp;
+	return(0);
+}
+
+ int
+z_wnew(Void)
+{
+	if (f__recpos < f__hiwater) {
+		f__icptr += f__hiwater - f__recpos;
+		f__recpos = f__hiwater;
+		}
+	while(f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = ' ';
+	f__recpos = 0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	f__icnum++;
+	return 1;
+}
+#ifdef KR_headers
+integer s_wsfi(a) icilist *a;
+#else
+integer s_wsfi(icilist *a)
+#endif
+{	int n;
+	if(n=c_si(a)) return(n);
+	f__reading=0;
+	f__doed=w_ed;
+	f__doned=w_ned;
+	f__putn=z_putc;
+	f__dorevert = iw_rev;
+	f__donewrec = z_wnew;
+	f__doend = z_endp;
+	return(0);
+}
+integer e_rsfi(Void)
+{	int n = en_fio();
+	f__fmtbuf = NULL;
+	return(n);
+}
+integer e_wsfi(Void)
+{
+	int n;
+	n = en_fio();
+	f__fmtbuf = NULL;
+	if(f__svic->icirnum != 1
+	 && (f__icnum >  f__svic->icirnum
+	 || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
+		err(f__svic->icierr,110,"inwrite");
+	if (f__recpos < f__hiwater)
+		f__recpos = f__hiwater;
+	if (f__recpos >= f__svic->icirlen)
+		err(f__svic->icierr,110,"recend");
+	if (!f__recpos && f__icnum)
+		return n;
+	while(f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = ' ';
+	return n;
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/ilnw.c

@@ -0,0 +1,83 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern char *f__icptr;
+extern char *f__icend;
+extern icilist *f__svic;
+extern int f__icnum;
+#ifdef KR_headers
+extern void z_putc();
+#else
+extern void z_putc(int);
+#endif
+
+ static int
+z_wSL(Void)
+{
+	while(f__recpos < f__svic->icirlen)
+		z_putc(' ');
+	return z_rnew();
+	}
+
+ static void
+#ifdef KR_headers
+c_liw(a) icilist *a;
+#else
+c_liw(icilist *a)
+#endif
+{
+	f__reading = 0;
+	f__external = 0;
+	f__formatted = 1;
+	f__putn = z_putc;
+	L_len = a->icirlen;
+	f__donewrec = z_wSL;
+	f__svic = a;
+	f__icnum = f__recpos = 0;
+	f__cursor = 0;
+	f__cf = 0;
+	f__curunit = 0;
+	f__icptr = a->iciunit;
+	f__icend = f__icptr + a->icirlen*a->icirnum;
+	f__elist = (cilist *)a;
+	}
+
+ integer
+#ifdef KR_headers
+s_wsni(a) icilist *a;
+#else
+s_wsni(icilist *a)
+#endif
+{
+	cilist ca;
+
+	c_liw(a);
+	ca.cifmt = a->icifmt;
+	x_wsne(&ca);
+	z_wSL();
+	return 0;
+	}
+
+ integer
+#ifdef KR_headers
+s_wsli(a) icilist *a;
+#else
+s_wsli(icilist *a)
+#endif
+{
+	f__lioproc = l_write;
+	c_liw(a);
+	return(0);
+	}
+
+integer e_wsli(Void)
+{
+	z_wSL();
+	return(0);
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/inquire.c

@@ -0,0 +1,117 @@
+#include "f2c.h"
+#include "fio.h"
+#include "string.h"
+#ifdef NON_UNIX_STDIO
+#ifndef MSDOS
+#include "unistd.h" /* for access() */
+#endif
+#endif
+#ifdef KR_headers
+integer f_inqu(a) inlist *a;
+#else
+#ifdef __cplusplus
+extern "C" integer f_inqu(inlist*);
+#endif
+#ifdef MSDOS
+#undef abs
+#undef min
+#undef max
+#include "io.h"
+#endif
+integer f_inqu(inlist *a)
+#endif
+{	flag byfile;
+	int i;
+#ifndef NON_UNIX_STDIO
+	int n;
+#endif
+	unit *p;
+	char buf[256];
+	long x;
+	if(a->infile!=NULL)
+	{	byfile=1;
+		g_char(a->infile,a->infilen,buf);
+#ifdef NON_UNIX_STDIO
+		x = access(buf,0) ? -1 : 0;
+		for(i=0,p=NULL;i<MXUNIT;i++)
+			if(f__units[i].ufd != NULL
+			 && f__units[i].ufnm != NULL
+			 && !strcmp(f__units[i].ufnm,buf)) {
+				p = &f__units[i];
+				break;
+				}
+#else
+		x=f__inode(buf, &n);
+		for(i=0,p=NULL;i<MXUNIT;i++)
+			if(f__units[i].uinode==x
+			&& f__units[i].ufd!=NULL
+			&& f__units[i].udev == n) {
+				p = &f__units[i];
+				break;
+				}
+#endif
+	}
+	else
+	{
+		byfile=0;
+		if(a->inunit<MXUNIT && a->inunit>=0)
+		{
+			p= &f__units[a->inunit];
+		}
+		else
+		{
+			p=NULL;
+		}
+	}
+	if(a->inex!=NULL)
+		if(byfile && x != -1 || !byfile && p!=NULL)
+			*a->inex=1;
+		else *a->inex=0;
+	if(a->inopen!=NULL)
+		if(byfile) *a->inopen=(p!=NULL);
+		else *a->inopen=(p!=NULL && p->ufd!=NULL);
+	if(a->innum!=NULL) *a->innum= p-f__units;
+	if(a->innamed!=NULL)
+		if(byfile || p!=NULL && p->ufnm!=NULL)
+			*a->innamed=1;
+		else	*a->innamed=0;
+	if(a->inname!=NULL)
+		if(byfile)
+			b_char(buf,a->inname,a->innamlen);
+		else if(p!=NULL && p->ufnm!=NULL)
+			b_char(p->ufnm,a->inname,a->innamlen);
+	if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL)
+		if(p->url)
+			b_char("DIRECT",a->inacc,a->inacclen);
+		else	b_char("SEQUENTIAL",a->inacc,a->inacclen);
+	if(a->inseq!=NULL)
+		if(p!=NULL && p->url)
+			b_char("NO",a->inseq,a->inseqlen);
+		else	b_char("YES",a->inseq,a->inseqlen);
+	if(a->indir!=NULL)
+		if(p==NULL || p->url)
+			b_char("YES",a->indir,a->indirlen);
+		else	b_char("NO",a->indir,a->indirlen);
+	if(a->infmt!=NULL)
+		if(p!=NULL && p->ufmt==0)
+			b_char("UNFORMATTED",a->infmt,a->infmtlen);
+		else	b_char("FORMATTED",a->infmt,a->infmtlen);
+	if(a->inform!=NULL)
+		if(p!=NULL && p->ufmt==0)
+		b_char("NO",a->inform,a->informlen);
+		else b_char("YES",a->inform,a->informlen);
+	if(a->inunf)
+		if(p!=NULL && p->ufmt==0)
+			b_char("YES",a->inunf,a->inunflen);
+		else if (p!=NULL) b_char("NO",a->inunf,a->inunflen);
+		else b_char("UNKNOWN",a->inunf,a->inunflen);
+	if(a->inrecl!=NULL && p!=NULL)
+		*a->inrecl=p->url;
+	if(a->innrec!=NULL && p!=NULL && p->url>0)
+		*a->innrec=(ftnint)(FTELL(p->ufd)/p->url+1);
+	if(a->inblank && p!=NULL && p->ufmt)
+		if(p->ublnk)
+			b_char("ZERO",a->inblank,a->inblanklen);
+		else	b_char("NULL",a->inblank,a->inblanklen);
+	return(0);
+}

ext/f2c_libs/l_ge.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/l_gt.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/l_le.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/l_lt.c

@@ -0,0 +1,18 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#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);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/lbitbits.c

@@ -0,0 +1,68 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef LONGBITS
+#define LONGBITS 32
+#endif
+
+ integer
+#ifdef KR_headers
+lbit_bits(a, b, len) integer a, b, len;
+#else
+lbit_bits(integer a, integer b, integer len)
+#endif
+{
+	/* Assume 2's complement arithmetic */
+
+	unsigned long x, y;
+
+	x = (unsigned long) a;
+	y = (unsigned long)-1L;
+	x >>= b;
+	y <<= len;
+	return (integer)(x & ~y);
+	}
+
+ integer
+#ifdef KR_headers
+lbit_cshift(a, b, len) integer a, b, len;
+#else
+lbit_cshift(integer a, integer b, integer len)
+#endif
+{
+	unsigned long x, y, z;
+
+	x = (unsigned long)a;
+	if (len <= 0) {
+		if (len == 0)
+			return 0;
+		goto full_len;
+		}
+	if (len >= LONGBITS) {
+ full_len:
+		if (b >= 0) {
+			b %= LONGBITS;
+			return (integer)(x << b | x >> LONGBITS -b );
+			}
+		b = -b;
+		b %= LONGBITS;
+		return (integer)(x << LONGBITS - b | x >> b);
+		}
+	y = z = (unsigned long)-1;
+	y <<= len;
+	z &= ~y;
+	y &= x;
+	x &= z;
+	if (b >= 0) {
+		b %= len;
+		return (integer)(y | z & (x << b | x >> len - b));
+		}
+	b = -b;
+	b %= len;
+	return (integer)(y | z & (x >> b | x << len - b));
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/lbitshft.c

@@ -0,0 +1,17 @@
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ integer
+#ifdef KR_headers
+lbit_shift(a, b) integer a; integer b;
+#else
+lbit_shift(integer a, integer b)
+#endif
+{
+	return b >= 0 ? a << b : (integer)((uinteger)a >> -b);
+	}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/lio.h

@@ -0,0 +1,74 @@
+/*	copy of ftypes from the compiler */
+/* variable types
+ * numeric assumptions:
+ *	int < reals < complexes
+ *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
+ */
+
+/* 0-10 retain their old (pre LOGICAL*1, etc.) */
+/* values to allow mixing old and new objects. */
+
+#define TYUNKNOWN 0
+#define TYADDR 1
+#define TYSHORT 2
+#define TYLONG 3
+#define TYREAL 4
+#define TYDREAL 5
+#define TYCOMPLEX 6
+#define TYDCOMPLEX 7
+#define TYLOGICAL 8
+#define TYCHAR 9
+#define TYSUBR 10
+#define TYINT1 11
+#define TYLOGICAL1 12
+#define TYLOGICAL2 13
+#ifdef Allow_TYQUAD
+#undef TYQUAD
+#define TYQUAD 14
+#endif
+
+#define	LINTW	24
+#define	LINE	80
+#define	LLOGW	2
+#ifdef Old_list_output
+#define	LLOW	1.0
+#define	LHIGH	1.e9
+#define	LEFMT	" %# .8E"
+#define	LFFMT	" %# .9g"
+#else
+#define	LGFMT	"%.9G"
+#endif
+/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */
+#define	LEFBL	24
+
+typedef union
+{
+	char	flchar;
+	short	flshort;
+	ftnint	flint;
+#ifdef Allow_TYQUAD
+	longint fllongint;
+#endif
+	real	flreal;
+	doublereal	fldouble;
+} flex;
+extern int f__scale;
+#ifdef KR_headers
+extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
+extern int l_read(), l_write();
+#else
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint);
+extern int l_write(ftnint*, char*, ftnlen, ftnint);
+extern void x_wsne(cilist*);
+extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*);
+extern int l_read(ftnint*,char*,ftnlen,ftnint);
+extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*);
+extern int z_rnew(void);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern ftnint L_len;

ext/f2c_libs/lread.c

@@ -0,0 +1,805 @@
+#include "f2c.h"
+#include "fio.h"
+
+/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */
+/* marks in namelist input a la the Fortran 8X Draft published in  */
+/* the May 1989 issue of Fortran Forum. */
+
+
+extern char *f__fmtbuf;
+
+#ifdef Allow_TYQUAD
+static longint f__llx;
+#endif
+
+#ifdef KR_headers
+extern double atof();
+extern char *malloc(), *realloc();
+int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#endif
+
+#include "fmt.h"
+#include "lio.h"
+#include "ctype.h"
+#include "fp.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef KR_headers
+int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void),
+	(*l_ungetc)(int,FILE*);
+#endif
+
+int l_eof;
+
+#define isblnk(x) (f__ltab[x+1]&B)
+#define issep(x) (f__ltab[x+1]&SX)
+#define isapos(x) (f__ltab[x+1]&AX)
+#define isexp(x) (f__ltab[x+1]&EX)
+#define issign(x) (f__ltab[x+1]&SG)
+#define iswhit(x) (f__ltab[x+1]&WH)
+#define SX 1
+#define B 2
+#define AX 4
+#define EX 8
+#define SG 16
+#define WH 32
+char f__ltab[128+1] = {	/* offset one for EOF */
+	0,
+	0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+};
+
+#ifdef ungetc
+ static int
+#ifdef KR_headers
+un_getc(x,f__cf) int x; FILE *f__cf;
+#else
+un_getc(int x, FILE *f__cf)
+#endif
+{ return ungetc(x,f__cf); }
+#else
+#define un_getc ungetc
+#ifdef KR_headers
+ extern int ungetc();
+#else
+extern int ungetc(int, FILE*);	/* for systems with a buggy stdio.h */
+#endif
+#endif
+
+ int
+t_getc(Void)
+{	int ch;
+	if(f__curunit->uend) return(EOF);
+	if((ch=getc(f__cf))!=EOF) return(ch);
+	if(feof(f__cf))
+		f__curunit->uend = l_eof = 1;
+	return(EOF);
+}
+integer e_rsle(Void)
+{
+	int ch;
+	if(f__curunit->uend) return(0);
+	while((ch=t_getc())!='\n')
+		if (ch == EOF) {
+			if(feof(f__cf))
+				f__curunit->uend = l_eof = 1;
+			return EOF;
+			}
+	return(0);
+}
+
+flag f__lquit;
+int f__lcount,f__ltype,nml_read;
+char *f__lchar;
+double f__lx,f__ly;
+#define ERR(x) if(n=(x)) return(n)
+#define GETC(x) (x=(*l_getc)())
+#define Ungetc(x,y) (*l_ungetc)(x,y)
+
+ static int
+#ifdef KR_headers
+l_R(poststar, reqint) int poststar, reqint;
+#else
+l_R(int poststar, int reqint)
+#endif
+{
+	char s[FMAX+EXPMAXDIGS+4];
+	register int ch;
+	register char *sp, *spe, *sp1;
+	long e, exp;
+	int havenum, havestar, se;
+
+	if (!poststar) {
+		if (f__lcount > 0)
+			return(0);
+		f__lcount = 1;
+		}
+#ifdef Allow_TYQUAD
+	f__llx = 0;
+#endif
+	f__ltype = 0;
+	exp = 0;
+	havestar = 0;
+retry:
+	sp1 = sp = s;
+	spe = sp + FMAX;
+	havenum = 0;
+
+	switch(GETC(ch)) {
+		case '-': *sp++ = ch; sp1++; spe++;
+		case '+':
+			GETC(ch);
+		}
+	while(ch == '0') {
+		++havenum;
+		GETC(ch);
+		}
+	while(isdigit(ch)) {
+		if (sp < spe) *sp++ = ch;
+		else ++exp;
+		GETC(ch);
+		}
+	if (ch == '*' && !poststar) {
+		if (sp == sp1 || exp || *s == '-') {
+			errfl(f__elist->cierr,112,"bad repetition count");
+			}
+		poststar = havestar = 1;
+		*sp = 0;
+		f__lcount = atoi(s);
+		goto retry;
+		}
+	if (ch == '.') {
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+		if (reqint)
+			errfl(f__elist->cierr,115,"invalid integer");
+#endif
+		GETC(ch);
+		if (sp == sp1)
+			while(ch == '0') {
+				++havenum;
+				--exp;
+				GETC(ch);
+				}
+		while(isdigit(ch)) {
+			if (sp < spe)
+				{ *sp++ = ch; --exp; }
+			GETC(ch);
+			}
+		}
+	havenum += sp - sp1;
+	se = 0;
+	if (issign(ch))
+		goto signonly;
+	if (havenum && isexp(ch)) {
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+		if (reqint)
+			errfl(f__elist->cierr,115,"invalid integer");
+#endif
+		GETC(ch);
+		if (issign(ch)) {
+signonly:
+			if (ch == '-') se = 1;
+			GETC(ch);
+			}
+		if (!isdigit(ch)) {
+bad:
+			errfl(f__elist->cierr,112,"exponent field");
+			}
+
+		e = ch - '0';
+		while(isdigit(GETC(ch))) {
+			e = 10*e + ch - '0';
+			if (e > EXPMAX)
+				goto bad;
+			}
+		if (se)
+			exp -= e;
+		else
+			exp += e;
+		}
+	(void) Ungetc(ch, f__cf);
+	if (sp > sp1) {
+		++havenum;
+		while(*--sp == '0')
+			++exp;
+		if (exp)
+			sprintf(sp+1, "e%ld", exp);
+		else
+			sp[1] = 0;
+		f__lx = atof(s);
+#ifdef Allow_TYQUAD
+		if (reqint&2 && (se = sp - sp1 + exp) > 14 && se < 20) {
+			/* Assuming 64-bit longint and 32-bit long. */
+			if (exp < 0)
+				sp += exp;
+			if (sp1 <= sp) {
+				f__llx = *sp1 - '0';
+				while(++sp1 <= sp)
+					f__llx = 10*f__llx + (*sp1 - '0');
+				}
+			while(--exp >= 0)
+				f__llx *= 10;
+			if (*s == '-')
+				f__llx = -f__llx;
+			}
+#endif
+		}
+	else
+		f__lx = 0.;
+	if (havenum)
+		f__ltype = TYLONG;
+	else
+		switch(ch) {
+			case ',':
+			case '/':
+				break;
+			default:
+				if (havestar && ( ch == ' '
+						||ch == '\t'
+						||ch == '\n'))
+					break;
+				if (nml_read > 1) {
+					f__lquit = 2;
+					return 0;
+					}
+				errfl(f__elist->cierr,112,"invalid number");
+			}
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+rd_count(ch) register int ch;
+#else
+rd_count(register int ch)
+#endif
+{
+	if (ch < '0' || ch > '9')
+		return 1;
+	f__lcount = ch - '0';
+	while(GETC(ch) >= '0' && ch <= '9')
+		f__lcount = 10*f__lcount + ch - '0';
+	Ungetc(ch,f__cf);
+	return f__lcount <= 0;
+	}
+
+ static int
+l_C(Void)
+{	int ch, nml_save;
+	double lz;
+	if(f__lcount>0) return(0);
+	f__ltype=0;
+	GETC(ch);
+	if(ch!='(')
+	{
+		if (nml_read > 1 && (ch < '0' || ch > '9')) {
+			Ungetc(ch,f__cf);
+			f__lquit = 2;
+			return 0;
+			}
+		if (rd_count(ch))
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"complex format");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		if(GETC(ch)!='*')
+		{
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"no star");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		}
+		if(GETC(ch)!='(')
+		{	Ungetc(ch,f__cf);
+			return(0);
+		}
+	}
+	else
+		f__lcount = 1;
+	while(iswhit(GETC(ch)));
+	Ungetc(ch,f__cf);
+	nml_save = nml_read;
+	nml_read = 0;
+	if (ch = l_R(1,0))
+		return ch;
+	if (!f__ltype)
+		errfl(f__elist->cierr,112,"no real part");
+	lz = f__lx;
+	while(iswhit(GETC(ch)));
+	if(ch!=',')
+	{	(void) Ungetc(ch,f__cf);
+		errfl(f__elist->cierr,112,"no comma");
+	}
+	while(iswhit(GETC(ch)));
+	(void) Ungetc(ch,f__cf);
+	if (ch = l_R(1,0))
+		return ch;
+	if (!f__ltype)
+		errfl(f__elist->cierr,112,"no imaginary part");
+	while(iswhit(GETC(ch)));
+	if(ch!=')') errfl(f__elist->cierr,112,"no )");
+	f__ly = f__lx;
+	f__lx = lz;
+#ifdef Allow_TYQUAD
+	f__llx = 0;
+#endif
+	nml_read = nml_save;
+	return(0);
+}
+
+ static char nmLbuf[256], *nmL_next;
+ static int (*nmL_getc_save)(Void);
+#ifdef KR_headers
+ static int (*nmL_ungetc_save)(/* int, FILE* */);
+#else
+ static int (*nmL_ungetc_save)(int, FILE*);
+#endif
+
+ static int
+nmL_getc(Void)
+{
+	int rv;
+	if (rv = *nmL_next++)
+		return rv;
+	l_getc = nmL_getc_save;
+	l_ungetc = nmL_ungetc_save;
+	return (*l_getc)();
+	}
+
+ static int
+#ifdef KR_headers
+nmL_ungetc(x, f) int x; FILE *f;
+#else
+nmL_ungetc(int x, FILE *f)
+#endif
+{
+	f = f;	/* banish non-use warning */
+	return *--nmL_next = x;
+	}
+
+ static int
+#ifdef KR_headers
+Lfinish(ch, dot, rvp) int ch, dot, *rvp;
+#else
+Lfinish(int ch, int dot, int *rvp)
+#endif
+{
+	char *s, *se;
+	static char what[] = "namelist input";
+
+	s = nmLbuf + 2;
+	se = nmLbuf + sizeof(nmLbuf) - 1;
+	*s++ = ch;
+	while(!issep(GETC(ch)) && ch!=EOF) {
+		if (s >= se) {
+ nmLbuf_ovfl:
+			return *rvp = err__fl(f__elist->cierr,131,what);
+			}
+		*s++ = ch;
+		if (ch != '=')
+			continue;
+		if (dot)
+			return *rvp = err__fl(f__elist->cierr,112,what);
+ got_eq:
+		*s = 0;
+		nmL_getc_save = l_getc;
+		l_getc = nmL_getc;
+		nmL_ungetc_save = l_ungetc;
+		l_ungetc = nmL_ungetc;
+		nmLbuf[1] = *(nmL_next = nmLbuf) = ',';
+		*rvp = f__lcount = 0;
+		return 1;
+		}
+	if (dot)
+		goto done;
+	for(;;) {
+		if (s >= se)
+			goto nmLbuf_ovfl;
+		*s++ = ch;
+		if (!isblnk(ch))
+			break;
+		if (GETC(ch) == EOF)
+			goto done;
+		}
+	if (ch == '=')
+		goto got_eq;
+ done:
+	Ungetc(ch, f__cf);
+	return 0;
+	}
+
+ static int
+l_L(Void)
+{
+	int ch, rv, sawdot;
+
+	if(f__lcount>0)
+		return(0);
+	f__lcount = 1;
+	f__ltype=0;
+	GETC(ch);
+	if(isdigit(ch))
+	{
+		rd_count(ch);
+		if(GETC(ch)!='*')
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"no star");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		GETC(ch);
+	}
+	sawdot = 0;
+	if(ch == '.') {
+		sawdot = 1;
+		GETC(ch);
+		}
+	switch(ch)
+	{
+	case 't':
+	case 'T':
+		if (nml_read && Lfinish(ch, sawdot, &rv))
+			return rv;
+		f__lx=1;
+		break;
+	case 'f':
+	case 'F':
+		if (nml_read && Lfinish(ch, sawdot, &rv))
+			return rv;
+		f__lx=0;
+		break;
+	default:
+		if(isblnk(ch) || issep(ch) || ch==EOF)
+		{	(void) Ungetc(ch,f__cf);
+			return(0);
+		}
+		if (nml_read > 1) {
+			Ungetc(ch,f__cf);
+			f__lquit = 2;
+			return 0;
+			}
+		errfl(f__elist->cierr,112,"logical");
+	}
+	f__ltype=TYLONG;
+	while(!issep(GETC(ch)) && ch!=EOF);
+	Ungetc(ch, f__cf);
+	return(0);
+}
+
+#define BUFSIZE	128
+
+ static int
+l_CHAR(Void)
+{	int ch,size,i;
+	static char rafail[] = "realloc failure";
+	char quote,*p;
+	if(f__lcount>0) return(0);
+	f__ltype=0;
+	if(f__lchar!=NULL) free(f__lchar);
+	size=BUFSIZE;
+	p=f__lchar = (char *)malloc((unsigned int)size);
+	if(f__lchar == NULL)
+		errfl(f__elist->cierr,113,"no space");
+
+	GETC(ch);
+	if(isdigit(ch)) {
+		/* allow Fortran 8x-style unquoted string...	*/
+		/* either find a repetition count or the string	*/
+		f__lcount = ch - '0';
+		*p++ = ch;
+		for(i = 1;;) {
+			switch(GETC(ch)) {
+				case '*':
+					if (f__lcount == 0) {
+						f__lcount = 1;
+#ifndef F8X_NML_ELIDE_QUOTES
+						if (nml_read)
+							goto no_quote;
+#endif
+						goto noquote;
+						}
+					p = f__lchar;
+					goto have_lcount;
+				case ',':
+				case ' ':
+				case '\t':
+				case '\n':
+				case '/':
+					Ungetc(ch,f__cf);
+					/* no break */
+				case EOF:
+					f__lcount = 1;
+					f__ltype = TYCHAR;
+					return *p = 0;
+				}
+			if (!isdigit(ch)) {
+				f__lcount = 1;
+#ifndef F8X_NML_ELIDE_QUOTES
+				if (nml_read) {
+ no_quote:
+					errfl(f__elist->cierr,112,
+						"undelimited character string");
+					}
+#endif
+				goto noquote;
+				}
+			*p++ = ch;
+			f__lcount = 10*f__lcount + ch - '0';
+			if (++i == size) {
+				f__lchar = (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+				if(f__lchar == NULL)
+					errfl(f__elist->cierr,113,rafail);
+				p = f__lchar + i;
+				}
+			}
+		}
+	else	(void) Ungetc(ch,f__cf);
+ have_lcount:
+	if(GETC(ch)=='\'' || ch=='"') quote=ch;
+	else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) {
+		Ungetc(ch,f__cf);
+		return 0;
+		}
+#ifndef F8X_NML_ELIDE_QUOTES
+	else if (nml_read > 1) {
+		Ungetc(ch,f__cf);
+		f__lquit = 2;
+		return 0;
+		}
+#endif
+	else {
+		/* Fortran 8x-style unquoted string */
+		*p++ = ch;
+		for(i = 1;;) {
+			switch(GETC(ch)) {
+				case ',':
+				case ' ':
+				case '\t':
+				case '\n':
+				case '/':
+					Ungetc(ch,f__cf);
+					/* no break */
+				case EOF:
+					f__ltype = TYCHAR;
+					return *p = 0;
+				}
+ noquote:
+			*p++ = ch;
+			if (++i == size) {
+				f__lchar = (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+				if(f__lchar == NULL)
+					errfl(f__elist->cierr,113,rafail);
+				p = f__lchar + i;
+				}
+			}
+		}
+	f__ltype=TYCHAR;
+	for(i=0;;)
+	{	while(GETC(ch)!=quote && ch!='\n'
+			&& ch!=EOF && ++i<size) *p++ = ch;
+		if(i==size)
+		{
+		newone:
+			f__lchar= (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+			if(f__lchar == NULL)
+				errfl(f__elist->cierr,113,rafail);
+			p=f__lchar+i-1;
+			*p++ = ch;
+		}
+		else if(ch==EOF) return(EOF);
+		else if(ch=='\n')
+		{	if(*(p-1) != '\\') continue;
+			i--;
+			p--;
+			if(++i<size) *p++ = ch;
+			else goto newone;
+		}
+		else if(GETC(ch)==quote)
+		{	if(++i<size) *p++ = ch;
+			else goto newone;
+		}
+		else
+		{	(void) Ungetc(ch,f__cf);
+			*p = 0;
+			return(0);
+		}
+	}
+}
+
+ int
+#ifdef KR_headers
+c_le(a) cilist *a;
+#else
+c_le(cilist *a)
+#endif
+{
+	if(!f__init)
+		f_init();
+	f__fmtbuf="list io";
+	f__curunit = &f__units[a->ciunit];
+	if(a->ciunit>=MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"stler");
+	f__scale=f__recpos=0;
+	f__elist=a;
+	if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit))
+		err(a->cierr,102,"lio");
+	f__cf=f__curunit->ufd;
+	if(!f__curunit->ufmt) err(a->cierr,103,"lio")
+	return(0);
+}
+
+ int
+#ifdef KR_headers
+l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+#else
+l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
+#endif
+{
+#define Ptr ((flex *)ptr)
+	int i,n,ch;
+	doublereal *yy;
+	real *xx;
+	for(i=0;i<*number;i++)
+	{
+		if(f__lquit) return(0);
+		if(l_eof)
+			err(f__elist->ciend, EOF, "list in")
+		if(f__lcount == 0) {
+			f__ltype = 0;
+			for(;;)  {
+				GETC(ch);
+				switch(ch) {
+				case EOF:
+					err(f__elist->ciend,(EOF),"list in")
+				case ' ':
+				case '\t':
+				case '\n':
+					continue;
+				case '/':
+					f__lquit = 1;
+					goto loopend;
+				case ',':
+					f__lcount = 1;
+					goto loopend;
+				default:
+					(void) Ungetc(ch, f__cf);
+					goto rddata;
+				}
+			}
+		}
+	rddata:
+		switch((int)type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+			ERR(l_R(0,1));
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			ERR(l_R(0,0));
+			break;
+#ifdef TYQUAD
+		case TYQUAD:
+			n = l_R(0,2);
+			if (n)
+				return n;
+			break;
+#endif
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			ERR(l_C());
+			break;
+		case TYLOGICAL1:
+		case TYLOGICAL2:
+		case TYLOGICAL:
+			ERR(l_L());
+			break;
+		case TYCHAR:
+			ERR(l_CHAR());
+			break;
+		}
+	while (GETC(ch) == ' ' || ch == '\t');
+	if (ch != ',' || f__lcount > 1)
+		Ungetc(ch,f__cf);
+	loopend:
+		if(f__lquit) return(0);
+		if(f__cf && ferror(f__cf)) {
+			clearerr(f__cf);
+			errfl(f__elist->cierr,errno,"list in");
+			}
+		if(f__ltype==0) goto bump;
+		switch((int)type)
+		{
+		case TYINT1:
+		case TYLOGICAL1:
+			Ptr->flchar = (char)f__lx;
+			break;
+		case TYLOGICAL2:
+		case TYSHORT:
+			Ptr->flshort = (short)f__lx;
+			break;
+		case TYLOGICAL:
+		case TYLONG:
+			Ptr->flint = (ftnint)f__lx;
+			break;
+#ifdef Allow_TYQUAD
+		case TYQUAD:
+			if (!(Ptr->fllongint = f__llx))
+				Ptr->fllongint = f__lx;
+			break;
+#endif
+		case TYREAL:
+			Ptr->flreal=f__lx;
+			break;
+		case TYDREAL:
+			Ptr->fldouble=f__lx;
+			break;
+		case TYCOMPLEX:
+			xx=(real *)ptr;
+			*xx++ = f__lx;
+			*xx = f__ly;
+			break;
+		case TYDCOMPLEX:
+			yy=(doublereal *)ptr;
+			*yy++ = f__lx;
+			*yy = f__ly;
+			break;
+		case TYCHAR:
+			b_char(f__lchar,ptr,len);
+			break;
+		}
+	bump:
+		if(f__lcount>0) f__lcount--;
+		ptr += len;
+		if (nml_read)
+			nml_read++;
+	}
+	return(0);
+#undef Ptr
+}
+#ifdef KR_headers
+integer s_rsle(a) cilist *a;
+#else
+integer s_rsle(cilist *a)
+#endif
+{
+	int n;
+
+	f__reading=1;
+	f__external=1;
+	f__formatted=1;
+	if(n=c_le(a)) return(n);
+	f__lioproc = l_read;
+	f__lquit = 0;
+	f__lcount = 0;
+	l_eof = 0;
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	if(f__curunit->uend)
+		err(f__elist->ciend,(EOF),"read start");
+	l_getc = t_getc;
+	l_ungetc = un_getc;
+	f__doend = xrd_SL;
+	return(0);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/lwrite.c

@@ -0,0 +1,314 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#include "lio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ftnint L_len;
+int f__Aquote;
+
+ static VOID
+donewrec(Void)
+{
+	if (f__recpos)
+		(*f__donewrec)();
+	}
+
+ static VOID
+#ifdef KR_headers
+lwrt_I(n) longint n;
+#else
+lwrt_I(longint n)
+#endif
+{
+	char *p;
+	int ndigit, sign;
+
+	p = f__icvt(n, &ndigit, &sign, 10);
+	if(f__recpos + ndigit >= L_len)
+		donewrec();
+	PUT(' ');
+	if (sign)
+		PUT('-');
+	while(*p)
+		PUT(*p++);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_L(n, len) ftnint n; ftnlen len;
+#else
+lwrt_L(ftnint n, ftnlen len)
+#endif
+{
+	if(f__recpos+LLOGW>=L_len)
+		donewrec();
+	wrt_L((Uint *)&n,LLOGW, len);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_A(p,len) char *p; ftnlen len;
+#else
+lwrt_A(char *p, ftnlen len)
+#endif
+{
+	int a;
+	char *p1, *pe;
+
+	a = 0;
+	pe = p + len;
+	if (f__Aquote) {
+		a = 3;
+		if (len > 1 && p[len-1] == ' ') {
+			while(--len > 1 && p[len-1] == ' ');
+			pe = p + len;
+			}
+		p1 = p;
+		while(p1 < pe)
+			if (*p1++ == '\'')
+				a++;
+		}
+	if(f__recpos+len+a >= L_len)
+		donewrec();
+	if (a
+#ifndef OMIT_BLANK_CC
+		|| !f__recpos
+#endif
+		)
+		PUT(' ');
+	if (a) {
+		PUT('\'');
+		while(p < pe) {
+			if (*p == '\'')
+				PUT('\'');
+			PUT(*p++);
+			}
+		PUT('\'');
+		}
+	else
+		while(p < pe)
+			PUT(*p++);
+}
+
+ static int
+#ifdef KR_headers
+l_g(buf, n) char *buf; double n;
+#else
+l_g(char *buf, double n)
+#endif
+{
+#ifdef Old_list_output
+	doublereal absn;
+	char *fmt;
+
+	absn = n;
+	if (absn < 0)
+		absn = -absn;
+	fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
+#ifdef USE_STRLEN
+	sprintf(buf, fmt, n);
+	return strlen(buf);
+#else
+	return sprintf(buf, fmt, n);
+#endif
+
+#else
+	register char *b, c, c1;
+
+	b = buf;
+	*b++ = ' ';
+	if (n < 0) {
+		*b++ = '-';
+		n = -n;
+		}
+	else
+		*b++ = ' ';
+	if (n == 0) {
+#ifdef SIGNED_ZEROS
+		if (signbit_f2c(&n))
+			*b++ = '-';
+#endif
+		*b++ = '0';
+		*b++ = '.';
+		*b = 0;
+		goto f__ret;
+		}
+	sprintf(b, LGFMT, n);
+	switch(*b) {
+#ifndef WANT_LEAD_0
+		case '0':
+			while(b[0] = b[1])
+				b++;
+			break;
+#endif
+		case 'i':
+		case 'I':
+			/* Infinity */
+		case 'n':
+		case 'N':
+			/* NaN */
+			while(*++b);
+			break;
+
+		default:
+	/* Fortran 77 insists on having a decimal point... */
+		    for(;; b++)
+			switch(*b) {
+			case 0:
+				*b++ = '.';
+				*b = 0;
+				goto f__ret;
+			case '.':
+				while(*++b);
+				goto f__ret;
+			case 'E':
+				for(c1 = '.', c = 'E';  *b = c1;
+					c1 = c, c = *++b);
+				goto f__ret;
+			}
+		}
+ f__ret:
+	return b - buf;
+#endif
+	}
+
+ static VOID
+#ifdef KR_headers
+l_put(s) register char *s;
+#else
+l_put(register char *s)
+#endif
+{
+#ifdef KR_headers
+	register void (*pn)() = f__putn;
+#else
+	register void (*pn)(int) = f__putn;
+#endif
+	register int c;
+
+	while(c = *s++)
+		(*pn)(c);
+	}
+
+ static VOID
+#ifdef KR_headers
+lwrt_F(n) double n;
+#else
+lwrt_F(double n)
+#endif
+{
+	char buf[LEFBL];
+
+	if(f__recpos + l_g(buf,n) >= L_len)
+		donewrec();
+	l_put(buf);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_C(a,b) double a,b;
+#else
+lwrt_C(double a, double b)
+#endif
+{
+	char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
+	int al, bl;
+
+	al = l_g(bufa, a);
+	for(ba = bufa; *ba == ' '; ba++)
+		--al;
+	bl = l_g(bufb, b) + 1;	/* intentionally high by 1 */
+	for(bb = bufb; *bb == ' '; bb++)
+		--bl;
+	if(f__recpos + al + bl + 3 >= L_len)
+		donewrec();
+#ifdef OMIT_BLANK_CC
+	else
+#endif
+	PUT(' ');
+	PUT('(');
+	l_put(ba);
+	PUT(',');
+	if (f__recpos + bl >= L_len) {
+		(*f__donewrec)();
+#ifndef OMIT_BLANK_CC
+		PUT(' ');
+#endif
+		}
+	l_put(bb);
+	PUT(')');
+}
+
+ int
+#ifdef KR_headers
+l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+#else
+l_write(ftnint *number, char *ptr, ftnlen len, ftnint type)
+#endif
+{
+#define Ptr ((flex *)ptr)
+	int i;
+	longint x;
+	double y,z;
+	real *xx;
+	doublereal *yy;
+	for(i=0;i< *number; i++)
+	{
+		switch((int)type)
+		{
+		default: f__fatal(117,"unknown type in lio");
+		case TYINT1:
+			x = Ptr->flchar;
+			goto xint;
+		case TYSHORT:
+			x=Ptr->flshort;
+			goto xint;
+#ifdef Allow_TYQUAD
+		case TYQUAD:
+			x = Ptr->fllongint;
+			goto xint;
+#endif
+		case TYLONG:
+			x=Ptr->flint;
+		xint:	lwrt_I(x);
+			break;
+		case TYREAL:
+			y=Ptr->flreal;
+			goto xfloat;
+		case TYDREAL:
+			y=Ptr->fldouble;
+		xfloat: lwrt_F(y);
+			break;
+		case TYCOMPLEX:
+			xx= &Ptr->flreal;
+			y = *xx++;
+			z = *xx;
+			goto xcomplex;
+		case TYDCOMPLEX:
+			yy = &Ptr->fldouble;
+			y= *yy++;
+			z = *yy;
+		xcomplex:
+			lwrt_C(y,z);
+			break;
+		case TYLOGICAL1:
+			x = Ptr->flchar;
+			goto xlog;
+		case TYLOGICAL2:
+			x = Ptr->flshort;
+			goto xlog;
+		case TYLOGICAL:
+			x = Ptr->flint;
+		xlog:	lwrt_L(Ptr->flint, len);
+			break;
+		case TYCHAR:
+			lwrt_A(ptr,len);
+			break;
+		}
+		ptr += len;
+	}
+	return(0);
+}
+#ifdef __cplusplus
+}
+#endif

ext/f2c_libs/main.c

@@ -0,0 +1,147 @@
+/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
+
+#include "stdio.h"
+#include "signal1.h"
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifndef KR_headers
+#undef VOID
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+#ifndef VOID
+#define VOID void
+#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(Sigarg)
+{
+Use_Sigarg;
+sig_die("Floating Exception", 1);
+}
+
+
+static VOID sigidie(Sigarg)
+{
+Use_Sigarg;
+sig_die("IOT Trap", 1);
+}
+
+#ifdef SIGQUIT
+static VOID sigqdie(Sigarg)
+{
+Use_Sigarg;
+sig_die("Quit signal", 1);
+}
+#endif
+
+
+static VOID sigindie(Sigarg)
+{
+Use_Sigarg;
+sig_die("Interrupt", 0);
+}
+
+static VOID sigtdie(Sigarg)
+{
+Use_Sigarg;
+sig_die("Killed", 0);
+}
+
+#ifdef SIGTRAP
+static VOID sigtrdie(Sigarg)
+{
+Use_Sigarg;
+sig_die("Trace trap", 1);
+}
+#endif
+
+
+int xargc;
+char **xargv;
+
+#ifdef __cplusplus
+	}
+#endif
+
+#ifdef KR_headers
+main(argc, argv) int argc; char **argv;
+#else
+main(int argc, char **argv)
+#endif
+{
+xargc = argc;
+xargv = argv;
+signal1(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */
+#ifdef SIGIOT
+signal1(SIGIOT, sigidie);
+#endif
+#ifdef SIGTRAP
+signal1(SIGTRAP, sigtrdie);
+#endif
+#ifdef SIGQUIT
+if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
+	signal1(SIGQUIT, SIG_IGN);
+#endif
+if(signal1(SIGINT, sigindie) == SIG_IGN)
+	signal1(SIGINT, SIG_IGN);
+signal1(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