Change install rule

Makefile

@@ -1,6 +1,6 @@
 
 install: 
-	source ./script_install.sh
+	. ./script_install.sh
 
 run: 
 	./run_simulation.sh
@@ -9,7 +9,7 @@ fftma:
 	cd fftma_module/gen && python3 setup.py install --user
 
 binaries: 
-	./script_fortran.sh
+	cd ./tools/connec && make clean && make all
 
 test: binaries
 	cd tests/integration && python3 -m unittest test.py

tools/connec/Makefile

@@ -0,0 +1,13 @@
+all: conec2d conec3d
+libf2c.a:
+	cd libf2c && make
+connec2d.o:
+	gcc ./src/connec2d.c -c -o connec2d.o
+connec3d.o:
+	gcc ./src/connec3d.c -c -o connec3d.o
+conec2d: connec2d.o libf2c.a
+	gcc connec2d.o ./libf2c/libf2c.a -lm -o conec2d
+conec3d: connec3d.o libf2c.a
+	gcc connec3d.o ./libf2c/libf2c.a -lm -o conec3d
+clean:
+	rm -f conec2d conec3d

tools/connec/libf2c/Notice

@@ -0,0 +1,23 @@
+/****************************************************************
+Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+

tools/connec/libf2c/README

@@ -0,0 +1,374 @@
+As shipped, "makefile" is a copy of "makefile.u", a Unix makefile.
+Variants for other systems have names of the form makefile.* and
+have initial comments saying how to invoke them.  You may wish to
+copy one of the other makefile.* files to makefile.
+
+If you use a C++ compiler, first say
+
+	make hadd
+
+to create a suitable f2c.h from f2c.h0 and f2ch.add.  Otherwise,
+
+	make f2c.h
+
+will just copy f2c.h0 to f2c.h .
+
+If your compiler does not recognize ANSI C headers,
+compile with KR_headers defined:  either add -DKR_headers
+to the definition of CFLAGS in the makefile, or insert
+
+#define KR_headers
+
+at the top of f2c.h .
+
+If your system lacks onexit() and you are not using an ANSI C
+compiler, then you should compile main.c with NO_ONEXIT defined.
+See the comments about onexit in makefile.u.
+
+If your system has a double drem() function such that drem(a,b)
+is the IEEE remainder function (with double a, b), then you may
+wish to compile r_mod.c and d_mod.c with IEEE_drem defined.
+
+To check for transmission errors, issue the command
+	make check
+or
+	make -f makefile.u check
+
+This assumes you have the xsum program whose source, xsum.c,
+is distributed as part of "all from f2c/src", and that it
+is installed somewhere in your search path.  If you do not
+have xsum, you can obtain xsum.c by sending the following E-mail
+message to netlib@netlib.org
+	send xsum.c from f2c/src
+
+For convenience, the f2c.h0 in this directory is a copy of netlib's
+"f2c.h from f2c".  It is best to install f2c.h in a standard place,
+so "include f2c.h" will work in any directory without further ado.
+Beware that the makefiles do not cause recompilation when f2c.h is
+changed.
+
+On machines, such as those using a DEC Alpha processor, on which
+sizeof(short) == 2, sizeof(int) == sizeof(float) == 4, and
+sizeof(long) == sizeof(double) == 8, it suffices to modify f2c.h by
+removing the first occurrence of "long " on each line containing
+"long ".  On Unix systems, you can do this by issuing the commands
+	mv f2c.h f2c.h0
+	sed 's/long int /int /' f2c.h0 >f2c.h
+On such machines, one can enable INTEGER*8 by uncommenting the typedefs
+of longint and ulongint in f2c.h and adjusting them, so they read
+	typedef long longint;
+	typedef unsigned long ulongint;
+and by compiling libf2c with -DAllow_TYQUAD, as discussed below.
+
+
+Most of the routines in libf2c are support routines for Fortran
+intrinsic functions or for operations that f2c chooses not
+to do "in line".  There are a few exceptions, summarized below --
+functions and subroutines that appear to your program as ordinary
+external Fortran routines.
+
+If you use the REAL valued functions listed below (ERF, ERFC,
+DTIME, and ETIME) with "f2c -R", then you need to compile the
+corresponding source files with -DREAL=float.  To do this, it is
+perhaps simplest to add "-DREAL=float" to CFLAGS in the makefile.
+
+1.	CALL ABORT prints a message and causes a core dump.
+
+2.	ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION
+	error functions (with x REAL and d DOUBLE PRECISION);
+	DERF must be declared DOUBLE PRECISION in your program.
+	Both ERF and DERF assume your C library provides the
+	underlying erf() function (which not all systems do).
+
+3.	ERFC(r) and DERFC(d) are the complementary error functions:
+	ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d)
+	(except that their results may be more accurate than
+	explicitly evaluating the above formulae would give).
+	Again, ERFC and r are REAL, and DERFC and d are DOUBLE
+	PRECISION (and must be declared as such in your program),
+	and ERFC and DERFC rely on your system's erfc().
+
+4.	CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER
+	variable, sets s to the n-th command-line argument (or to
+	all blanks if there are fewer than n command-line arguments);
+	CALL GETARG(0,s) sets s to the name of the program (on systems
+	that support this feature).  See IARGC below.
+
+5.	CALL GETENV(name, value), where name and value are of type
+	CHARACTER, sets value to the environment value, $name, of
+	name (or to blanks if $name has not been set).
+
+6.	NARGS = IARGC() sets NARGS to the number of command-line
+	arguments (an INTEGER value).
+
+7.	CALL SIGNAL(n,func), where n is an INTEGER and func is an
+	EXTERNAL procedure, arranges for func to be invoked when n
+	occurs (on systems where this makes sense).
+	
+If your compiler complains about the signal calls in main.c, s_paus.c,
+and signal_.c, you may need to adjust signal1.h suitably.  See the
+comments in signal1.h.
+
+8.	ETIME(ARR) and DTIME(ARR) are REAL functions that return
+	execution times.  ARR is declared REAL ARR(2).  The elapsed
+	user and system CPU times are stored in ARR(1) and ARR(2),
+	respectively.  ETIME returns the total elapsed CPU time,
+	i.e., ARR(1) + ARR(2).  DTIME returns total elapsed CPU
+	time since the previous call on DTIME.
+
+9.	CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes
+	cmd to the system's command processor (on systems where
+	this can be done).
+
+10.	CALL FLUSH flushes all buffers.
+
+11.	FTELL(i) is an INTEGER function that returns the current
+	offset of Fortran unit i (or -1 if unit i is not open).
+
+12.	CALL FSEEK(i, offset, whence, *errlab) attemps to move
+	Fortran unit i to the specified offset: absolute offset
+	if whence = 0; relative to the current offset if whence = 1;
+	relative to the end of the file if whence = 2.  It branches
+	to label errlab if unit i is not open or if the call
+	otherwise fails.
+
+The routines whose objects are makefile.u's $(I77) are for I/O.
+The following comments apply to them.
+
+If your system lacks /usr/include/local.h ,
+then you should create an appropriate local.h in
+this directory.  An appropriate local.h may simply
+be empty, or it may #define VAX or #define CRAY
+(or whatever else you must do to make fp.h work right).
+Alternatively, edit fp.h to suite your machine.
+
+If your system lacks /usr/include/fcntl.h , then you
+should simply create an empty fcntl.h in this directory.
+If your compiler then complains about creat and open not
+having a prototype, compile with OPEN_DECL defined.
+On many systems, open and creat are declared in fcntl.h .
+
+If your system's sprintf does not work the way ANSI C
+specifies -- specifically, if it does not return the
+number of characters transmitted -- then insert the line
+
+#define USE_STRLEN
+
+at the end of fmt.h .  This is necessary with
+at least some versions of Sun software.
+In particular, if you get a warning about an improper
+pointer/integer combination in compiling wref.c, then
+you need to compile with -DUSE_STRLEN .
+
+If your system's fopen does not like the ANSI binary
+reading and writing modes "rb" and "wb", then you should
+compile open.c with NON_ANSI_RW_MODES #defined.
+
+If you get error messages about references to cf->_ptr
+and cf->_base when compiling wrtfmt.c and wsfe.c or to
+stderr->_flag when compiling err.c, then insert the line
+
+#define NON_UNIX_STDIO
+
+at the beginning of fio.h, and recompile everything (or
+at least those modules that contain NON_UNIX_STDIO).
+
+Unformatted sequential records consist of a length of record
+contents, the record contents themselves, and the length of
+record contents again (for backspace).  Prior to 17 Oct. 1991,
+the length was of type int; now it is of type long, but you
+can change it back to int by inserting
+
+#define UIOLEN_int
+
+at the beginning of fio.h.  This affects only sue.c and uio.c .
+
+If you have a really ancient K&R C compiler that does not understand
+void, add -Dvoid=int to the definition of CFLAGS in the makefile.
+
+On VAX, Cray, or Research Tenth-Edition Unix systems, you may
+need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS
+to make fp.h work correctly.  Alternatively, you may need to
+edit fp.h to suit your machine.
+
+If your compiler complains about the signal calls in main.c, s_paus.c,
+and signal_.c, you may need to adjust signal1.h suitably.  See the
+comments in signal1.h.
+
+You may need to supply the following non-ANSI routines:
+
+  fstat(int fileds, struct stat *buf) is similar
+to stat(char *name, struct stat *buf), except that
+the first argument, fileds, is the file descriptor
+returned by open rather than the name of the file.
+fstat is used in the system-dependent routine
+canseek (in the libf2c source file err.c), which
+is supposed to return 1 if it's possible to issue
+seeks on the file in question, 0 if it's not; you may
+need to suitably modify err.c .  On non-UNIX systems,
+you can avoid references to fstat and stat by compiling
+with NON_UNIX_STDIO defined; in that case, you may need
+to supply access(char *Name,0), which is supposed to
+return 0 if file Name exists, nonzero otherwise.
+
+  char * mktemp(char *buf) is supposed to replace the
+6 trailing X's in buf with a unique number and then
+return buf.  The idea is to get a unique name for
+a temporary file.
+
+On non-UNIX systems, you may need to change a few other,
+e.g.: the form of name computed by mktemp() in endfile.c and
+open.c; the use of the open(), close(), and creat() system
+calls in endfile.c, err.c, open.c; and the modes in calls on
+fopen() and fdopen() (and perhaps the use of fdopen() itself
+-- it's supposed to return a FILE* corresponding to a given
+an integer file descriptor) in err.c and open.c (component ufmt
+of struct unit is 1 for formatted I/O -- text mode on some systems
+-- and 0 for unformatted I/O -- binary mode on some systems).
+Compiling with -DNON_UNIX_STDIO omits all references to creat()
+and almost all references to open() and close(), the exception
+being in the function f__isdev() (in open.c).
+
+If you wish to use translated Fortran that has funny notions
+of record length for direct unformatted I/O (i.e., that assumes
+RECL= values in OPEN statements are not bytes but rather counts
+of some other units -- e.g., 4-character words for VMS), then you
+should insert an appropriate #define for url_Adjust at the
+beginning of open.c .  For VMS Fortran, for example,
+#define url_Adjust(x) x *= 4
+would suffice.
+
+By default, Fortran I/O units 5, 6, and 0 are pre-connected to
+stdin, stdout, and stderr, respectively.  You can change this
+behavior by changing f_init() in err.c to suit your needs.
+Note that f2c assumes READ(*... means READ(5... and WRITE(*...
+means WRITE(6... .  Moreover, an OPEN(n,... statement that does
+not specify a file name (and does not specify STATUS='SCRATCH')
+assumes FILE='fort.n' .  You can change this by editing open.c
+and endfile.c suitably.
+
+Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units
+0, 1, ..., 99 are available, i.e., the highest allowed unit number
+is MXUNIT - 1.
+
+Lines protected from compilation by #ifdef Allow_TYQUAD
+are for a possible extension to 64-bit integers in which
+integer = int = 32 bits and longint = long = 64 bits.
+
+The makefile does not attempt to compile pow_qq.c, qbitbits.c,
+and qbitshft.c, which are meant for use with INTEGER*8.  To use
+INTEGER*8, you must modify f2c.h to declare longint and ulongint
+appropriately; then add $(QINT) to the end of the makefile's
+dependency list for libf2c.a (if makefile is a copy of makefile.u;
+for the PC makefiles, add pow_qq.obj qbitbits.obj qbitshft.obj
+to the library's dependency list and adjust libf2c.lbc or libf2c.sy
+accordingly).  Also add -DAllow_TYQUAD to the makefile's CFLAGS
+assignment.  To make longint and ulongint available, it may suffice
+to add -DINTEGER_STAR_8 to the CFLAGS assignment.
+
+Following Fortran 90, s_cat.c and s_copy.c allow the target of a
+(character string) assignment to be appear on its right-hand, at
+the cost of some extra overhead for all run-time concatenations.
+If you prefer the  extra efficiency that comes with the Fortran 77
+requirement that the left-hand side of a character assignment not
+be involved in the right-hand side, compile s_cat.c and s_copy.c
+with -DNO_OVERWRITE .
+
+Extensions (Feb. 1993) to NAMELIST processing:
+ 1. Reading a ? instead of &name (the start of a namelist) causes
+the namelist being sought to be written to stdout (unit 6);
+to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
+ 2. Reading the wrong namelist name now leads to an error message
+and an attempt to skip input until the right namelist name is found;
+to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
+ 3. Namelist writes now insert newlines before each variable; to omit
+this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
+ 4. (Sept. 1995) When looking for the &name that starts namelist
+input, lines whose first non-blank character is something other
+than &, $, or ? are treated as comment lines and ignored, unless
+rsne.c is compiled with -DNo_Namelist_Comments.
+
+Nonstandard extension (Feb. 1993) to open: for sequential files,
+ACCESS='APPEND' (or access='anything else starting with "A" or "a"')
+causes the file to be positioned at end-of-file, so a write will
+append to the file.
+
+Some buggy Fortran programs use unformatted direct I/O to write
+an incomplete record and later read more from that record than
+they have written.  For records other than the last, the unwritten
+portion of the record reads as binary zeros.  The last record is
+a special case: attempting to read more from it than was written
+gives end-of-file -- which may help one find a bug.  Some other
+Fortran I/O libraries treat the last record no differently than
+others and thus give no help in finding the bug of reading more
+than was written.  If you wish to have this behavior, compile
+uio.c with -DPad_UDread .
+
+If you want to be able to catch write failures (e.g., due to a
+disk being full) with an ERR= specifier, compile dfe.c, due.c,
+sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH.  This will lead to
+slower execution and more I/O, but should make ERR= work as
+expected, provided fflush returns an error return when its
+physical write fails.
+
+Carriage controls are meant to be interpreted by the UNIX col
+program (or a similar program).  Sometimes it's convenient to use
+only ' ' as the carriage control character (normal single spacing).
+If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted
+external output lines will have an initial ' ' quietly omitted,
+making use of the col program unnecessary with output that only
+has ' ' for carriage control.
+
+The Fortran 77 Standard leaves it up to the implementation whether
+formatted writes of floating-point numbers of absolute value < 1 have
+a zero before the decimal point.  By default, libI77 omits such
+superfluous zeros, but you can cause them to appear by compiling
+lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 .
+
+If your (Unix) system lacks a ranlib command, you don't need it.
+Either comment out the makefile's ranlib invocation, or install
+a harmless "ranlib" command somewhere in your PATH, such as the
+one-line shell script
+
+	exit 0
+
+or (on some systems)
+
+	exec /usr/bin/ar lts $1 >/dev/null
+
+By default, the routines that implement complex and double complex
+division, c_div.c and z_div.c, call sig_die to print an error message
+and exit if they see a divisor of 0, as this is sometimes helpful for
+debugging.  On systems with IEEE arithmetic, compiling c_div.c and
+z_div.c with -DIEEE_COMPLEX_DIVIDE causes them instead to set both
+the real and imaginary parts of the result to +INFINITY if the
+numerator is nonzero, or to NaN if it vanishes.
+
+Nowadays most Unix and Linux systems have function
+	int ftruncate(int fildes, off_t len);
+defined in system header file unistd.h that adjusts the length of file
+descriptor fildes to length len.  Unless endfile.c is compiled with
+-DNO_TRUNCATE, endfile.c #includes "unistd.h" and calls ftruncate() if
+necessary to shorten files.  If your system lacks ftruncate(), compile
+endfile.c with -DNO_TRUNCATE to make endfile.c use the older and more
+portable scheme of shortening a file by copying to a temporary file
+and back again.
+
+The initializations for "f2c -trapuv" are done by _uninit_f2c(),
+whose source is uninit.c, introduced June 2001.  On IEEE-arithmetic
+systems, _uninit_f2c should initialize floating-point variables to
+signaling NaNs and, at its first invocation, should enable the
+invalid operation exception.  Alas, the rules for distinguishing
+signaling from quiet NaNs were not specified in the IEEE P754 standard,
+nor were the precise means of enabling and disabling IEEE-arithmetic
+exceptions, and these details are thus system dependent.  There are
+#ifdef's in uninit.c that specify them for some popular systems.  If
+yours is not one of these systems, it may take some detective work to
+discover the appropriate details for your system.  Sometimes it helps
+to look in the standard include directories for header files with
+relevant-sounding names, such as ieeefp.h, nan.h, or trap.h, and
+it may be simplest to run experiments to see what distinguishes a
+signaling from a quiet NaN.  (If x is initialized to a signaling
+NaN and the invalid operation exception is masked off, as it should
+be by default on IEEE-arithmetic systems, then computing, say,
+y = x + 1 will yield a quiet NaN.)

tools/connec/libf2c/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(const char*,int);
+
+int abort_(void)
+#endif
+{
+sig_die("Fortran abort routine called", 1);
+return 0;	/* not reached */
+}
+#ifdef __cplusplus
+}
+#endif

