mirror of
https://github.com/freebsd/freebsd-src.git
synced 2024-11-29 02:22:43 +00:00
Virgin import of EGCS 1.1.2's libf2c
This commit is contained in:
David E. O'Brien
parent
2a266d02ba
commit
c1f999a45c
Notes:
svn2git
2020-12-20 02:59:44 +00:00
svn path=/vendor/gcc/dist/; revision=51363
1091
contrib/libf2c/ChangeLog
Normal file
1091
contrib/libf2c/ChangeLog
Normal file
File diff suppressed because it is too large
Load Diff
200
contrib/libf2c/ChangeLog.egcs
Normal file
200
contrib/libf2c/ChangeLog.egcs
Normal file
@ -0,0 +1,200 @@
|
||||
Thu Jul 16 00:58:52 1998 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* libU77/Makefile.in: Missed one config.h.in -> config.hin change.
|
||||
|
||||
* g2c.hin: Renamed from g2c.h.in.
|
||||
* Makefile.in, configure.in: Changed as needed.
|
||||
* configure: Rebuilt.
|
||||
|
||||
* libU77/config.hin: Renamed from libU77/config.h.in.
|
||||
* Makefile.in, configure.in: Changed as needed.
|
||||
* configure: Rebuilt.
|
||||
|
||||
Tue Jul 14 21:35:30 1998 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at>
|
||||
|
||||
* Makefile.in (all): Invoke $(MAKE) instead of just make.
|
||||
|
||||
Tue Jul 14 02:16:34 1998 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* Makefile.in: stamp-lib* -> s-lib*.
|
||||
* libU77/Makefile.in: Likewise.
|
||||
* libF77/Makefile.in: Likewise.
|
||||
* libI77/Makefile.in: Likewise.
|
||||
|
||||
* libU77/Makefile.in (ALL_CFLAGS): Add -I$(F2C_H_DIR).
|
||||
|
||||
1998-07-06 Mike Stump <mrs@wrs.com>
|
||||
|
||||
* Makefile.in (clean): Don't remove Makefiles, that is done in
|
||||
distclean.
|
||||
|
||||
Sat Jun 27 23:04:49 1998 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* Makefile.in (FLAGS_TO_PASS, case G2C_H_DIR): Use $(TARGET_SUBDIR)
|
||||
instead of hardcoding "libraries".
|
||||
|
||||
1998-06-26 Manfred Hollstein <manfred@s-direktnet.de>
|
||||
|
||||
* Makefile.in (gcc_version_trigger): Add new macro.
|
||||
(config.status): Add dependency upon $(gcc_version_trigger).
|
||||
|
||||
* configure.in (gcc_version_trigger): New variable; initialize
|
||||
using value from toplevel configure; add AC_SUBST for it.
|
||||
(gcc_version): Change initialization to use this new variable.
|
||||
* configure: Regenerate.
|
||||
|
||||
1998-06-24 Manfred Hollstein <manfred@s-direktnet.de>
|
||||
|
||||
* Makefile.in (version): Rename to gcc_version.
|
||||
* configure.in (version): Likewise.
|
||||
(gcc_version): Add code to use an option passed from parent configure.
|
||||
* configure: Regenerate.
|
||||
|
||||
1998-06-21 Dave Love <d.love@dl.ac.uk>
|
||||
|
||||
* configure.in (version, target_alias): Define.
|
||||
|
||||
* Makefile.in (version, target_alias, libsubdir): Define.
|
||||
(install): Remove check for libsubdir.
|
||||
|
||||
Mon Apr 27 22:52:31 1998 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* libU77/ltime_.c: Bounce the ftnint argument through a local time_t.
|
||||
* libU77/gmtime_.c: Likewise.
|
||||
|
||||
Sun Apr 26 18:07:56 1998 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* configure.in: Adjust include paths in F2C_INTEGER and F2C_LONGINT
|
||||
tests to work out of the build directory.
|
||||
|
||||
1998-02-17 Dave Love <d.love@dl.ac.uk>
|
||||
|
||||
* libU77/u77-test.f: Tweak some o/p.
|
||||
|
||||
* libU77/Makefile.in (check): Use -L for new directory structure.
|
||||
|
||||
* Makefile.in (check): Run the u77 check.
|
||||
(config.status, Makefile): New targets.
|
||||
|
||||
Wed Feb 11 01:46:20 1998 Manfred Hollstein <manfred@s-direktnet.de>
|
||||
|
||||
* Makefile.in ($(lib)): Call $(AR) repeatedly to avoid overflowing
|
||||
argument size limit on ancious System V.
|
||||
|
||||
Sun Feb 8 00:32:17 1998 Manfred Hollstein <manfred@s-direktnet.de>
|
||||
|
||||
* Makefile.in: Add `info install-info clean-info check dvi' targets.
|
||||
|
||||
Mon Feb 2 11:08:49 1998 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* configure.in: Update F2C_INTEGER and F2C_LONGINT tests
|
||||
for the new placement in the hierarchy.
|
||||
|
||||
Sun Feb 1 02:36:33 1998 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* Previous contents of gcc/f/runtime moved into toplevel
|
||||
"libf2c" directory.
|
||||
|
||||
Sun Feb 1 01:42:47 1998 Mumit Khan <khan@xraylith.wisc.edu>
|
||||
|
||||
* libU77/configure.in (getlogin,getgid,getuid, kill,link,ttyname):
|
||||
Check.
|
||||
* libU77/config.h.in (HAVE_GETLOGIN, HAVE_GETGID, HAVE_GETUID,
|
||||
HAVE_KILL, HAVE_LINK, HAVE_TTYNAME): New defs.
|
||||
* libU77/getlog_.c: Conditionalize for target platform. Set errno
|
||||
to ENOSYS if target libc doesn't have the function.
|
||||
* libU77/getgid_.c: Likewise.
|
||||
* libU77/getuid_.c: Likewise.
|
||||
* libU77/kill_.c: Likewise.
|
||||
* libU77/link_.c: Likewise.
|
||||
* libU77/ttynam_.c: Likewise.
|
||||
|
||||
Sun Jan 18 20:01:37 1998 Toon Moene <toon@moene.indiv.nluug.nl>
|
||||
|
||||
* libI77/backspace.c: (f_back): Use type `uiolen' to determine size
|
||||
of record length specifier.
|
||||
|
||||
Sat Jan 17 22:40:31 1998 Mumit Khan <khan@xraylith.wisc.edu>
|
||||
|
||||
* libU77/configure.in (sys/param.h,sys/times.h): Check.
|
||||
(times,alarm): Likewise.
|
||||
* libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H,
|
||||
HAVE_ALARM, HAVE_TIMES): New defs.
|
||||
* libU77/alarm_.c: Conditionalize for target platform. Set errno
|
||||
to ENOSYS if target libc doesn't have the function.
|
||||
* libU77/dtime_.c: Likewise.
|
||||
* libU77/etime_.c: Likewise.
|
||||
* libU77/sys_clock_.c: Likewise.
|
||||
|
||||
* configure.in (NON_UNIX_STDIO): Define if MINGW32.
|
||||
(NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32.
|
||||
|
||||
* libI77/rawio.h: Don't providing conflicting declarations for
|
||||
read() and write(). MINGW32 header files use "const" quals.
|
||||
|
||||
* libF77/s_paus.c: _WIN32 does not have pause().
|
||||
|
||||
Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu)
|
||||
|
||||
* libI77/close.c (f_exit): Reset f__init so that f_clos does not
|
||||
(incorrectly) think there is an I/O recursion when program is
|
||||
interrupted.
|
||||
|
||||
Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* libF77/signal_.c: Undo last change until we can fix it right.
|
||||
|
||||
Wed Oct 15 10:06:29 1997 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* libF77/signal_.c (G77_signal_0): Make return type sig_pf as well.
|
||||
* libI77/fio.h: Include <string.h> if STDC_HEADERS.
|
||||
* libU77/chmod_.c: Likewise.
|
||||
|
||||
Tue Oct 7 18:22:10 1997 Richard Henderson <rth@cygnus.com>
|
||||
|
||||
* Makefile.in (CGFLAGS): Don't force -g0.
|
||||
* libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise.
|
||||
|
||||
Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* Makefile.in (distclean): Do a better job at cleaning up.
|
||||
|
||||
Wed Oct 1 01:46:16 1997 Philippe De Muyter <phdm@info.ucl.ac.be>
|
||||
|
||||
* libU77/sys_clock_.c: File renamed from system_clock_.c.
|
||||
* libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not
|
||||
system_clock_.*.
|
||||
* libU77/dtime_.c (clk_tck): Try also HZ macro.
|
||||
* libU77/access.c (G77_access_0): Check malloc return value against 0,
|
||||
not NULL.
|
||||
* libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto.
|
||||
* libU77/chmod_.c, libU77/rename_.c: Ditto.
|
||||
|
||||
1997-09-19 Dave Love <d.love@dl.ac.uk>
|
||||
|
||||
* libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case
|
||||
so as not to truncate results to integer values.
|
||||
* libU77/Version.c: Bump.
|
||||
|
||||
Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* Makefile.in (stamp-lib): Don't use '$?', explicitly
|
||||
list the variables containing the object files to include
|
||||
in libf2c.a
|
||||
|
||||
Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com)
|
||||
|
||||
* Makefile.in (clean): Don't remove config.cache.
|
||||
(distclean): Do it here instead.
|
||||
|
||||
Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com)
|
||||
|
||||
* hostnm_.c: Include errno.h
|
||||
|
||||
Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu)
|
||||
|
||||
* Makefile.in (mostlyclean, clean): Check if Makefile exists
|
||||
before using it. Remove stamp-*.
|
||||
(stamp-libi77, stamp-libf77, stamp-libu77): New.
|
||||
(stamp-lib): Only depend on stamp-libi77 stamp-libf77
|
||||
stamp-libu77
|
||||
185
contrib/libf2c/Makefile.in
Normal file
185
contrib/libf2c/Makefile.in
Normal file
@ -0,0 +1,185 @@
|
||||
# Makefile for GNU F77 compiler runtime.
|
||||
# Copyright (C) 1995-1998 Free Software Foundation, Inc.
|
||||
# Contributed by Dave Love (d.love@dl.ac.uk).
|
||||
#
|
||||
#This file is part of GNU Fortran.
|
||||
#
|
||||
#GNU Fortran is free software; you can redistribute it and/or modify
|
||||
#it under the terms of the GNU General Public License as published by
|
||||
#the Free Software Foundation; either version 2, or (at your option)
|
||||
#any later version.
|
||||
#
|
||||
#GNU Fortran is distributed in the hope that it will be useful,
|
||||
#but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
#GNU General Public License for more details.
|
||||
#
|
||||
#You should have received a copy of the GNU General Public License
|
||||
#along with GNU Fortran; see the file COPYING. If not, write to
|
||||
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
||||
#02111-1307, USA.
|
||||
|
||||
SHELL = /bin/sh
|
||||
|
||||
#### Start of system configuration section. ####
|
||||
|
||||
srcdir = @srcdir@
|
||||
VPATH = @srcdir@
|
||||
prefix = @prefix@
|
||||
exec_prefix = @exec_prefix@
|
||||
target_alias = @target_alias@
|
||||
gcc_version = @gcc_version@
|
||||
gcc_version_trigger = @gcc_version_trigger@
|
||||
|
||||
libdir = $(exec_prefix)/lib
|
||||
libsubdir = $(libdir)/gcc-lib/$(target_alias)/$(gcc_version)
|
||||
|
||||
# Not configured per top-level version, since that doesn't get passed
|
||||
# down at configure time, but overrridden by the top-level install
|
||||
# target.
|
||||
INSTALL = @INSTALL@
|
||||
INSTALL_PROGRAM = @INSTALL_PROGRAM@
|
||||
INSTALL_DATA = @INSTALL_DATA@
|
||||
|
||||
AR = @AR@
|
||||
AR_FLAGS = rc
|
||||
|
||||
RANLIB = @RANLIB@
|
||||
|
||||
CC = @CC@
|
||||
CFLAGS = @CFLAGS@
|
||||
|
||||
# List of variables to pass to sub-makes.
|
||||
# Quote this way so that it can be used to set shell variables too.
|
||||
# Currently no use for PICFLAG, RUNTESTFLAGS -- check usage.
|
||||
FLAGS_TO_PASS= \
|
||||
CC='$(CC)' \
|
||||
CFLAGS='$(CFLAGS)' \
|
||||
CPPFLAGS='$(CPPFLAGS)' \
|
||||
AR='$(AR)' \
|
||||
RANLIB='$(RANLIB)' \
|
||||
PICFLAG='$(PICFLAG)' \
|
||||
RUNTESTFLAGS='$(RUNTESTFLAGS)'
|
||||
|
||||
LIBG2C = libg2c.a
|
||||
|
||||
SUBDIRS = libI77 libF77 libU77
|
||||
|
||||
F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \
|
||||
signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \
|
||||
besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \
|
||||
dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \
|
||||
getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \
|
||||
isatty itime kill link lnblnk lstat ltime mclock perror rand rename \
|
||||
secnds second sleep srand stat symlnk time ttynam umask unlink \
|
||||
vxtidt vxttim alarm
|
||||
|
||||
# These dependencies can be satisfied in parallel. The [fiu]77
|
||||
# targets update stamp files which the $(LIBG2C) target checks in the
|
||||
# sub-make. (Probably only one stamp file is really needed.)
|
||||
all: i77 f77 u77 s-libe77
|
||||
$(MAKE) $(FLAGS_TO_PASS) $(LIBG2C)
|
||||
|
||||
i77 f77 u77: g2c.h
|
||||
|
||||
$(LIBG2C): s-libi77 s-libf77 s-libu77 s-libe77
|
||||
rm -f $(LIBG2C)
|
||||
set -e; \
|
||||
for i in $(SUBDIRS); \
|
||||
do (cd $$i && $(MAKE) $(FLAGS_TO_PASS) LIBG2C=../$(LIBG2C) archive); \
|
||||
done
|
||||
objs=""; for i in $(F2CEXT); do objs="$$objs libE77/L$$i.o"; done; \
|
||||
$(AR) $(AR_FLAGS) $(LIBG2C) $$objs
|
||||
$(RANLIB) $(LIBG2C)
|
||||
|
||||
i77:
|
||||
cd libI77; $(MAKE) $(FLAGS_TO_PASS) all
|
||||
|
||||
f77:
|
||||
cd libF77; $(MAKE) $(FLAGS_TO_PASS) all
|
||||
|
||||
u77:
|
||||
cd libU77; $(MAKE) $(FLAGS_TO_PASS) all
|
||||
|
||||
s-libe77: f2cext.c
|
||||
if [ -d libE77 ]; then rm -f libE77/*.o; else mkdir libE77; fi
|
||||
for name in $(F2CEXT); \
|
||||
do \
|
||||
echo $${name}; \
|
||||
$(CC) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) \
|
||||
-DL$${name} $(srcdir)/f2cext.c \
|
||||
-o libE77/L$${name}.o; \
|
||||
if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
|
||||
done
|
||||
echo timestamp >s-libe77
|
||||
|
||||
${srcdir}/configure: configure.in
|
||||
rm -f config.cache
|
||||
cd $(srcdir) && autoconf
|
||||
|
||||
# Dependence on Makefile serializes for parallel make.
|
||||
g2c.h: g2c.hin config.status Makefile
|
||||
# Might try to avoid rebuilding everything if Makefile or configure
|
||||
# changes and g2c.h doesn't; see also the Makefile rule. Should
|
||||
# depend on another stamp file rather than using the commented-out
|
||||
# lines below, since g2c.h isn't necessarily brought up to date.
|
||||
# mv g2c.h g2c.x
|
||||
$(SHELL) config.status
|
||||
# $(srcdir)/../move-if-change g2c.h g2c.x && mv g2c.x g2c.h
|
||||
|
||||
Makefile: Makefile.in config.status
|
||||
# Autoconf doc uses `./config.status'. Is there a good reason to use
|
||||
$(SHELL) config.status
|
||||
|
||||
config.status: configure $(gcc_version_trigger)
|
||||
# Make sure we don't pick up a site config file and that configure
|
||||
# gets run with correct values of variables such as CC.
|
||||
CONFIG_SITE=no-such-file $(FLAGS_TO_PASS) \
|
||||
$(SHELL) config.status --recheck
|
||||
|
||||
info install-info clean-info dvi TAGS dist installcheck installdirs:
|
||||
|
||||
check:
|
||||
cd libU77; $(MAKE) G77DIR=../../../gcc/ check
|
||||
|
||||
install: all
|
||||
$(INSTALL_DATA) $(LIBG2C) $(libsubdir)/$(LIBG2C).n
|
||||
( cd $(libsubdir) ; $(RANLIB) $(LIBG2C).n )
|
||||
mv -f $(libsubdir)/$(LIBG2C).n $(libsubdir)/$(LIBG2C)
|
||||
$(INSTALL_DATA) g2c.h $(libsubdir)/include/g2c.h
|
||||
@if [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]; then \
|
||||
echo ''; \
|
||||
echo 'Warning: g77 no longer installs libf2c.a or f2c.h.'; \
|
||||
echo ' You must do so yourself. For more information,'; \
|
||||
echo ' read "Distributing Binaries" in the g77 docs.'; \
|
||||
echo ' (To turn off this warning, delete the file'; \
|
||||
echo ' f2c-install-ok in the source or build directory.)'; \
|
||||
echo ''; \
|
||||
else true; fi
|
||||
|
||||
install-strip:
|
||||
$(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install
|
||||
|
||||
uninstall:
|
||||
rm -f $(libsubdir)/include/g2c.h $(libsubdir)/$(LIBG2C)
|
||||
|
||||
mostlyclean:
|
||||
rm -f $(LIBG2C)
|
||||
for i in $(SUBDIRS); do (cd $$i && $(MAKE) mostlyclean); done
|
||||
rm -fr libE77
|
||||
|
||||
clean: mostlyclean
|
||||
rm -f config.log
|
||||
for i in $(SUBDIRS); do (cd $$i && $(MAKE) clean); done
|
||||
|
||||
distclean: clean
|
||||
rm -f Makefile config.cache config.status g2c.h s-libe77
|
||||
for i in $(SUBDIRS); do (cd $$i && $(MAKE) distclean); done
|
||||
|
||||
maintainer-clean:
|
||||
|
||||
rebuilt: configure
|
||||
|
||||
.PHONY: rebuilt mostlyclean clean distclean maintainer-clean all \
|
||||
i77 f77 u77 check uninstall install-strip dist \
|
||||
installcheck installdirs
|
||||
109
contrib/libf2c/README
Normal file
109
contrib/libf2c/README
Normal file
@ -0,0 +1,109 @@
|
||||
1998-08-11
|
||||
|
||||
This directory contains the libf2c library packaged for use with g77
|
||||
to configure and build automatically (in principle!) as part of the
|
||||
top-level configure and make steps. g77 names this library `libg2c'
|
||||
to avoid conflicts with existing copies of `libf2c' on a system.
|
||||
|
||||
Some small changes have been made vis-a-vis the netlib distribution of
|
||||
libf2c, which comes from <ftp:bell-labs.com/netlib/f2c/> and is maintained
|
||||
(excellently) by David M. Gay <dmg@bell-labs.com>. See the Notice files
|
||||
for copyright information. We usually try to get g77-specific changes
|
||||
rolled back into the libf2c distribution.
|
||||
|
||||
Files that come directly from netlib are either maintained in the
|
||||
libf2c directory under their original names or, if they are not pertinent
|
||||
for g77's version of libf2c, under their original names with `.netlib'
|
||||
appended. For example, permissions.netlib is a copy of f2c's top-level
|
||||
`permissions' file in the netlib distribution. In this case, it applies
|
||||
only to the relevant portions of the libF77/ and libI77/ directories; it
|
||||
does not apply to the libU77/ directory, which is distributed under
|
||||
different licensing arrangements. Similarly, the `makefile.netlib' files
|
||||
in the libF77/ and libI77/ subdirectories are copies of the respective
|
||||
`makefile' files in the netlib distribution, but are not used when
|
||||
building g77's version of libf2c.
|
||||
|
||||
The README.netlib files in libF77/ and libI77/ thus might be
|
||||
interesting, but should not be taken as guidelines for how to
|
||||
configure and build libf2c in g77's distribution.
|
||||
|
||||
* Read permissions.netlib for licensing conditions that apply to
|
||||
distributing programs containing portions of code in the libF77/ and
|
||||
libI77/ subdirectories. Also read disclaimer.netlib.
|
||||
|
||||
* Read libU77/COPYING.LIB for licensing conditions that apply to
|
||||
distributing programs containing portions of code in the libU77/
|
||||
subdirectory.
|
||||
|
||||
Among the user-visible changes (choices) g77 makes in its version of libf2c:
|
||||
|
||||
- f2c.h configured to default to padding unformatted direct reads
|
||||
(#define Pad_UDread), because that's the behavior most users
|
||||
expect.
|
||||
|
||||
- f2c.h configured to default to outputting leading zeros before
|
||||
decimal points in formatted and list-directed output, to be compatible
|
||||
with many other compilers (#define WANT_LEAD_0). Either way is
|
||||
standard-conforming, however, and you should try to avoid writing
|
||||
code that assumes one format or another.
|
||||
|
||||
- dtime_() and etime_() are from Dave Love's libU77, not from
|
||||
netlib's libF77.
|
||||
|
||||
- Routines that are intended to be called directly via user code
|
||||
(as in `CALL EXIT', but not the support routines for `OPEN')
|
||||
have been renamed from `<name>' to `G77_<name>_0'. This, in
|
||||
combination with g77 recognizing these names as intrinsics and
|
||||
calling them directly by those names, reduces the likelihood of
|
||||
interface mismatches occurring due to use of compiler options
|
||||
that change code generation, and permits use of these names as
|
||||
both intrinsics and user-supplied routines in applications (as
|
||||
required by the Fortran standards). f2cext.c contains "jacket"
|
||||
routines named `<name>' that call `G77_<name>_0', to support
|
||||
code that relies on calling the relevant routines as `EXTERNAL'
|
||||
routines.
|
||||
|
||||
Note that the `_0' in the name denotes version 0 of the *interface*,
|
||||
not the *implementation*, of a routine. The interface of a
|
||||
given routine *must not change* -- instead, introduce a new copy
|
||||
of the code, with an increment (e.g. `_1') suffix, having the
|
||||
new interface. Whether the previous interface is maintained is
|
||||
not as important as ensuring the routine implementing the new
|
||||
interface is never successfully linked to a call in existing,
|
||||
e.g. previously compiled, code that expects the old interface.
|
||||
|
||||
- Version.c in the subdirectories contains g77-specific version
|
||||
information and a routine (per subdirectory) to print both the
|
||||
netlib and g77 version information when called. The `g77 -v'
|
||||
command is designed to trigger this, by compiling, linking, and
|
||||
running a small program that calls the routines in sequence.
|
||||
|
||||
- libF77/main.c no longer contains the actual code to copy the
|
||||
argc and argv values into globals or to set up the signal-handling
|
||||
environment. These have been removed to libF77/setarg.c and
|
||||
libF77/setsig.c, respectively. libF77/main.c contains procedure
|
||||
calls to the new code in place of the code itself. This should
|
||||
simplify linking executables with a main() function other than
|
||||
that in libF77/main.c (such as one written by the user in C or
|
||||
C++). See the g77 documentation for more information.
|
||||
|
||||
- Complex-arithmetic support routines in libF77/ take a different approach
|
||||
to avoiding problems resulting from aliased input and output arguments,
|
||||
which should avoid particularly unusual alias problems that netlib
|
||||
libf2c might suffer from.
|
||||
|
||||
- libF77/signal_.c supports systems with 64-bit pointers and 32-bit
|
||||
integers.
|
||||
|
||||
- I/O routines in libI77/ have code to detect attempts to do recursive
|
||||
I/O more "directly", mainly to lead to a clearer diagnostic than
|
||||
typically occurs under such conditions.
|
||||
|
||||
- Formatted-I/O routines in libI77/ have code to pretty-print a FORMAT
|
||||
string when printing a fatal diagnostic involving formatted I/O.
|
||||
|
||||
- libI77/open.c supports a more robust, perhaps more secure, method
|
||||
of naming temporary files on some systems.
|
||||
|
||||
- Some g77-specific handling of building under Microsoft operating
|
||||
systems exists, mainly in libI77/.
|
||||
14
contrib/libf2c/TODO
Normal file
14
contrib/libf2c/TODO
Normal file
@ -0,0 +1,14 @@
|
||||
980709
|
||||
|
||||
TODO list for the g77 library
|
||||
|
||||
* Investigate building shared libraries on systems we know about
|
||||
(probably using libtool).
|
||||
|
||||
* Better test cases.
|
||||
|
||||
* Allow the library to be stripped to save space. (The install-strip
|
||||
makefile target now allows this, should it be easily invocable.)
|
||||
|
||||
* An interface to IEEE maths functions from libc where this makes
|
||||
sense.
|
||||
2929
contrib/libf2c/changes.netlib
Normal file
2929
contrib/libf2c/changes.netlib
Normal file
File diff suppressed because it is too large
Load Diff
1576
contrib/libf2c/configure
vendored
Executable file
1576
contrib/libf2c/configure
vendored
Executable file
File diff suppressed because it is too large
Load Diff
176
contrib/libf2c/configure.in
Normal file
176
contrib/libf2c/configure.in
Normal file
@ -0,0 +1,176 @@
|
||||
# Process this file with autoconf to produce a configure script.
|
||||
# Copyright (C) 1995, 1997, 1998 Free Software Foundation, Inc.
|
||||
# Contributed by Dave Love (d.love@dl.ac.uk).
|
||||
#
|
||||
#This file is part of GNU Fortran.
|
||||
#
|
||||
#GNU Fortran is free software; you can redistribute it and/or modify
|
||||
#it under the terms of the GNU General Public License as published by
|
||||
#the Free Software Foundation; either version 2, or (at your option)
|
||||
#any later version.
|
||||
#
|
||||
#GNU Fortran is distributed in the hope that it will be useful,
|
||||
#but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
#GNU General Public License for more details.
|
||||
#
|
||||
#You should have received a copy of the GNU General Public License
|
||||
#along with GNU Fortran; see the file COPYING. If not, write to
|
||||
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
||||
#02111-1307, USA.
|
||||
|
||||
AC_INIT(libF77/Version.c)
|
||||
|
||||
AC_REVISION(1.12)
|
||||
|
||||
dnl Checks for programs.
|
||||
# For g77 we'll set CC to point at the built gcc, but this will get it into
|
||||
# the makefiles
|
||||
AC_PROG_CC
|
||||
|
||||
dnl These should be inherited in the recursive make, but ensure they are
|
||||
dnl defined:
|
||||
test "$AR" || AR=ar
|
||||
AC_SUBST(AR)
|
||||
if test "$RANLIB"; then :
|
||||
AC_SUBST(RANLIB)
|
||||
else
|
||||
AC_PROG_RANLIB
|
||||
fi
|
||||
AC_PROG_INSTALL
|
||||
AC_PROG_MAKE_SET
|
||||
|
||||
dnl Checks for header files.
|
||||
# Sanity check for the cross-compilation case:
|
||||
AC_CHECK_HEADER(stdio.h,:,
|
||||
[AC_MSG_ERROR([Can't find stdio.h.
|
||||
You must have a usable C system for the target already installed, at least
|
||||
including headers and, preferably, the library, before you can configure
|
||||
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
|
||||
then the target library, then build with \`LANGUAGES=f77'.])])
|
||||
|
||||
# We have to firkle with the info in hconfig.h to figure out suitable types
|
||||
# (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need
|
||||
# is in ../.. and the config files are in $srcdir/../../config.
|
||||
AC_MSG_CHECKING(f2c integer type)
|
||||
late_ac_cpp=$ac_cpp
|
||||
ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config"
|
||||
if test "$subdir" != . ; then
|
||||
ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config"
|
||||
fi
|
||||
AC_CACHE_VAL(g77_cv_sys_f2cinteger,
|
||||
echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC
|
||||
AC_EGREP_CPP(F2C_INTEGER=long int,
|
||||
[#include "proj.h"
|
||||
#define FFECOM_DETERMINE_TYPES 1
|
||||
#include "com.h"
|
||||
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
|
||||
F2C_INTEGER=long int
|
||||
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
|
||||
F2C_INTEGER=int
|
||||
#else
|
||||
# error "Cannot find a suitable type for F2C_INTEGER"
|
||||
#endif
|
||||
],
|
||||
g77_cv_sys_f2cinteger="long int",)
|
||||
if test "$g77_cv_sys_f2cinteger" = ""; then
|
||||
echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC
|
||||
AC_EGREP_CPP(F2C_INTEGER=int,
|
||||
[#include "proj.h"
|
||||
#define FFECOM_DETERMINE_TYPES 1
|
||||
#include "com.h"
|
||||
#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
|
||||
F2C_INTEGER=long int
|
||||
#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
|
||||
F2C_INTEGER=int
|
||||
#else
|
||||
# error "Cannot find a suitable type for F2C_INTEGER"
|
||||
#endif
|
||||
],
|
||||
g77_cv_sys_f2cinteger=int,)
|
||||
fi
|
||||
if test "$g77_cv_sys_f2cinteger" = ""; then
|
||||
AC_MSG_RESULT("")
|
||||
AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.])
|
||||
fi
|
||||
)
|
||||
AC_MSG_RESULT($g77_cv_sys_f2cinteger)
|
||||
F2C_INTEGER=$g77_cv_sys_f2cinteger
|
||||
ac_cpp=$late_ac_cpp
|
||||
AC_SUBST(F2C_INTEGER)
|
||||
|
||||
AC_MSG_CHECKING(f2c long int type)
|
||||
late_ac_cpp=$ac_cpp
|
||||
ac_cpp="$late_ac_cpp -I../../gcc/f -I../../gcc -I../../gcc/config"
|
||||
if test "$subdir" != . ; then
|
||||
ac_cpp="$ac_cpp -I$srcdir/../gcc/f -I$srcdir/../gcc -I$srcdir/../gcc/config"
|
||||
fi
|
||||
AC_CACHE_VAL(g77_cv_sys_f2clongint,
|
||||
echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC
|
||||
AC_EGREP_CPP(F2C_LONGINT=long int,
|
||||
[#include "proj.h"
|
||||
#define FFECOM_DETERMINE_TYPES 1
|
||||
#include "com.h"
|
||||
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
|
||||
F2C_LONGINT=long int
|
||||
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
|
||||
F2C_LONGINT=long long int
|
||||
#else
|
||||
# error "Cannot find a suitable type for F2C_LONGINT"
|
||||
#endif
|
||||
],
|
||||
g77_cv_sys_f2clongint="long int",)
|
||||
if test "$g77_cv_sys_f2clongint" = ""; then
|
||||
echo "configure:__oline__: using $ac_cpp" >&AC_FD_CC
|
||||
AC_EGREP_CPP(F2C_LONGINT=long long int,
|
||||
[#include "proj.h"
|
||||
#define FFECOM_DETERMINE_TYPES 1
|
||||
#include "com.h"
|
||||
#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
|
||||
F2C_LONGINT=long int
|
||||
#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
|
||||
F2C_LONGINT=long long int
|
||||
#else
|
||||
# error "Cannot find a suitable type for F2C_LONGINT"
|
||||
#endif
|
||||
],
|
||||
g77_cv_sys_f2clongint="long long int",)
|
||||
fi
|
||||
if test "$g77_cv_sys_f2clongint" = ""; then
|
||||
AC_MSG_RESULT("")
|
||||
AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.])
|
||||
fi
|
||||
)
|
||||
AC_MSG_RESULT($g77_cv_sys_f2clongint)
|
||||
F2C_LONGINT=$g77_cv_sys_f2clongint
|
||||
ac_cpp=$late_ac_cpp
|
||||
AC_SUBST(F2C_LONGINT)
|
||||
|
||||
# avoid confusion in case the `makefile's from the f2c distribution have
|
||||
# got put here
|
||||
test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori
|
||||
test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori
|
||||
test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori
|
||||
|
||||
# Get the version trigger filename from the toplevel
|
||||
if [[ "${with_gcc_version_trigger+set}" = set ]]; then
|
||||
gcc_version_trigger=$with_gcc_version_trigger
|
||||
gcc_version=`sed -e 's/.*\"\([[^ \"]]*\)[[ \"]].*/\1/' < ${gcc_version_trigger}`
|
||||
else
|
||||
gcc_version_trigger=
|
||||
gcc_version=UNKNOWN
|
||||
fi
|
||||
|
||||
AC_SUBST(gcc_version)
|
||||
AC_SUBST(gcc_version_trigger)
|
||||
AC_CANONICAL_SYSTEM
|
||||
AC_SUBST(target_alias)
|
||||
|
||||
AC_CONFIG_SUBDIRS(libU77 libI77 libF77)
|
||||
AC_OUTPUT(Makefile g2c.h:g2c.hin)
|
||||
|
||||
dnl Local Variables:
|
||||
dnl comment-start: "dnl "
|
||||
dnl comment-end: ""
|
||||
dnl comment-start-skip: "\\bdnl\\b\\s *"
|
||||
dnl End:
|
||||
15
contrib/libf2c/disclaimer.netlib
Normal file
15
contrib/libf2c/disclaimer.netlib
Normal file
@ -0,0 +1,15 @@
|
||||
f2c is a Fortran to C converter under development since 1990 by
|
||||
David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies)
|
||||
Stu Feldman (then at Bellcore, now at IBM)
|
||||
Mark Maimone (Carnegie-Mellon University)
|
||||
Norm Schryer (then AT&T Bell Labs, now AT&T Labs)
|
||||
Please send bug reports to dmg@research.bell-labs.com .
|
||||
|
||||
AT&T, Bellcore and Lucent disclaim all warranties with regard to this
|
||||
software, including all implied warranties of merchantability
|
||||
and fitness. In no event shall AT&T, Bellcore or Lucent 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.
|
||||
64
contrib/libf2c/f2c.h
Normal file
64
contrib/libf2c/f2c.h
Normal file
@ -0,0 +1,64 @@
|
||||
/* f2c.h file for GNU Fortran run-time library
|
||||
Copyright (C) 1998 Free Software Foundation, Inc.
|
||||
Contributed by James Craig Burley (burley@gnu.org).
|
||||
|
||||
This file is part of GNU Fortran.
|
||||
|
||||
GNU Fortran is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
GNU Fortran is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with GNU Fortran; see the file COPYING. If not, write to
|
||||
the Free Software Foundation, 59 Temple Place - Suite 330,
|
||||
Boston, MA 02111-1307, USA. */
|
||||
|
||||
/* This file currently is just a stub through which g77's copy
|
||||
of netlib's libf2c, which g77 builds and installs as libg2c.a
|
||||
(to avoid conflict), #include's g77's version of f2c.h, named
|
||||
g2c.h. That file is, in turn, produced via g77's library
|
||||
configuration process from g2c.h.in.
|
||||
|
||||
By going through this extra "hoop", it is easy to provide for
|
||||
libg2c-specific configuration and typedefs that aren't appropriate
|
||||
in g2c.h itself (since that is intended to be installed so it can
|
||||
be shared with f2c users), without changing the libf2c (libg2c)
|
||||
routines themselves. (They continue to #include "f2c.h", just
|
||||
like they do in netlib's version.) */
|
||||
|
||||
#include "g2c.h"
|
||||
|
||||
/* For GNU Fortran (g77), we always enable the following behaviors for
|
||||
libf2c, to make things easy on the programmer. The alternate
|
||||
behaviors have their uses, and g77 might provide them as compiler,
|
||||
rather than library, options, so only a single copy of a shared libf2c
|
||||
need be built for a system. */
|
||||
|
||||
/* This makes unformatted I/O more consistent in relation to other
|
||||
systems. It is not required by the F77 standard. */
|
||||
|
||||
#define Pad_UDread
|
||||
|
||||
/* This makes ERR= and IOSTAT= returns work properly in disk-full
|
||||
situations, making things work more as expected. It slows things
|
||||
down, so g77 will probably someday choose the original implementation
|
||||
on a case-by-case basis when it can be shown to not be necessary
|
||||
(e.g. no ERR= or IOSTAT=) or when it is given the appropriate
|
||||
compile-time option or, perhaps, source-code directive.
|
||||
|
||||
(No longer defined, since it really slows down NFS access too much.) */
|
||||
|
||||
/* #define ALWAYS_FLUSH */
|
||||
|
||||
/* Most Fortran implementations do this, so to make it easier
|
||||
to compare the output of g77-compiled programs to those compiled
|
||||
by most other compilers, tell libf2c to put leading zeros in
|
||||
appropriate places on output. */
|
||||
|
||||
#define WANT_LEAD_0
|
||||
555
contrib/libf2c/f2cext.c
Normal file
555
contrib/libf2c/f2cext.c
Normal file
@ -0,0 +1,555 @@
|
||||
/* Copyright (C) 1997 Free Software Foundation, Inc.
|
||||
This file is part of GNU Fortran run-time library.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published
|
||||
by the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
GNU Fortran is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with GNU Fortran; see the file COPYING.LIB. If
|
||||
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
Boston, MA 02111-1307, USA. */
|
||||
|
||||
|
||||
#include <f2c.h>
|
||||
typedef void *sig_proc; /* For now, this will have to do. */
|
||||
|
||||
#ifdef Labort
|
||||
int abort_ (void) {
|
||||
extern int G77_abort_0 (void);
|
||||
return G77_abort_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lderf
|
||||
double derf_ (doublereal *x) {
|
||||
extern double G77_derf_0 (doublereal *x);
|
||||
return G77_derf_0 (x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lderfc
|
||||
double derfc_ (doublereal *x) {
|
||||
extern double G77_derfc_0 (doublereal *x);
|
||||
return G77_derfc_0 (x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lef1asc
|
||||
int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
|
||||
extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
|
||||
return G77_ef1asc_0 (a, la, b, lb);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lef1cmc
|
||||
integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
|
||||
extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
|
||||
return G77_ef1cmc_0 (a, la, b, lb);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lerf
|
||||
double erf_ (real *x) {
|
||||
extern double G77_erf_0 (real *x);
|
||||
return G77_erf_0 (x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lerfc
|
||||
double erfc_ (real *x) {
|
||||
extern double G77_erfc_0 (real *x);
|
||||
return G77_erfc_0 (x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lexit
|
||||
void exit_ (integer *rc) {
|
||||
extern void G77_exit_0 (integer *rc);
|
||||
G77_exit_0 (rc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetarg
|
||||
void getarg_ (ftnint *n, char *s, ftnlen ls) {
|
||||
extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
|
||||
G77_getarg_0 (n, s, ls);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetenv
|
||||
void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
|
||||
extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
|
||||
G77_getenv_0 (fname, value, flen, vlen);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Liargc
|
||||
ftnint iargc_ (void) {
|
||||
extern ftnint G77_iargc_0 (void);
|
||||
return G77_iargc_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsignal
|
||||
void *signal_ (integer *sigp, sig_proc proc) {
|
||||
extern void *G77_signal_0 (integer *sigp, sig_proc proc);
|
||||
return G77_signal_0 (sigp, proc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsystem
|
||||
integer system_ (char *s, ftnlen n) {
|
||||
extern integer G77_system_0 (char *s, ftnlen n);
|
||||
return G77_system_0 (s, n);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lflush
|
||||
int flush_ (void) {
|
||||
extern int G77_flush_0 (void);
|
||||
return G77_flush_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lftell
|
||||
integer ftell_ (integer *Unit) {
|
||||
extern integer G77_ftell_0 (integer *Unit);
|
||||
return G77_ftell_0 (Unit);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfseek
|
||||
integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
|
||||
extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
|
||||
return G77_fseek_0 (Unit, offset, xwhence);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Laccess
|
||||
integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
|
||||
extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
|
||||
return G77_access_0 (name, mode, Lname, Lmode);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lalarm
|
||||
integer alarm_ (integer *seconds, sig_proc proc, integer *status) {
|
||||
extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
|
||||
return G77_alarm_0 (seconds, proc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesj0
|
||||
double besj0_ (const real *x) {
|
||||
return j0 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesj1
|
||||
double besj1_ (const real *x) {
|
||||
return j1 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesjn
|
||||
double besjn_ (const integer *n, real *x) {
|
||||
return jn (*n, *x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesy0
|
||||
double besy0_ (const real *x) {
|
||||
return y0 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesy1
|
||||
double besy1_ (const real *x) {
|
||||
return y1 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lbesyn
|
||||
double besyn_ (const integer *n, real *x) {
|
||||
return yn (*n, *x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lchdir
|
||||
integer chdir_ (const char *name, const ftnlen Lname) {
|
||||
extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
|
||||
return G77_chdir_0 (name, Lname);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lchmod
|
||||
integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
|
||||
extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
|
||||
return G77_chmod_0 (name, mode, Lname, Lmode);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lctime
|
||||
void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
|
||||
extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
|
||||
G77_ctime_0 (chtime, Lchtime, xstime);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldate
|
||||
int date_ (char *buf, ftnlen buf_len) {
|
||||
extern int G77_date_0 (char *buf, ftnlen buf_len);
|
||||
return G77_date_0 (buf, buf_len);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesj0
|
||||
double dbesj0_ (const double *x) {
|
||||
return j0 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesj1
|
||||
double dbesj1_ (const double *x) {
|
||||
return j1 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesjn
|
||||
double dbesjn_ (const integer *n, double *x) {
|
||||
return jn (*n, *x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesy0
|
||||
double dbesy0_ (const double *x) {
|
||||
return y0 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesy1
|
||||
double dbesy1_ (const double *x) {
|
||||
return y1 (*x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldbesyn
|
||||
double dbesyn_ (const integer *n, double *x) {
|
||||
return yn (*n, *x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ldtime
|
||||
double dtime_ (real tarray[2]) {
|
||||
extern double G77_dtime_0 (real tarray[2]);
|
||||
return G77_dtime_0 (tarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Letime
|
||||
double etime_ (real tarray[2]) {
|
||||
extern double G77_etime_0 (real tarray[2]);
|
||||
return G77_etime_0 (tarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfdate
|
||||
void fdate_ (char *ret_val, ftnlen ret_val_len) {
|
||||
extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
|
||||
G77_fdate_0 (ret_val, ret_val_len);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfgetc
|
||||
integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
|
||||
extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
|
||||
return G77_fgetc_0 (lunit, c, Lc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfget
|
||||
integer fget_ (char *c, const ftnlen Lc) {
|
||||
extern integer G77_fget_0 (char *c, const ftnlen Lc);
|
||||
return G77_fget_0 (c, Lc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lflush1
|
||||
int flush1_ (const integer *lunit) {
|
||||
extern int G77_flush1_0 (const integer *lunit);
|
||||
return G77_flush1_0 (lunit);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfnum
|
||||
integer fnum_ (integer *lunit) {
|
||||
extern integer G77_fnum_0 (integer *lunit);
|
||||
return G77_fnum_0 (lunit);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfputc
|
||||
integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
|
||||
extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
|
||||
return G77_fputc_0 (lunit, c, Lc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfput
|
||||
integer fput_ (const char *c, const ftnlen Lc) {
|
||||
extern integer G77_fput_0 (const char *c, const ftnlen Lc);
|
||||
return G77_fput_0 (c, Lc);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lfstat
|
||||
integer fstat_ (const integer *lunit, integer statb[13]) {
|
||||
extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
|
||||
return G77_fstat_0 (lunit, statb);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgerror
|
||||
int gerror_ (char *str, ftnlen Lstr) {
|
||||
extern int G77_gerror_0 (char *str, ftnlen Lstr);
|
||||
return G77_gerror_0 (str, Lstr);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetcwd
|
||||
integer getcwd_ (char *str, const ftnlen Lstr) {
|
||||
extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
|
||||
return G77_getcwd_0 (str, Lstr);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetgid
|
||||
integer getgid_ (void) {
|
||||
extern integer G77_getgid_0 (void);
|
||||
return G77_getgid_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetlog
|
||||
int getlog_ (char *str, const ftnlen Lstr) {
|
||||
extern int G77_getlog_0 (char *str, const ftnlen Lstr);
|
||||
return G77_getlog_0 (str, Lstr);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetpid
|
||||
integer getpid_ (void) {
|
||||
extern integer G77_getpid_0 (void);
|
||||
return G77_getpid_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgetuid
|
||||
integer getuid_ (void) {
|
||||
extern integer G77_getuid_0 (void);
|
||||
return G77_getuid_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lgmtime
|
||||
int gmtime_ (const integer *stime, integer tarray[9]) {
|
||||
extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
|
||||
return G77_gmtime_0 (stime, tarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lhostnm
|
||||
integer hostnm_ (char *name, ftnlen Lname) {
|
||||
extern integer G77_hostnm_0 (char *name, ftnlen Lname);
|
||||
return G77_hostnm_0 (name, Lname);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lidate
|
||||
int idate_ (int iarray[3]) {
|
||||
extern int G77_idate_0 (int iarray[3]);
|
||||
return G77_idate_0 (iarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lierrno
|
||||
integer ierrno_ (void) {
|
||||
extern integer G77_ierrno_0 (void);
|
||||
return G77_ierrno_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lirand
|
||||
integer irand_ (integer *flag) {
|
||||
extern integer G77_irand_0 (integer *flag);
|
||||
return G77_irand_0 (flag);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lisatty
|
||||
logical isatty_ (integer *lunit) {
|
||||
extern logical G77_isatty_0 (integer *lunit);
|
||||
return G77_isatty_0 (lunit);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Litime
|
||||
int itime_ (integer tarray[3]) {
|
||||
extern int G77_itime_0 (integer tarray[3]);
|
||||
return G77_itime_0 (tarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lkill
|
||||
integer kill_ (const integer *pid, const integer *signum) {
|
||||
extern integer G77_kill_0 (const integer *pid, const integer *signum);
|
||||
return G77_kill_0 (pid, signum);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Llink
|
||||
integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
||||
extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
||||
return G77_link_0 (path1, path2, Lpath1, Lpath2);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Llnblnk
|
||||
integer lnblnk_ (char *str, ftnlen str_len) {
|
||||
extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
|
||||
return G77_lnblnk_0 (str, str_len);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Llstat
|
||||
integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
|
||||
extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
|
||||
return G77_lstat_0 (name, statb, Lname);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lltime
|
||||
int ltime_ (const integer *stime, integer tarray[9]) {
|
||||
extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
|
||||
return G77_ltime_0 (stime, tarray);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lmclock
|
||||
longint mclock_ (void) {
|
||||
extern longint G77_mclock_0 (void);
|
||||
return G77_mclock_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lperror
|
||||
int perror_ (const char *str, const ftnlen Lstr) {
|
||||
extern int G77_perror_0 (const char *str, const ftnlen Lstr);
|
||||
return G77_perror_0 (str, Lstr);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lrand
|
||||
double rand_ (integer *flag) {
|
||||
extern double G77_rand_0 (integer *flag);
|
||||
return G77_rand_0 (flag);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lrename
|
||||
integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
||||
extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
||||
return G77_rename_0 (path1, path2, Lpath1, Lpath2);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsecnds
|
||||
double secnds_ (real *r) {
|
||||
extern double G77_secnds_0 (real *r);
|
||||
return G77_secnds_0 (r);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsecond
|
||||
double second_ () {
|
||||
extern double G77_second_0 ();
|
||||
return G77_second_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsleep
|
||||
int sleep_ (const integer *seconds) {
|
||||
extern int G77_sleep_0 (const integer *seconds);
|
||||
return G77_sleep_0 (seconds);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsrand
|
||||
int srand_ (const integer *seed) {
|
||||
extern int G77_srand_0 (const integer *seed);
|
||||
return G77_srand_0 (seed);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lstat
|
||||
integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
|
||||
extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
|
||||
return G77_stat_0 (name, statb, Lname);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lsymlnk
|
||||
integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
||||
extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
||||
return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Ltime
|
||||
longint time_ (void) {
|
||||
extern longint G77_time_0 (void);
|
||||
return G77_time_0 ();
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lttynam
|
||||
void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
|
||||
extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
|
||||
G77_ttynam_0 (ret_val, ret_val_len, lunit);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lumask
|
||||
integer umask_ (integer *mask) {
|
||||
extern integer G77_umask_0 (integer *mask);
|
||||
return G77_umask_0 (mask);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lunlink
|
||||
integer unlink_ (const char *str, const ftnlen Lstr) {
|
||||
extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
|
||||
return G77_unlink_0 (str, Lstr);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lvxtidt
|
||||
int vxtidate_ (integer *m, integer *d, integer *y) {
|
||||
extern int G77_vxtidate_0 (integer *m, integer *d, integer *y);
|
||||
return G77_vxtidate_0 (m, d, y);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef Lvxttim
|
||||
void vxttime_ (char chtime[8], const ftnlen Lchtime) {
|
||||
extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
|
||||
G77_vxttime_0 (chtime, Lchtime);
|
||||
}
|
||||
#endif
|
||||
236
contrib/libf2c/g2c.hin
Normal file
236
contrib/libf2c/g2c.hin
Normal file
@ -0,0 +1,236 @@
|
||||
/* g2c.h -- g77 version of f2c (Standard Fortran to C header file) */
|
||||
|
||||
/* This file is generated by the g77 libg2c configuration process from a
|
||||
file named g2c.hin. This process sets up the appropriate types,
|
||||
defines the appropriate macros, and so on. The resulting g2c.h file
|
||||
is used to build g77's copy of libf2c, named libg2c, and also can
|
||||
be used when compiling C code produced by f2c to link the resulting
|
||||
object file(s) with those produced by the same version of g77 that
|
||||
produced this file, allowing inter-operability of f2c-compiled and
|
||||
g77-compiled code. */
|
||||
|
||||
/** 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
|
||||
|
||||
/* F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems */
|
||||
/* we assume short, float are OK */
|
||||
typedef @F2C_INTEGER@ /* long int */ integer;
|
||||
typedef unsigned @F2C_INTEGER@ /* long */ 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 @F2C_INTEGER@ /* long int */ logical;
|
||||
typedef short int shortlogical;
|
||||
typedef char logical1;
|
||||
typedef char integer1;
|
||||
typedef @F2C_LONGINT@ /* long long */ longint; /* system-dependent */
|
||||
typedef unsigned @F2C_LONGINT@ /* long long */ ulongint; /* system-dependent */
|
||||
#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
|
||||
#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
|
||||
|
||||
#define TRUE_ (1)
|
||||
#define FALSE_ (0)
|
||||
|
||||
/* Extern is for use with -E */
|
||||
#ifndef Extern
|
||||
#define Extern extern
|
||||
#endif
|
||||
|
||||
/* I/O stuff */
|
||||
|
||||
#ifdef f2c_i2
|
||||
#error "f2c_i2 will not work with g77!!!!"
|
||||
/* for -i2 */
|
||||
typedef short flag;
|
||||
typedef short ftnlen;
|
||||
typedef short ftnint;
|
||||
#else
|
||||
typedef @F2C_INTEGER@ /* long int */ flag;
|
||||
typedef @F2C_INTEGER@ /* long int */ ftnlen;
|
||||
typedef @F2C_INTEGER@ /* 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
|
||||
/* (No such symbols should be defined in a strict ANSI C compiler.
|
||||
We can avoid trouble with f2c-translated code by using
|
||||
gcc -ansi [-traditional].) */
|
||||
#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
|
||||
32
contrib/libf2c/libF77/F77_aloc.c
Normal file
32
contrib/libf2c/libF77/F77_aloc.c
Normal file
@ -0,0 +1,32 @@
|
||||
#include "f2c.h"
|
||||
#undef abs
|
||||
#undef min
|
||||
#undef max
|
||||
#include <stdio.h>
|
||||
|
||||
static integer memfailure = 3;
|
||||
|
||||
#ifdef KR_headers
|
||||
extern char *malloc();
|
||||
extern void G77_exit_0 ();
|
||||
|
||||
char *
|
||||
F77_aloc(Len, whence) integer Len; char *whence;
|
||||
#else
|
||||
#include <stdlib.h>
|
||||
extern void G77_exit_0 (integer*);
|
||||
|
||||
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);
|
||||
G77_exit_0 (&memfailure);
|
||||
}
|
||||
return rv;
|
||||
}
|
||||
124
contrib/libf2c/libF77/Makefile.in
Normal file
124
contrib/libf2c/libF77/Makefile.in
Normal file
@ -0,0 +1,124 @@
|
||||
# Makefile for GNU F77 compiler runtime.
|
||||
# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
|
||||
# file `Notice').
|
||||
# Portions of this file Copyright (C) 1995-1998 Free Software Foundation, Inc.
|
||||
# Contributed by Dave Love (d.love@dl.ac.uk).
|
||||
#
|
||||
#This file is part of GNU Fortran.
|
||||
#
|
||||
#GNU Fortran is free software; you can redistribute it and/or modify
|
||||
#it under the terms of the GNU General Public License as published by
|
||||
#the Free Software Foundation; either version 2, or (at your option)
|
||||
#any later version.
|
||||
#
|
||||
#GNU Fortran is distributed in the hope that it will be useful,
|
||||
#but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
#GNU General Public License for more details.
|
||||
#
|
||||
#You should have received a copy of the GNU General Public License
|
||||
#along with GNU Fortran; see the file COPYING. If not, write to
|
||||
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
||||
#02111-1307, USA.
|
||||
|
||||
#### Start of system configuration section. ####
|
||||
|
||||
# $(srcdir) must be set to the g77 runtime libF77 source directory.
|
||||
srcdir = @srcdir@
|
||||
VPATH = @srcdir@
|
||||
|
||||
# configure sets this to all the -D options appropriate for the
|
||||
# configuration.
|
||||
DEFS = @DEFS@
|
||||
|
||||
LIBG2C = ../libg2c.a
|
||||
|
||||
F2C_H_DIR = @srcdir@/..
|
||||
G2C_H_DIR = ..
|
||||
CC = @CC@
|
||||
CFLAGS = @CFLAGS@
|
||||
CPPFLAGS = @CPPFLAGS@
|
||||
AR = @AR@
|
||||
ARFLAGS = rc
|
||||
@SET_MAKE@
|
||||
|
||||
SHELL = /bin/sh
|
||||
|
||||
#### End of system configuration section. ####
|
||||
|
||||
ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(CFLAGS)
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .c .o
|
||||
|
||||
.c.o:
|
||||
$(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $<
|
||||
|
||||
MISC = F77_aloc.o VersionF.o main.o s_rnge.o abort_.o getarg_.o iargc_.o\
|
||||
getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
|
||||
derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o setarg.o setsig.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 \
|
||||
pow_qq.o
|
||||
CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
|
||||
DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
|
||||
REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
|
||||
r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
|
||||
r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
|
||||
r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
|
||||
DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
|
||||
d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
|
||||
d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
|
||||
d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
|
||||
d_sqrt.o d_tan.o d_tanh.o
|
||||
INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
|
||||
HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o
|
||||
CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
|
||||
EFL = ef1asc_.o ef1cmc_.o
|
||||
CHAR = s_cat.o s_cmp.o s_copy.o
|
||||
F90BIT = lbitbits.o lbitshft.o qbitbits.o qbitshft.o
|
||||
|
||||
OBJS = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
|
||||
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
|
||||
|
||||
all: ../s-libf77
|
||||
|
||||
../s-libf77: $(OBJS)
|
||||
echo timestamp > ../s-libf77
|
||||
|
||||
archive:
|
||||
$(AR) $(ARFLAGS) $(LIBG2C) $(OBJS)
|
||||
|
||||
Makefile: Makefile.in config.status
|
||||
$(SHELL) config.status
|
||||
|
||||
config.status: configure
|
||||
rm -f config.cache
|
||||
CONFIG_SITE=no-such-file CC='$(CC)' AR='$(AR)' CFLAGS='$(CFLAGS)' \
|
||||
CPPFLAGS='$(CPPFLAGS)' $(SHELL) config.status --recheck
|
||||
|
||||
${srcdir}/configure: configure.in
|
||||
rm -f config.cache
|
||||
cd ${srcdir} && autoconf
|
||||
|
||||
VersionF.o: Version.c
|
||||
$(CC) -c $(ALL_CFLAGS) -o $@ $(srcdir)/Version.c
|
||||
|
||||
# Not quite all these actually do depend on f2c.h...
|
||||
$(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) $(EFL) \
|
||||
$(CHAR) $(F90BIT): $(F2C_H_DIR)/f2c.h $(G2C_H_DIR)/g2c.h
|
||||
|
||||
check install uninstall install-strip dist installcheck installdirs:
|
||||
|
||||
mostlyclean:
|
||||
rm -f *.o
|
||||
|
||||
clean: mostlyclean
|
||||
rm -f config.log
|
||||
|
||||
distclean: clean
|
||||
rm -f config.cache config.status Makefile ../s-libf77 configure
|
||||
|
||||
maintainer-clean:
|
||||
|
||||
.PHONY: mostlyclean clean distclean maintainer-clean all check uninstall \
|
||||
install-strip dist installcheck installdirs archive
|
||||
23
contrib/libf2c/libF77/Notice
Normal file
23
contrib/libf2c/libF77/Notice
Normal file
@ -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.
|
||||
****************************************************************/
|
||||
|
||||
108
contrib/libf2c/libF77/README.netlib
Normal file
108
contrib/libf2c/libF77/README.netlib
Normal file
@ -0,0 +1,108 @@
|
||||
If your compiler does not recognize ANSI C headers,
|
||||
compile with KR_headers defined: either add -DKR_headers
|
||||
to the definition of CFLAGS in the makefile, or insert
|
||||
|
||||
#define KR_headers
|
||||
|
||||
at the top of f2c.h , cabs.c , main.c , and sig_die.c .
|
||||
|
||||
Under MS-DOS, compile s_paus.c with -DMSDOS.
|
||||
|
||||
If you have a really ancient K&R C compiler that does not understand
|
||||
void, add -Dvoid=int to the definition of CFLAGS in the makefile.
|
||||
|
||||
If you use a C++ compiler, first create a local f2c.h by appending
|
||||
f2ch.add to the usual f2c.h, e.g., by issuing the command
|
||||
make f2c.h
|
||||
which assumes f2c.h is installed in /usr/include .
|
||||
|
||||
If your system lacks onexit() and you are not using an ANSI C
|
||||
compiler, then you should compile main.c, s_paus.c, s_stop.c, and
|
||||
sig_die.c with NO_ONEXIT defined. See the comments about onexit in
|
||||
the makefile.
|
||||
|
||||
If your system has a double drem() function such that drem(a,b)
|
||||
is the IEEE remainder function (with double a, b), then you may
|
||||
wish to compile r_mod.c and d_mod.c with IEEE_drem defined.
|
||||
On some systems, you may also need to compile with -Ddrem=remainder .
|
||||
|
||||
To check for transmission errors, issue the command
|
||||
make check
|
||||
This assumes you have the xsum program whose source, xsum.c,
|
||||
is distributed as part of "all from f2c/src". If you do not
|
||||
have xsum, you can obtain xsum.c by sending the following E-mail
|
||||
message to netlib@netlib.bell-labs.com
|
||||
send xsum.c from f2c/src
|
||||
|
||||
The makefile assumes you have installed f2c.h in a standard
|
||||
place (and does not cause recompilation when f2c.h is changed);
|
||||
f2c.h comes with "all from f2c" (the source for f2c) and is
|
||||
available separately ("f2c.h from f2c").
|
||||
|
||||
Most of the routines in libF77 are support routines for Fortran
|
||||
intrinsic functions or for operations that f2c chooses not
|
||||
to do "in line". There are a few exceptions, summarized below --
|
||||
functions and subroutines that appear to your program as ordinary
|
||||
external Fortran routines.
|
||||
|
||||
1. CALL ABORT prints a message and causes a core dump.
|
||||
|
||||
2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION
|
||||
error functions (with x REAL and d DOUBLE PRECISION);
|
||||
DERF must be declared DOUBLE PRECISION in your program.
|
||||
Both ERF and DERF assume your C library provides the
|
||||
underlying erf() function (which not all systems do).
|
||||
|
||||
3. ERFC(r) and DERFC(d) are the complementary error functions:
|
||||
ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d)
|
||||
(except that their results may be more accurate than
|
||||
explicitly evaluating the above formulae would give).
|
||||
Again, ERFC and r are REAL, and DERFC and d are DOUBLE
|
||||
PRECISION (and must be declared as such in your program),
|
||||
and ERFC and DERFC rely on your system's erfc().
|
||||
|
||||
4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER
|
||||
variable, sets s to the n-th command-line argument (or to
|
||||
all blanks if there are fewer than n command-line arguments);
|
||||
CALL GETARG(0,s) sets s to the name of the program (on systems
|
||||
that support this feature). See IARGC below.
|
||||
|
||||
5. CALL GETENV(name, value), where name and value are of type
|
||||
CHARACTER, sets value to the environment value, $name, of
|
||||
name (or to blanks if $name has not been set).
|
||||
|
||||
6. NARGS = IARGC() sets NARGS to the number of command-line
|
||||
arguments (an INTEGER value).
|
||||
|
||||
7. CALL SIGNAL(n,func), where n is an INTEGER and func is an
|
||||
EXTERNAL procedure, arranges for func to be invoked when
|
||||
signal n occurs (on systems where this makes sense).
|
||||
|
||||
8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes
|
||||
cmd to the system's command processor (on systems where
|
||||
this can be done).
|
||||
|
||||
The makefile does not attempt to compile pow_qq.c, 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 pow_qq.o to the POW = line in the makefile,
|
||||
and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line.
|
||||
|
||||
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 .
|
||||
|
||||
If your 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
|
||||
67
contrib/libf2c/libF77/Version.c
Normal file
67
contrib/libf2c/libF77/Version.c
Normal file
@ -0,0 +1,67 @@
|
||||
static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
|
||||
|
||||
/*
|
||||
*/
|
||||
|
||||
char __G77_LIBF77_VERSION__[] = "0.5.24";
|
||||
|
||||
/*
|
||||
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.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
void
|
||||
g77__fvers__ ()
|
||||
{
|
||||
fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__);
|
||||
fputs (junk, stderr);
|
||||
}
|
||||
18
contrib/libf2c/libF77/abort_.c
Normal file
18
contrib/libf2c/libF77/abort_.c
Normal file
@ -0,0 +1,18 @@
|
||||
#include <stdio.h>
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern VOID sig_die();
|
||||
|
||||
int G77_abort_0 ()
|
||||
#else
|
||||
extern void sig_die(char*,int);
|
||||
|
||||
int G77_abort_0 (void)
|
||||
#endif
|
||||
{
|
||||
sig_die("Fortran abort routine called", 1);
|
||||
#ifdef __cplusplus
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
14
contrib/libf2c/libF77/c_abs.c
Normal file
14
contrib/libf2c/libF77/c_abs.c
Normal file
@ -0,0 +1,14 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double f__cabs();
|
||||
|
||||
double c_abs(z) complex *z;
|
||||
#else
|
||||
extern double f__cabs(double, double);
|
||||
|
||||
double c_abs(complex *z)
|
||||
#endif
|
||||
{
|
||||
return( f__cabs( z->r, z->i ) );
|
||||
}
|
||||
21
contrib/libf2c/libF77/c_cos.c
Normal file
21
contrib/libf2c/libF77/c_cos.c
Normal file
@ -0,0 +1,21 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double sin(), cos(), sinh(), cosh();
|
||||
|
||||
VOID c_cos(resx, z) complex *resx, *z;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
|
||||
void c_cos(complex *resx, complex *z)
|
||||
#endif
|
||||
{
|
||||
complex res;
|
||||
|
||||
res.r = cos(z->r) * cosh(z->i);
|
||||
res.i = - sin(z->r) * sinh(z->i);
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
40
contrib/libf2c/libF77/c_div.c
Normal file
40
contrib/libf2c/libF77/c_div.c
Normal file
@ -0,0 +1,40 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern VOID sig_die();
|
||||
VOID c_div(resx, a, b)
|
||||
complex *a, *b, *resx;
|
||||
#else
|
||||
extern void sig_die(char*,int);
|
||||
void c_div(complex *resx, complex *a, complex *b)
|
||||
#endif
|
||||
{
|
||||
double ratio, den;
|
||||
double abr, abi;
|
||||
complex res;
|
||||
|
||||
if( (abr = b->r) < 0.)
|
||||
abr = - abr;
|
||||
if( (abi = b->i) < 0.)
|
||||
abi = - abi;
|
||||
if( abr <= abi )
|
||||
{
|
||||
if(abi == 0)
|
||||
sig_die("complex division by zero", 1);
|
||||
ratio = (double)b->r / b->i ;
|
||||
den = b->i * (1 + ratio*ratio);
|
||||
res.r = (a->r*ratio + a->i) / den;
|
||||
res.i = (a->i*ratio - a->r) / den;
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
ratio = (double)b->i / b->r ;
|
||||
den = b->r * (1 + ratio*ratio);
|
||||
res.r = (a->r + a->i*ratio) / den;
|
||||
res.i = (a->i - a->r*ratio) / den;
|
||||
}
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
23
contrib/libf2c/libF77/c_exp.c
Normal file
23
contrib/libf2c/libF77/c_exp.c
Normal file
@ -0,0 +1,23 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double exp(), cos(), sin();
|
||||
|
||||
VOID c_exp(resx, z) complex *resx, *z;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
|
||||
void c_exp(complex *resx, complex *z)
|
||||
#endif
|
||||
{
|
||||
double expx;
|
||||
complex res;
|
||||
|
||||
expx = exp(z->r);
|
||||
res.r = expx * cos(z->i);
|
||||
res.i = expx * sin(z->i);
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
21
contrib/libf2c/libF77/c_log.c
Normal file
21
contrib/libf2c/libF77/c_log.c
Normal file
@ -0,0 +1,21 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double log(), f__cabs(), atan2();
|
||||
VOID c_log(resx, z) complex *resx, *z;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
extern double f__cabs(double, double);
|
||||
|
||||
void c_log(complex *resx, complex *z)
|
||||
#endif
|
||||
{
|
||||
complex res;
|
||||
|
||||
res.i = atan2(z->i, z->r);
|
||||
res.r = log( f__cabs(z->r, z->i) );
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
21
contrib/libf2c/libF77/c_sin.c
Normal file
21
contrib/libf2c/libF77/c_sin.c
Normal file
@ -0,0 +1,21 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double sin(), cos(), sinh(), cosh();
|
||||
|
||||
VOID c_sin(resx, z) complex *resx, *z;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
|
||||
void c_sin(complex *resx, complex *z)
|
||||
#endif
|
||||
{
|
||||
complex res;
|
||||
|
||||
res.r = sin(z->r) * cosh(z->i);
|
||||
res.i = cos(z->r) * sinh(z->i);
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
38
contrib/libf2c/libF77/c_sqrt.c
Normal file
38
contrib/libf2c/libF77/c_sqrt.c
Normal file
@ -0,0 +1,38 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double sqrt(), f__cabs();
|
||||
|
||||
VOID c_sqrt(resx, z) complex *resx, *z;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
extern double f__cabs(double, double);
|
||||
|
||||
void c_sqrt(complex *resx, complex *z)
|
||||
#endif
|
||||
{
|
||||
double mag, t;
|
||||
complex res;
|
||||
|
||||
if( (mag = f__cabs(z->r, z->i)) == 0.)
|
||||
res.r = res.i = 0.;
|
||||
else if(z->r > 0)
|
||||
{
|
||||
res.r = t = sqrt(0.5 * (mag + z->r) );
|
||||
t = z->i / t;
|
||||
res.i = 0.5 * t;
|
||||
}
|
||||
else
|
||||
{
|
||||
t = sqrt(0.5 * (mag - z->r) );
|
||||
if(z->i < 0)
|
||||
t = -t;
|
||||
res.i = t;
|
||||
t = z->i / t;
|
||||
res.r = 0.5 * t;
|
||||
}
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
27
contrib/libf2c/libF77/cabs.c
Normal file
27
contrib/libf2c/libF77/cabs.c
Normal file
@ -0,0 +1,27 @@
|
||||
#ifdef KR_headers
|
||||
extern double sqrt();
|
||||
double f__cabs(real, imag) double real, imag;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double f__cabs(double real, double imag)
|
||||
#endif
|
||||
{
|
||||
double temp;
|
||||
|
||||
if(real < 0)
|
||||
real = -real;
|
||||
if(imag < 0)
|
||||
imag = -imag;
|
||||
if(imag > real){
|
||||
temp = real;
|
||||
real = imag;
|
||||
imag = temp;
|
||||
}
|
||||
if((real+imag) == real)
|
||||
return(real);
|
||||
|
||||
temp = imag/real;
|
||||
temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/
|
||||
return(temp);
|
||||
}
|
||||
1495
contrib/libf2c/libF77/configure
vendored
Executable file
1495
contrib/libf2c/libF77/configure
vendored
Executable file
File diff suppressed because it is too large
Load Diff
107
contrib/libf2c/libF77/configure.in
Normal file
107
contrib/libf2c/libF77/configure.in
Normal file
@ -0,0 +1,107 @@
|
||||
# Process this file with autoconf to produce a configure script.
|
||||
# Copyright (C) 1995, 1997, 1998 Free Software Foundation, Inc.
|
||||
# Contributed by Dave Love (d.love@dl.ac.uk).
|
||||
#
|
||||
#This file is part of GNU Fortran.
|
||||
#
|
||||
#GNU Fortran is free software; you can redistribute it and/or modify
|
||||
#it under the terms of the GNU General Public License as published by
|
||||
#the Free Software Foundation; either version 2, or (at your option)
|
||||
#any later version.
|
||||
#
|
||||
#GNU Fortran is distributed in the hope that it will be useful,
|
||||
#but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
#GNU General Public License for more details.
|
||||
#
|
||||
#You should have received a copy of the GNU General Public License
|
||||
#along with GNU Fortran; see the file COPYING. If not, write to
|
||||
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
||||
#02111-1307, USA.
|
||||
|
||||
AC_INIT(getarg_.c)
|
||||
|
||||
dnl Checks for programs.
|
||||
# For g77 we'll set CC to point at the built gcc, but this will get it into
|
||||
# the makefiles
|
||||
AC_PROG_CC
|
||||
|
||||
test "$AR" || AR=ar
|
||||
AC_SUBST(AR)
|
||||
AC_PROG_MAKE_SET
|
||||
|
||||
dnl Checks for libraries.
|
||||
|
||||
dnl Checks for header files.
|
||||
# Sanity check for the cross-compilation case:
|
||||
AC_CHECK_HEADER(stdio.h,:,
|
||||
[AC_MSG_ERROR([Can't find stdio.h.
|
||||
You must have a usable C system for the target already installed, at least
|
||||
including headers and, preferably, the library, before you can configure
|
||||
the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c',
|
||||
then the target library, then build with \`LANGUAGES=f77'.])])
|
||||
|
||||
AC_HEADER_STDC
|
||||
dnl We could do this if we didn't know we were using gcc
|
||||
dnl AC_MSG_CHECKING(for prototype-savvy compiler)
|
||||
dnl AC_CACHE_VAL(g77_cv_sys_proto,
|
||||
dnl [AC_TRY_LINK(,
|
||||
dnl dnl looks screwy because TRY_LINK expects a function body
|
||||
dnl [return 0;} int foo (int * bar) {],
|
||||
dnl g77_cv_sys_proto=yes,
|
||||
dnl [g77_cv_sys_proto=no
|
||||
dnl AC_DEFINE(KR_headers)])])
|
||||
dnl AC_MSG_RESULT($g77_cv_sys_proto)
|
||||
|
||||
AC_MSG_CHECKING(for posix)
|
||||
AC_CACHE_VAL(g77_cv_header_posix,
|
||||
AC_EGREP_CPP(yes,
|
||||
[#include <sys/types.h>
|
||||
#include <unistd.h>
|
||||
#ifdef _POSIX_VERSION
|
||||
yes
|
||||
#endif
|
||||
],
|
||||
g77_cv_header_posix=yes,
|
||||
g77_cv_header_posix=no))
|
||||
AC_MSG_RESULT($g77_cv_header_posix)
|
||||
|
||||
# We can rely on the GNU library being posix-ish. I guess checking the
|
||||
# header isn't actually like checking the functions, though...
|
||||
AC_MSG_CHECKING(for GNU library)
|
||||
AC_CACHE_VAL(g77_cv_lib_gnu,
|
||||
AC_EGREP_CPP(yes,
|
||||
[#include <stdio.h>
|
||||
#ifdef __GNU_LIBRARY__
|
||||
yes
|
||||
#endif
|
||||
],
|
||||
g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no))
|
||||
AC_MSG_RESULT($g77_cv_lib_gnu)
|
||||
|
||||
dnl Checks for library functions.
|
||||
AC_TYPE_SIGNAL
|
||||
# we'll get atexit by default
|
||||
if test $ac_cv_header_stdc != yes; then
|
||||
AC_CHECK_FUNC(atexit,
|
||||
AC_DEFINE(onexit,atexit),dnl just in case
|
||||
[AC_DEFINE(NO_ONEXIT)
|
||||
AC_CHECK_FUNC(onexit,,
|
||||
[AC_CHECK_FUNC(on_exit,
|
||||
AC_DEFINE(onexit,on_exit),)])])
|
||||
else true
|
||||
fi
|
||||
|
||||
dnl perhaps should check also for remainder
|
||||
dnl Unfortunately, the message implies we're just checking for -lm...
|
||||
AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
|
||||
|
||||
AC_DEFINE(Skip_f2c_Undefs)
|
||||
|
||||
AC_OUTPUT(Makefile)
|
||||
|
||||
dnl Local Variables:
|
||||
dnl comment-start: "dnl "
|
||||
dnl comment-end: ""
|
||||
dnl comment-start-skip: "\\bdnl\\b\\s *"
|
||||
dnl End:
|
||||
12
contrib/libf2c/libF77/d_abs.c
Normal file
12
contrib/libf2c/libF77/d_abs.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double d_abs(x) doublereal *x;
|
||||
#else
|
||||
double d_abs(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
if(*x >= 0)
|
||||
return(*x);
|
||||
return(- *x);
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_acos.c
Normal file
13
contrib/libf2c/libF77/d_acos.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double acos();
|
||||
double d_acos(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_acos(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( acos(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_asin.c
Normal file
13
contrib/libf2c/libF77/d_asin.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double asin();
|
||||
double d_asin(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_asin(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( asin(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_atan.c
Normal file
13
contrib/libf2c/libF77/d_atan.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double atan();
|
||||
double d_atan(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_atan(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( atan(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_atn2.c
Normal file
13
contrib/libf2c/libF77/d_atn2.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double atan2();
|
||||
double d_atn2(x,y) doublereal *x, *y;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_atn2(doublereal *x, doublereal *y)
|
||||
#endif
|
||||
{
|
||||
return( atan2(*x,*y) );
|
||||
}
|
||||
17
contrib/libf2c/libF77/d_cnjg.c
Normal file
17
contrib/libf2c/libF77/d_cnjg.c
Normal file
@ -0,0 +1,17 @@
|
||||
#include "f2c.h"
|
||||
|
||||
VOID
|
||||
#ifdef KR_headers
|
||||
d_cnjg(resx, z) doublecomplex *resx, *z;
|
||||
#else
|
||||
d_cnjg(doublecomplex *resx, doublecomplex *z)
|
||||
#endif
|
||||
{
|
||||
doublecomplex res;
|
||||
|
||||
res.r = z->r;
|
||||
res.i = - z->i;
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_cos.c
Normal file
13
contrib/libf2c/libF77/d_cos.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double cos();
|
||||
double d_cos(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_cos(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( cos(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_cosh.c
Normal file
13
contrib/libf2c/libF77/d_cosh.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double cosh();
|
||||
double d_cosh(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_cosh(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( cosh(*x) );
|
||||
}
|
||||
10
contrib/libf2c/libF77/d_dim.c
Normal file
10
contrib/libf2c/libF77/d_dim.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double d_dim(a,b) doublereal *a, *b;
|
||||
#else
|
||||
double d_dim(doublereal *a, doublereal *b)
|
||||
#endif
|
||||
{
|
||||
return( *a > *b ? *a - *b : 0);
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_exp.c
Normal file
13
contrib/libf2c/libF77/d_exp.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double exp();
|
||||
double d_exp(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_exp(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( exp(*x) );
|
||||
}
|
||||
10
contrib/libf2c/libF77/d_imag.c
Normal file
10
contrib/libf2c/libF77/d_imag.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double d_imag(z) doublecomplex *z;
|
||||
#else
|
||||
double d_imag(doublecomplex *z)
|
||||
#endif
|
||||
{
|
||||
return(z->i);
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_int.c
Normal file
13
contrib/libf2c/libF77/d_int.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
double d_int(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_int(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( (*x>0) ? floor(*x) : -floor(- *x) );
|
||||
}
|
||||
15
contrib/libf2c/libF77/d_lg10.c
Normal file
15
contrib/libf2c/libF77/d_lg10.c
Normal file
@ -0,0 +1,15 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#define log10e 0.43429448190325182765
|
||||
|
||||
#ifdef KR_headers
|
||||
double log();
|
||||
double d_lg10(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_lg10(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( log10e * log(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_log.c
Normal file
13
contrib/libf2c/libF77/d_log.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double log();
|
||||
double d_log(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_log(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( log(*x) );
|
||||
}
|
||||
40
contrib/libf2c/libF77/d_mod.c
Normal file
40
contrib/libf2c/libF77/d_mod.c
Normal file
@ -0,0 +1,40 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
#ifdef IEEE_drem
|
||||
double drem();
|
||||
#else
|
||||
double floor();
|
||||
#endif
|
||||
double d_mod(x,y) doublereal *x, *y;
|
||||
#else
|
||||
#ifdef IEEE_drem
|
||||
double drem(double, double);
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
#endif
|
||||
double d_mod(doublereal *x, doublereal *y)
|
||||
#endif
|
||||
{
|
||||
#ifdef IEEE_drem
|
||||
double xa, ya, z;
|
||||
if ((ya = *y) < 0.)
|
||||
ya = -ya;
|
||||
z = drem(xa = *x, ya);
|
||||
if (xa > 0) {
|
||||
if (z < 0)
|
||||
z += ya;
|
||||
}
|
||||
else if (z > 0)
|
||||
z -= ya;
|
||||
return z;
|
||||
#else
|
||||
double quotient;
|
||||
if( (quotient = *x / *y) >= 0)
|
||||
quotient = floor(quotient);
|
||||
else
|
||||
quotient = -floor(-quotient);
|
||||
return(*x - (*y) * quotient );
|
||||
#endif
|
||||
}
|
||||
14
contrib/libf2c/libF77/d_nint.c
Normal file
14
contrib/libf2c/libF77/d_nint.c
Normal file
@ -0,0 +1,14 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
double d_nint(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_nint(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( (*x)>=0 ?
|
||||
floor(*x + .5) : -floor(.5 - *x) );
|
||||
}
|
||||
10
contrib/libf2c/libF77/d_prod.c
Normal file
10
contrib/libf2c/libF77/d_prod.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double d_prod(x,y) real *x, *y;
|
||||
#else
|
||||
double d_prod(real *x, real *y)
|
||||
#endif
|
||||
{
|
||||
return( (*x) * (*y) );
|
||||
}
|
||||
12
contrib/libf2c/libF77/d_sign.c
Normal file
12
contrib/libf2c/libF77/d_sign.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double d_sign(a,b) doublereal *a, *b;
|
||||
#else
|
||||
double d_sign(doublereal *a, doublereal *b)
|
||||
#endif
|
||||
{
|
||||
double x;
|
||||
x = (*a >= 0 ? *a : - *a);
|
||||
return( *b >= 0 ? x : -x);
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_sin.c
Normal file
13
contrib/libf2c/libF77/d_sin.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double sin();
|
||||
double d_sin(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_sin(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( sin(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_sinh.c
Normal file
13
contrib/libf2c/libF77/d_sinh.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double sinh();
|
||||
double d_sinh(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_sinh(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( sinh(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_sqrt.c
Normal file
13
contrib/libf2c/libF77/d_sqrt.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double sqrt();
|
||||
double d_sqrt(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_sqrt(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( sqrt(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_tan.c
Normal file
13
contrib/libf2c/libF77/d_tan.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double tan();
|
||||
double d_tan(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_tan(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( tan(*x) );
|
||||
}
|
||||
13
contrib/libf2c/libF77/d_tanh.c
Normal file
13
contrib/libf2c/libF77/d_tanh.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double tanh();
|
||||
double d_tanh(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double d_tanh(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( tanh(*x) );
|
||||
}
|
||||
12
contrib/libf2c/libF77/derf_.c
Normal file
12
contrib/libf2c/libF77/derf_.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double erf();
|
||||
double G77_derf_0 (x) doublereal *x;
|
||||
#else
|
||||
extern double erf(double);
|
||||
double G77_derf_0 (doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( erf(*x) );
|
||||
}
|
||||
14
contrib/libf2c/libF77/derfc_.c
Normal file
14
contrib/libf2c/libF77/derfc_.c
Normal file
@ -0,0 +1,14 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern double erfc();
|
||||
|
||||
double G77_derfc_0 (x) doublereal *x;
|
||||
#else
|
||||
extern double erfc(double);
|
||||
|
||||
double G77_derfc_0 (doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return( erfc(*x) );
|
||||
}
|
||||
47
contrib/libf2c/libF77/dtime_.c
Normal file
47
contrib/libf2c/libF77/dtime_.c
Normal file
@ -0,0 +1,47 @@
|
||||
#include "time.h"
|
||||
#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"
|
||||
#endif
|
||||
|
||||
#undef Hz
|
||||
#ifdef CLK_TCK
|
||||
#define Hz CLK_TCK
|
||||
#else
|
||||
#ifdef HZ
|
||||
#define Hz HZ
|
||||
#else
|
||||
#define Hz 60
|
||||
#endif
|
||||
#endif
|
||||
|
||||
double
|
||||
#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] = (t.tms_utime - t0.tms_utime) / Hz;
|
||||
tarray[1] = (t.tms_stime - t0.tms_stime) / Hz;
|
||||
t0 = t;
|
||||
return tarray[0] + tarray[1];
|
||||
#endif
|
||||
}
|
||||
21
contrib/libf2c/libF77/ef1asc_.c
Normal file
21
contrib/libf2c/libF77/ef1asc_.c
Normal file
@ -0,0 +1,21 @@
|
||||
/* EFL support routine to copy string b to string a */
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
|
||||
#define M ( (long) (sizeof(long) - 1) )
|
||||
#define EVEN(x) ( ( (x)+ M) & (~M) )
|
||||
|
||||
#ifdef KR_headers
|
||||
extern VOID s_copy();
|
||||
G77_ef1asc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
|
||||
#else
|
||||
extern void s_copy(char*,char*,ftnlen,ftnlen);
|
||||
int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
|
||||
#endif
|
||||
{
|
||||
s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
|
||||
#ifdef __cplusplus
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
14
contrib/libf2c/libF77/ef1cmc_.c
Normal file
14
contrib/libf2c/libF77/ef1cmc_.c
Normal file
@ -0,0 +1,14 @@
|
||||
/* EFL support routine to compare two character strings */
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
|
||||
#else
|
||||
extern integer s_cmp(char*,char*,ftnlen,ftnlen);
|
||||
integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
|
||||
#endif
|
||||
{
|
||||
return( s_cmp( (char *)a, (char *)b, *la, *lb) );
|
||||
}
|
||||
12
contrib/libf2c/libF77/erf_.c
Normal file
12
contrib/libf2c/libF77/erf_.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double erf();
|
||||
double G77_erf_0 (x) real *x;
|
||||
#else
|
||||
extern double erf(double);
|
||||
double G77_erf_0 (real *x)
|
||||
#endif
|
||||
{
|
||||
return( erf(*x) );
|
||||
}
|
||||
12
contrib/libf2c/libF77/erfc_.c
Normal file
12
contrib/libf2c/libF77/erfc_.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double erfc();
|
||||
double G77_erfc_0 (x) real *x;
|
||||
#else
|
||||
extern double erfc(double);
|
||||
double G77_erfc_0 (real *x)
|
||||
#endif
|
||||
{
|
||||
return( erfc(*x) );
|
||||
}
|
||||
40
contrib/libf2c/libF77/etime_.c
Normal file
40
contrib/libf2c/libF77/etime_.c
Normal file
@ -0,0 +1,40 @@
|
||||
#include "time.h"
|
||||
#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"
|
||||
#endif
|
||||
|
||||
#undef Hz
|
||||
#ifdef CLK_TCK
|
||||
#define Hz CLK_TCK
|
||||
#else
|
||||
#ifdef HZ
|
||||
#define Hz HZ
|
||||
#else
|
||||
#define Hz 60
|
||||
#endif
|
||||
#endif
|
||||
|
||||
double
|
||||
#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] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz);
|
||||
#endif
|
||||
}
|
||||
37
contrib/libf2c/libF77/exit_.c
Normal file
37
contrib/libf2c/libF77/exit_.c
Normal file
@ -0,0 +1,37 @@
|
||||
/* 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
|
||||
extern void f_exit(void);
|
||||
#endif
|
||||
|
||||
void
|
||||
#ifdef KR_headers
|
||||
G77_exit_0 (rc) integer *rc;
|
||||
#else
|
||||
G77_exit_0 (integer *rc)
|
||||
#endif
|
||||
{
|
||||
#ifdef NO_ONEXIT
|
||||
f_exit();
|
||||
#endif
|
||||
exit(*rc);
|
||||
}
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
162
contrib/libf2c/libF77/f2ch.add
Normal file
162
contrib/libf2c/libF77/f2ch.add
Normal file
@ -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
|
||||
28
contrib/libf2c/libF77/getarg_.c
Normal file
28
contrib/libf2c/libF77/getarg_.c
Normal file
@ -0,0 +1,28 @@
|
||||
#include "f2c.h"
|
||||
|
||||
/*
|
||||
* subroutine getarg(k, c)
|
||||
* returns the kth unix command argument in fortran character
|
||||
* variable argument c
|
||||
*/
|
||||
|
||||
#ifdef KR_headers
|
||||
VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls;
|
||||
#else
|
||||
void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls)
|
||||
#endif
|
||||
{
|
||||
extern int f__xargc;
|
||||
extern char **f__xargv;
|
||||
register char *t;
|
||||
register int i;
|
||||
|
||||
if(*n>=0 && *n<f__xargc)
|
||||
t = f__xargv[*n];
|
||||
else
|
||||
t = "";
|
||||
for(i = 0; i<ls && *t!='\0' ; ++i)
|
||||
*s++ = *t++;
|
||||
for( ; i<ls ; ++i)
|
||||
*s++ = ' ';
|
||||
}
|
||||
51
contrib/libf2c/libF77/getenv_.c
Normal file
51
contrib/libf2c/libF77/getenv_.c
Normal file
@ -0,0 +1,51 @@
|
||||
#include "f2c.h"
|
||||
|
||||
/*
|
||||
* getenv - f77 subroutine to return environment variables
|
||||
*
|
||||
* called by:
|
||||
* call getenv (ENV_NAME, char_var)
|
||||
* where:
|
||||
* ENV_NAME is the name of an environment variable
|
||||
* char_var is a character variable which will receive
|
||||
* the current value of ENV_NAME, or all blanks
|
||||
* if ENV_NAME is not defined
|
||||
*/
|
||||
|
||||
#ifdef KR_headers
|
||||
VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
|
||||
#else
|
||||
void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
|
||||
#endif
|
||||
{
|
||||
extern char **environ;
|
||||
register char *ep, *fp, *flast;
|
||||
register char **env = environ;
|
||||
|
||||
flast = fname + flen;
|
||||
for(fp = fname ; fp < flast ; ++fp)
|
||||
if(*fp == ' ')
|
||||
{
|
||||
flast = fp;
|
||||
break;
|
||||
}
|
||||
|
||||
while (ep = *env++)
|
||||
{
|
||||
for(fp = fname; fp<flast ; )
|
||||
if(*fp++ != *ep++)
|
||||
goto endloop;
|
||||
|
||||
if(*ep++ == '=') { /* copy right hand side */
|
||||
while( *ep && --vlen>=0 )
|
||||
*value++ = *ep++;
|
||||
|
||||
goto blank;
|
||||
}
|
||||
endloop: ;
|
||||
}
|
||||
|
||||
blank:
|
||||
while( --vlen >= 0 )
|
||||
*value++ = ' ';
|
||||
}
|
||||
12
contrib/libf2c/libF77/h_abs.c
Normal file
12
contrib/libf2c/libF77/h_abs.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_abs(x) shortint *x;
|
||||
#else
|
||||
shortint h_abs(shortint *x)
|
||||
#endif
|
||||
{
|
||||
if(*x >= 0)
|
||||
return(*x);
|
||||
return(- *x);
|
||||
}
|
||||
10
contrib/libf2c/libF77/h_dim.c
Normal file
10
contrib/libf2c/libF77/h_dim.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_dim(a,b) shortint *a, *b;
|
||||
#else
|
||||
shortint h_dim(shortint *a, shortint *b)
|
||||
#endif
|
||||
{
|
||||
return( *a > *b ? *a - *b : 0);
|
||||
}
|
||||
13
contrib/libf2c/libF77/h_dnnt.c
Normal file
13
contrib/libf2c/libF77/h_dnnt.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
shortint h_dnnt(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
shortint h_dnnt(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
26
contrib/libf2c/libF77/h_indx.c
Normal file
26
contrib/libf2c/libF77/h_indx.c
Normal file
@ -0,0 +1,26 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
ftnlen i, n;
|
||||
char *s, *t, *bend;
|
||||
|
||||
n = la - lb + 1;
|
||||
bend = b + lb;
|
||||
|
||||
for(i = 0 ; i < n ; ++i)
|
||||
{
|
||||
s = a + i;
|
||||
t = b;
|
||||
while(t < bend)
|
||||
if(*s++ != *t++)
|
||||
goto no;
|
||||
return((shortint)i+1);
|
||||
no: ;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
10
contrib/libf2c/libF77/h_len.c
Normal file
10
contrib/libf2c/libF77/h_len.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_len(s, n) char *s; ftnlen n;
|
||||
#else
|
||||
shortint h_len(char *s, ftnlen n)
|
||||
#endif
|
||||
{
|
||||
return(n);
|
||||
}
|
||||
10
contrib/libf2c/libF77/h_mod.c
Normal file
10
contrib/libf2c/libF77/h_mod.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_mod(a,b) short *a, *b;
|
||||
#else
|
||||
shortint h_mod(short *a, short *b)
|
||||
#endif
|
||||
{
|
||||
return( *a % *b);
|
||||
}
|
||||
13
contrib/libf2c/libF77/h_nint.c
Normal file
13
contrib/libf2c/libF77/h_nint.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
shortint h_nint(x) real *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
shortint h_nint(real *x)
|
||||
#endif
|
||||
{
|
||||
return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
12
contrib/libf2c/libF77/h_sign.c
Normal file
12
contrib/libf2c/libF77/h_sign.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint h_sign(a,b) shortint *a, *b;
|
||||
#else
|
||||
shortint h_sign(shortint *a, shortint *b)
|
||||
#endif
|
||||
{
|
||||
shortint x;
|
||||
x = (*a >= 0 ? *a : - *a);
|
||||
return( *b >= 0 ? x : -x);
|
||||
}
|
||||
12
contrib/libf2c/libF77/hl_ge.c
Normal file
12
contrib/libf2c/libF77/hl_ge.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) >= 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/hl_gt.c
Normal file
12
contrib/libf2c/libF77/hl_gt.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) > 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/hl_le.c
Normal file
12
contrib/libf2c/libF77/hl_le.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) <= 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/hl_lt.c
Normal file
12
contrib/libf2c/libF77/hl_lt.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) < 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/i_abs.c
Normal file
12
contrib/libf2c/libF77/i_abs.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_abs(x) integer *x;
|
||||
#else
|
||||
integer i_abs(integer *x)
|
||||
#endif
|
||||
{
|
||||
if(*x >= 0)
|
||||
return(*x);
|
||||
return(- *x);
|
||||
}
|
||||
10
contrib/libf2c/libF77/i_dim.c
Normal file
10
contrib/libf2c/libF77/i_dim.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_dim(a,b) integer *a, *b;
|
||||
#else
|
||||
integer i_dim(integer *a, integer *b)
|
||||
#endif
|
||||
{
|
||||
return( *a > *b ? *a - *b : 0);
|
||||
}
|
||||
13
contrib/libf2c/libF77/i_dnnt.c
Normal file
13
contrib/libf2c/libF77/i_dnnt.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
integer i_dnnt(x) doublereal *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
integer i_dnnt(doublereal *x)
|
||||
#endif
|
||||
{
|
||||
return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
26
contrib/libf2c/libF77/i_indx.c
Normal file
26
contrib/libf2c/libF77/i_indx.c
Normal file
@ -0,0 +1,26 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
integer i_indx(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
ftnlen i, n;
|
||||
char *s, *t, *bend;
|
||||
|
||||
n = la - lb + 1;
|
||||
bend = b + lb;
|
||||
|
||||
for(i = 0 ; i < n ; ++i)
|
||||
{
|
||||
s = a + i;
|
||||
t = b;
|
||||
while(t < bend)
|
||||
if(*s++ != *t++)
|
||||
goto no;
|
||||
return(i+1);
|
||||
no: ;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
10
contrib/libf2c/libF77/i_len.c
Normal file
10
contrib/libf2c/libF77/i_len.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_len(s, n) char *s; ftnlen n;
|
||||
#else
|
||||
integer i_len(char *s, ftnlen n)
|
||||
#endif
|
||||
{
|
||||
return(n);
|
||||
}
|
||||
10
contrib/libf2c/libF77/i_mod.c
Normal file
10
contrib/libf2c/libF77/i_mod.c
Normal file
@ -0,0 +1,10 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_mod(a,b) integer *a, *b;
|
||||
#else
|
||||
integer i_mod(integer *a, integer *b)
|
||||
#endif
|
||||
{
|
||||
return( *a % *b);
|
||||
}
|
||||
13
contrib/libf2c/libF77/i_nint.c
Normal file
13
contrib/libf2c/libF77/i_nint.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double floor();
|
||||
integer i_nint(x) real *x;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
integer i_nint(real *x)
|
||||
#endif
|
||||
{
|
||||
return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
12
contrib/libf2c/libF77/i_sign.c
Normal file
12
contrib/libf2c/libF77/i_sign.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer i_sign(a,b) integer *a, *b;
|
||||
#else
|
||||
integer i_sign(integer *a, integer *b)
|
||||
#endif
|
||||
{
|
||||
integer x;
|
||||
x = (*a >= 0 ? *a : - *a);
|
||||
return( *b >= 0 ? x : -x);
|
||||
}
|
||||
11
contrib/libf2c/libF77/iargc_.c
Normal file
11
contrib/libf2c/libF77/iargc_.c
Normal file
@ -0,0 +1,11 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
ftnint G77_iargc_0 ()
|
||||
#else
|
||||
ftnint G77_iargc_0 (void)
|
||||
#endif
|
||||
{
|
||||
extern int f__xargc;
|
||||
return ( f__xargc - 1 );
|
||||
}
|
||||
12
contrib/libf2c/libF77/l_ge.c
Normal file
12
contrib/libf2c/libF77/l_ge.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
logical l_ge(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) >= 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/l_gt.c
Normal file
12
contrib/libf2c/libF77/l_gt.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
logical l_gt(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) > 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/l_le.c
Normal file
12
contrib/libf2c/libF77/l_le.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
logical l_le(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) <= 0);
|
||||
}
|
||||
12
contrib/libf2c/libF77/l_lt.c
Normal file
12
contrib/libf2c/libF77/l_lt.c
Normal file
@ -0,0 +1,12 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
extern integer s_cmp();
|
||||
logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb;
|
||||
#else
|
||||
extern integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
logical l_lt(char *a, char *b, ftnlen la, ftnlen lb)
|
||||
#endif
|
||||
{
|
||||
return(s_cmp(a,b,la,lb) < 0);
|
||||
}
|
||||
62
contrib/libf2c/libF77/lbitbits.c
Normal file
62
contrib/libf2c/libF77/lbitbits.c
Normal file
@ -0,0 +1,62 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#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));
|
||||
}
|
||||
11
contrib/libf2c/libF77/lbitshft.c
Normal file
11
contrib/libf2c/libF77/lbitshft.c
Normal file
@ -0,0 +1,11 @@
|
||||
#include "f2c.h"
|
||||
|
||||
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);
|
||||
}
|
||||
68
contrib/libf2c/libF77/main.c
Normal file
68
contrib/libf2c/libF77/main.c
Normal file
@ -0,0 +1,68 @@
|
||||
/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
|
||||
|
||||
#include <stdio.h>
|
||||
#include "signal1.h"
|
||||
|
||||
#ifndef KR_headers
|
||||
#undef VOID
|
||||
#include <stdlib.h>
|
||||
#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();
|
||||
extern int MAIN__();
|
||||
#else
|
||||
extern void f_init(void);
|
||||
extern int MAIN__(void);
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef KR_headers
|
||||
main(argc, argv) int argc; char **argv;
|
||||
#else
|
||||
main(int argc, char **argv)
|
||||
#endif
|
||||
{
|
||||
f_setarg(argc, argv);
|
||||
f_setsig();
|
||||
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. */
|
||||
}
|
||||
103
contrib/libf2c/libF77/makefile.netlib
Normal file
103
contrib/libf2c/libF77/makefile.netlib
Normal file
@ -0,0 +1,103 @@
|
||||
.SUFFIXES: .c .o
|
||||
CC = cc
|
||||
SHELL = /bin/sh
|
||||
CFLAGS = -O
|
||||
|
||||
# If your system lacks onexit() and you are not using an
|
||||
# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
|
||||
# e.g., by changing the above "CFLAGS =" line to
|
||||
# CFLAGS = -O -DNO_ONEXIT
|
||||
|
||||
# On at least some Sun systems, it is more appropriate to change the
|
||||
# "CFLAGS =" line to
|
||||
# CFLAGS = -O -Donexit=on_exit
|
||||
|
||||
# compile, then strip unnecessary symbols
|
||||
.c.o:
|
||||
$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
|
||||
ld -r -x -o $*.xxx $*.o
|
||||
mv $*.xxx $*.o
|
||||
## 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 = F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
|
||||
getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
|
||||
derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
|
||||
POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o
|
||||
CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
|
||||
DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
|
||||
REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
|
||||
r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
|
||||
r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
|
||||
r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
|
||||
DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
|
||||
d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
|
||||
d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
|
||||
d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
|
||||
d_sqrt.o d_tan.o d_tanh.o
|
||||
INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
|
||||
HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o
|
||||
CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
|
||||
EFL = ef1asc_.o ef1cmc_.o
|
||||
CHAR = F77_aloc.o s_cat.o s_cmp.o s_copy.o
|
||||
F90BIT = lbitbits.o lbitshft.o
|
||||
QINT = pow_qq.o qbitbits.o qbitshft.o
|
||||
TIME = dtime_.o etime_.o
|
||||
|
||||
all: signal1.h libF77.a
|
||||
|
||||
# You may need to adjust signal1.h suitably for your system...
|
||||
signal1.h: signal1.h0
|
||||
cp signal1.h0 signal1.h
|
||||
|
||||
# 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 the dependency list for libF77.a below.
|
||||
|
||||
# For INTEGER*8 support (which requires system-dependent adjustments to
|
||||
# f2c.h), add $(QINT) to the libf2c.a dependency list below...
|
||||
|
||||
libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
|
||||
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME)
|
||||
ar r libF77.a $?
|
||||
-ranlib libF77.a
|
||||
|
||||
### If your system lacks ranlib, you don't need it; see README.
|
||||
|
||||
Version.o: Version.c
|
||||
$(CC) -c Version.c
|
||||
|
||||
# To compile with C++, first "make f2c.h"
|
||||
f2c.h: f2ch.add
|
||||
cat /usr/include/f2c.h f2ch.add >f2c.h
|
||||
|
||||
install: libF77.a
|
||||
mv libF77.a /usr/lib
|
||||
ranlib /usr/lib/libF77.a
|
||||
|
||||
clean:
|
||||
rm -f libF77.a *.o
|
||||
|
||||
check:
|
||||
xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \
|
||||
c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
|
||||
d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
|
||||
d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
|
||||
d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
|
||||
derf_.c derfc_.c dtime_.c \
|
||||
ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \
|
||||
getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
|
||||
h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
|
||||
i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
|
||||
i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \
|
||||
main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \
|
||||
pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \
|
||||
r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
|
||||
r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
|
||||
r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
|
||||
r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
|
||||
s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \
|
||||
z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
|
||||
cmp zap libF77.xsum && rm zap || diff libF77.xsum zap
|
||||
20
contrib/libf2c/libF77/pow_ci.c
Normal file
20
contrib/libf2c/libF77/pow_ci.c
Normal file
@ -0,0 +1,20 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
VOID pow_ci(p, a, b) /* p = a**b */
|
||||
complex *p, *a; integer *b;
|
||||
#else
|
||||
extern void pow_zi(doublecomplex*, doublecomplex*, integer*);
|
||||
void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */
|
||||
#endif
|
||||
{
|
||||
doublecomplex p1, a1;
|
||||
|
||||
a1.r = a->r;
|
||||
a1.i = a->i;
|
||||
|
||||
pow_zi(&p1, &a1, b);
|
||||
|
||||
p->r = p1.r;
|
||||
p->i = p1.i;
|
||||
}
|
||||
13
contrib/libf2c/libF77/pow_dd.c
Normal file
13
contrib/libf2c/libF77/pow_dd.c
Normal file
@ -0,0 +1,13 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double pow();
|
||||
double pow_dd(ap, bp) doublereal *ap, *bp;
|
||||
#else
|
||||
#undef abs
|
||||
#include <math.h>
|
||||
double pow_dd(doublereal *ap, doublereal *bp)
|
||||
#endif
|
||||
{
|
||||
return(pow(*ap, *bp) );
|
||||
}
|
||||
35
contrib/libf2c/libF77/pow_di.c
Normal file
35
contrib/libf2c/libF77/pow_di.c
Normal file
@ -0,0 +1,35 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double pow_di(ap, bp) doublereal *ap; integer *bp;
|
||||
#else
|
||||
double pow_di(doublereal *ap, integer *bp)
|
||||
#endif
|
||||
{
|
||||
double pow, x;
|
||||
integer n;
|
||||
unsigned long u;
|
||||
|
||||
pow = 1;
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if(n != 0)
|
||||
{
|
||||
if(n < 0)
|
||||
{
|
||||
n = -n;
|
||||
x = 1/x;
|
||||
}
|
||||
for(u = n; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
pow *= x;
|
||||
if(u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
}
|
||||
return(pow);
|
||||
}
|
||||
33
contrib/libf2c/libF77/pow_hh.c
Normal file
33
contrib/libf2c/libF77/pow_hh.c
Normal file
@ -0,0 +1,33 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
shortint pow_hh(ap, bp) shortint *ap, *bp;
|
||||
#else
|
||||
shortint pow_hh(shortint *ap, shortint *bp)
|
||||
#endif
|
||||
{
|
||||
shortint pow, x, n;
|
||||
unsigned u;
|
||||
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1)
|
||||
return 1;
|
||||
if (x != -1)
|
||||
return x == 0 ? 1/x : 0;
|
||||
n = -n;
|
||||
}
|
||||
u = n;
|
||||
for(pow = 1; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
pow *= x;
|
||||
if(u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
return(pow);
|
||||
}
|
||||
33
contrib/libf2c/libF77/pow_ii.c
Normal file
33
contrib/libf2c/libF77/pow_ii.c
Normal file
@ -0,0 +1,33 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
integer pow_ii(ap, bp) integer *ap, *bp;
|
||||
#else
|
||||
integer pow_ii(integer *ap, integer *bp)
|
||||
#endif
|
||||
{
|
||||
integer pow, x, n;
|
||||
unsigned long u;
|
||||
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1)
|
||||
return 1;
|
||||
if (x != -1)
|
||||
return x == 0 ? 1/x : 0;
|
||||
n = -n;
|
||||
}
|
||||
u = n;
|
||||
for(pow = 1; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
pow *= x;
|
||||
if(u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
return(pow);
|
||||
}
|
||||
33
contrib/libf2c/libF77/pow_qq.c
Normal file
33
contrib/libf2c/libF77/pow_qq.c
Normal file
@ -0,0 +1,33 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
longint pow_qq(ap, bp) longint *ap, *bp;
|
||||
#else
|
||||
longint pow_qq(longint *ap, longint *bp)
|
||||
#endif
|
||||
{
|
||||
longint pow, x, n;
|
||||
unsigned long long u; /* system-dependent */
|
||||
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1)
|
||||
return 1;
|
||||
if (x != -1)
|
||||
return x == 0 ? 1/x : 0;
|
||||
n = -n;
|
||||
}
|
||||
u = n;
|
||||
for(pow = 1; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
pow *= x;
|
||||
if(u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
return(pow);
|
||||
}
|
||||
35
contrib/libf2c/libF77/pow_ri.c
Normal file
35
contrib/libf2c/libF77/pow_ri.c
Normal file
@ -0,0 +1,35 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
double pow_ri(ap, bp) real *ap; integer *bp;
|
||||
#else
|
||||
double pow_ri(real *ap, integer *bp)
|
||||
#endif
|
||||
{
|
||||
double pow, x;
|
||||
integer n;
|
||||
unsigned long u;
|
||||
|
||||
pow = 1;
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if(n != 0)
|
||||
{
|
||||
if(n < 0)
|
||||
{
|
||||
n = -n;
|
||||
x = 1/x;
|
||||
}
|
||||
for(u = n; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
pow *= x;
|
||||
if(u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
}
|
||||
return(pow);
|
||||
}
|
||||
61
contrib/libf2c/libF77/pow_zi.c
Normal file
61
contrib/libf2c/libF77/pow_zi.c
Normal file
@ -0,0 +1,61 @@
|
||||
#include "f2c.h"
|
||||
|
||||
#ifdef KR_headers
|
||||
VOID pow_zi(resx, a, b) /* p = a**b */
|
||||
doublecomplex *resx, *a; integer *b;
|
||||
#else
|
||||
extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
|
||||
void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */
|
||||
#endif
|
||||
{
|
||||
integer n;
|
||||
unsigned long u;
|
||||
double t;
|
||||
doublecomplex x;
|
||||
doublecomplex res;
|
||||
static doublecomplex one = {1.0, 0.0};
|
||||
|
||||
n = *b;
|
||||
|
||||
if(n == 0)
|
||||
{
|
||||
resx->r = 1;
|
||||
resx->i = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
res.r = 1;
|
||||
res.i = 0;
|
||||
|
||||
if(n < 0)
|
||||
{
|
||||
n = -n;
|
||||
z_div(&x, &one, a);
|
||||
}
|
||||
else
|
||||
{
|
||||
x.r = a->r;
|
||||
x.i = a->i;
|
||||
}
|
||||
|
||||
for(u = n; ; )
|
||||
{
|
||||
if(u & 01)
|
||||
{
|
||||
t = res.r * x.r - res.i * x.i;
|
||||
res.i = res.r * x.i + res.i * x.r;
|
||||
res.r = t;
|
||||
}
|
||||
if(u >>= 1)
|
||||
{
|
||||
t = x.r * x.r - x.i * x.i;
|
||||
x.i = 2 * x.r * x.i;
|
||||
x.r = t;
|
||||
}
|
||||
else
|
||||
break;
|
||||
}
|
||||
|
||||
resx->r = res.r;
|
||||
resx->i = res.i;
|
||||
}
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user