tools/connec/libf2c/arith.h

@@ -0,0 +1,8 @@
+#define IEEE_8087
+#define Arith_Kind_ASL 1
+#define Long int
+#define Intcast (int)(long)
+#define Double_Align
+#define X64_bit_pointers
+#define QNaN0 0x0
+#define QNaN1 0xfff80000

tools/connec/libf2c/arithchk.c

@@ -0,0 +1,267 @@
+/****************************************************************
+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 <string.h>	/* possibly for ssize_t */
+#include <math.h>
+#include <errno.h>
+#include <sys/types.h>	/* another possible place for ssize_t */
+
+#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(void)
+{
+	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(void)
+{
+	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(void)
+{
+	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(void)
+{
+	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(void)
+{
+	double t;
+
+	errno = 0;
+	t = log(t_nan);
+	if (errno == 0)
+		return 1;
+	errno = 0;
+	t = sqrt(t_nan);
+	return errno == 0;
+	}
+
+ void
+get_nanbits(unsigned int *b, int k)
+{
+	union { double d; unsigned int z[2]; } u, u1, u2;
+
+	k = 2 - k;
+	u1.z[k] = u2.z[k] = 0x7ff00000;
+	u1.z[1-k] = u2.z[1-k] = 0;
+	u.d = u1.d - u2.d;	/* Infinity - Infinity */
+	b[0] = u.z[0];
+	b[1] = u.z[1];
+	}
+
+ int
+main(void)
+{
+	FILE *f;
+	Akind *a = 0;
+	int Ldef = 0;
+	size_t sa, sb;
+	unsigned int nanbits[2];
+
+	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) > sizeof(long)
+		 && sizeof(long long) == sizeof(void*))
+			fprintf(f, "#define LONG_LONG_POINTERS\n");
+		if (sizeof(long long) < 8)
+#endif
+			fprintf(f, "#define NO_LONG_LONG\n");
+#ifdef NO_SSIZE_T /*{{*/
+		if (sizeof(size_t) == sizeof(long))
+			fprintf(f, "#define ssize_t long\n");
+		else if (sizeof(size_t) == sizeof(int))
+			fprintf(f, "#define ssize_t int\n");
+#ifndef NO_LONG_LONG
+		else if (sizeof(size_t) == sizeof(long long))
+			fprintf(f, "#define ssize_t long long\n");
+#endif
+		else
+			fprintf(f, "#define ssize_t signed size_t\n"); /* punt */
+#else /*}{*/
+		if (sizeof(size_t) != sizeof(ssize_t))
+			fprintf(f, "/* sizeof(size_t) = %d but sizeof(ssize_t) = %d */\n",
+				(int)sizeof(size_t), (int)sizeof(ssize_t));
+#endif /*}}*/
+		if (a->kind <= 2) {
+			if (fzcheck())
+				fprintf(f, "#define Sudden_Underflow\n");
+			t_nan = -a->kind;
+			if (need_nancheck())
+				fprintf(f, "#define NANCHECK\n");
+			if (sizeof(double) == 2*sizeof(unsigned int)) {
+				get_nanbits(nanbits, a->kind);
+				fprintf(f, "#define QNaN0 0x%x\n", nanbits[0]);
+				fprintf(f, "#define QNaN1 0x%x\n", nanbits[1]);
+				}
+			}
+		return 0;
+		}
+	fprintf(f, "/* Unknown arithmetic */\n");
+	return 1;
+	}
+
+#ifdef __sun
+#ifdef __i386
+/* kludge for Intel Solaris */
+void fpsetprec(int x) { }
+#endif
+#endif

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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(const 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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/comptry.bat

@@ -0,0 +1,13 @@
+%*
+if errorlevel 1 goto nolonglong
+exit 0
+:nolonglong
+%* -DNO_LONG_LONG
+if errorlevel 1 goto nossizet
+exit 0
+:nossizet
+%* -DNO_SSIZE_T
+if errorlevel 1 goto noboth
+exit 0
+:noboth
+%* -DNO_LONG_LONG -DNO_SSIZE_T

tools/connec/libf2c/ctype.c

@@ -0,0 +1,2 @@
+#define My_ctype_DEF
+#include "ctype.h"

tools/connec/libf2c/ctype.h

@@ -0,0 +1,47 @@
+/*  Custom ctype.h to overcome trouble with recent versions of Linux libc.a */
+
+#ifdef NO_My_ctype
+#include <ctype.h>
+#else /*{*/
+#ifndef My_ctype_DEF
+extern char My_ctype[];
+#else /*{*/
+char My_ctype[264] = {
+	0, 0, 0, 0, 0, 0, 0, 0,
+	0, 0, 0, 0, 0, 0, 0, 0,
+	0, 2, 2, 2, 2, 2, 0, 0,
+	0, 0, 0, 0, 0, 0, 0, 0,
+	0, 0, 0, 0, 0, 0, 0, 0,
+	2, 0, 0, 0, 0, 0, 0, 0,
+	0, 0, 0, 0, 0, 0, 0, 0,
+	1, 1, 1, 1, 1, 1, 1, 1,
+	1, 1, 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, 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, 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,
+	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, 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, 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, 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,
+	0, 0, 0, 0, 0, 0, 0, 0,
+	0, 0, 0, 0, 0, 0, 0, 0};
+#endif /*}*/
+
+#define isdigit(x) (My_ctype[(x)+8] & 1)
+#define isspace(x) (My_ctype[(x)+8] & 2)
+#endif

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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

tools/connec/libf2c/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