mirror of git://gcc.gnu.org/git/gcc.git
libf2c: Removed.
2004-07-15 Toon Moene <toon@moene.indiv.nluug.nl> * libf2c: Removed. * gcc/gccbug.in: Updated because of libf2c removal. * maintainer-scripts/gcc_release: Ditto. From-SVN: r84759
This commit is contained in:
Toon Moene
Toon Moene
parent
48b456474c
commit
3e4035f833
|
|
@ -1,3 +1,9 @@
|
||||||
|
2004-07-15 Toon Moene <toon@moene.indiv.nluug.nl>
|
||||||
|
|
||||||
|
* libf2c: Removed.
|
||||||
|
* gcc/gccbug.in: Updated because of libf2c removal.
|
||||||
|
* maintainer-scripts/gcc_release: Ditto.
|
||||||
|
|
||||||
2004-07-09 Loren J. Rittle <ljrittle@acm.org>
|
2004-07-09 Loren J. Rittle <ljrittle@acm.org>
|
||||||
|
|
||||||
* configure.in: Build libmudflap by default on FreeBSD.
|
* configure.in: Build libmudflap by default on FreeBSD.
|
||||||
|
|
|
||||||
|
|
@ -198,7 +198,7 @@ EOF
|
||||||
done
|
done
|
||||||
|
|
||||||
# spam does not need to be listed here
|
# spam does not need to be listed here
|
||||||
CATEGORIES="ada bootstrap c++ c debug driver fortran inline-asm java libf2c libgcj libobjc libstdc++ middle-end objc other pch preprocessor rtl-optimization target tree-optimization web"
|
CATEGORIES="ada bootstrap c++ c debug driver fortran inline-asm java libgcj libobjc libstdc++ middle-end objc other pch preprocessor rtl-optimization target tree-optimization web"
|
||||||
|
|
||||||
case "$FORMAT" in
|
case "$FORMAT" in
|
||||||
lisp) echo "$CATEGORIES" | \
|
lisp) echo "$CATEGORIES" | \
|
||||||
|
|
|
||||||
2423
libf2c/ChangeLog
2423
libf2c/ChangeLog
File diff suppressed because it is too large
Load Diff
|
|
@ -1,276 +0,0 @@
|
||||||
# Makefile for GNU F77 compiler runtime.
|
|
||||||
# Copyright (C) 1995-1998, 2001, 2002, 2003 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 = @SHELL@
|
|
||||||
PWD_COMMAND = $${PWDCMD-pwd}
|
|
||||||
MAKEOVERRIDES=
|
|
||||||
.NOEXPORTS:
|
|
||||||
|
|
||||||
#### Start of system configuration section. ####
|
|
||||||
|
|
||||||
srcdir = @glibcpp_srcdir@
|
|
||||||
VPATH = @glibcpp_srcdir@
|
|
||||||
prefix = @prefix@
|
|
||||||
exec_prefix = @exec_prefix@
|
|
||||||
target_alias = @target_alias@
|
|
||||||
gcc_version = @gcc_version@
|
|
||||||
gcc_version_trigger = @gcc_version_trigger@
|
|
||||||
top_srcdir = @top_srcdir@
|
|
||||||
toplevel_srcdir = @toplevel_srcdir@
|
|
||||||
toolexecdir = @glibcpp_toolexecdir@
|
|
||||||
glibcpp_toolexecdir = @glibcpp_toolexecdir@
|
|
||||||
glibcpp_toolexeclibdir = @glibcpp_toolexeclibdir@
|
|
||||||
|
|
||||||
top_builddir = .
|
|
||||||
|
|
||||||
libdir = $(exec_prefix)/lib
|
|
||||||
libsubdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)
|
|
||||||
#
|
|
||||||
# Versions should start at 0:0:0 - See libtool manual.
|
|
||||||
VERSION_MAJOR=0
|
|
||||||
VERSION_MINOR=0
|
|
||||||
VERSION_SUB=0
|
|
||||||
|
|
||||||
# Multilib support variables.
|
|
||||||
MULTISRCTOP =
|
|
||||||
MULTIBUILDTOP =
|
|
||||||
MULTIDIRS =
|
|
||||||
MULTISUBDIR =
|
|
||||||
MULTIDO = true
|
|
||||||
MULTICLEAN = true
|
|
||||||
|
|
||||||
# Not configured per top-level version, since that doesn't get passed
|
|
||||||
# Versions should start at 0:0:0 - See libtool manual.
|
|
||||||
# down at configure time, but overrridden by the top-level install
|
|
||||||
# target.
|
|
||||||
INSTALL = @INSTALL@
|
|
||||||
INSTALL_PROGRAM = @INSTALL_PROGRAM@
|
|
||||||
INSTALL_DATA = @INSTALL_DATA@
|
|
||||||
|
|
||||||
LIBTOOL = @LIBTOOL@
|
|
||||||
CC = @CC@
|
|
||||||
WARN_CFLAGS = -W -Wall
|
|
||||||
CFLAGS = @CFLAGS@
|
|
||||||
AR = @AR@
|
|
||||||
RANLIB = @RANLIB@
|
|
||||||
|
|
||||||
# List of variables to pass to sub-makes.
|
|
||||||
# Quote this way so that it can be used to set shell variables too.
|
|
||||||
FLAGS_TO_PASS= \
|
|
||||||
CC='$(CC)' \
|
|
||||||
LD='$(LD)' \
|
|
||||||
LIBTOOL='$(LIBTOOL)' \
|
|
||||||
WARN_CFLAGS='$(WARN_CFLAGS)' \
|
|
||||||
CFLAGS='$(CFLAGS)' \
|
|
||||||
CPPFLAGS='$(CPPFLAGS)' \
|
|
||||||
DESTDIR='$(DESTDIR)' \
|
|
||||||
AR='$(AR)' \
|
|
||||||
RANLIB='$(RANLIB)' \
|
|
||||||
prefix='$(prefix)' \
|
|
||||||
exec_prefix='$(exec_prefix)' \
|
|
||||||
libdir='$(libdir)' \
|
|
||||||
libsubdir='$(libsubdir)' \
|
|
||||||
tooldir='$(tooldir)'
|
|
||||||
|
|
||||||
LIBG2C_BASE = libg2c
|
|
||||||
LIBG2C = $(LIBG2C_BASE).la
|
|
||||||
|
|
||||||
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 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 \
|
|
||||||
vxttim alarm \
|
|
||||||
date_y2kbuggy date_y2kbug vxtidt_y2kbuggy vxtidt_y2kbug
|
|
||||||
|
|
||||||
.SUFFIXES:
|
|
||||||
|
|
||||||
# The logic here is partly dictated by the desire to keep the lib?77
|
|
||||||
# subdirs for compatibility with the Netlib version and because libU77
|
|
||||||
# has a different copyright; then the libe77 bit (EXTERNALly-callable
|
|
||||||
# versions) is funny. Given that, as well as keeping things as simple
|
|
||||||
# as possible we want (at least) the following:
|
|
||||||
# * Allow make to be run at the top level (all-target-libf2c), at this
|
|
||||||
# level, or the subdirs of this level. In the latter case we only
|
|
||||||
# compile, rather than updating libg2c.a;
|
|
||||||
# * A robust set of dependencies, so that we rebuild (as little as
|
|
||||||
# possible) if a configuration file, g2c.h or any lib?77/*.c file
|
|
||||||
# changes;
|
|
||||||
# * Avoid unnecessary running of ar and ranlib;
|
|
||||||
# * Expose parallelism where reasonable, but not as a priority.
|
|
||||||
|
|
||||||
# The intended top-level target here does a non-multilib build (via
|
|
||||||
# the dependency) and then (perhaps) builds multilibs.
|
|
||||||
|
|
||||||
all: all-unilib
|
|
||||||
: $(MAKE) ; exec $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="all-unilib"
|
|
||||||
|
|
||||||
# `all-unilib' is the overall target in the absence of multilibs,
|
|
||||||
# meant to be invoked via multi-do for multilibs.
|
|
||||||
|
|
||||||
# Its dependencies can be satisfied in parallel. The [fiu]77 targets
|
|
||||||
# update stamp files (object file lists, actually, see the subdir
|
|
||||||
# makefiles) on which the $(LIBG2C) depends. The stamp files
|
|
||||||
# s-lib[fiu]77 are intentionally not targets, since we're only meant
|
|
||||||
# to come in at the level of this target. The [fiu]77 targets always
|
|
||||||
# invoke sub makes to check dependencies in the subdirs, else we'd
|
|
||||||
# have to maintain them at this level; we live with the overhead of
|
|
||||||
# some recursive makes which may do nothing.
|
|
||||||
|
|
||||||
all-unilib: i77 f77 u77 s-libe77
|
|
||||||
$(MAKE) $(FLAGS_TO_PASS) $(LIBG2C)
|
|
||||||
|
|
||||||
i77 f77 u77: g2c.h
|
|
||||||
|
|
||||||
# This target should normally only get invoked via `all-unilib' --
|
|
||||||
# after all's well in the subdirs -- actually to assemble the library.
|
|
||||||
# The stamp files contain the object lists of each component of the
|
|
||||||
# library. The point of breaking them up is to avoid command-line
|
|
||||||
# length limitations.
|
|
||||||
|
|
||||||
$(LIBG2C): s-libi77 s-libf77 s-libu77 s-libe77
|
|
||||||
$(LIBTOOL) --mode=link $(CC) -o $@ \
|
|
||||||
-version-info $(VERSION_MAJOR):$(VERSION_MINOR):$(VERSION_SUB) \
|
|
||||||
-rpath $(glibcpp_toolexeclibdir) \
|
|
||||||
-objectlist s-libe77 \
|
|
||||||
-objectlist s-libf77 \
|
|
||||||
-objectlist s-libi77 \
|
|
||||||
-objectlist s-libu77 \
|
|
||||||
-lm
|
|
||||||
|
|
||||||
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 libE77/*.lo; else mkdir libE77; fi
|
|
||||||
-rm -f $@.T $@
|
|
||||||
for name in $(F2CEXT); \
|
|
||||||
do \
|
|
||||||
echo $${name}; \
|
|
||||||
$(LIBTOOL) --mode=compile $(CC) -c -I. -I$(srcdir) -I../../include \
|
|
||||||
$(CPPFLAGS) $(WARN_CFLAGS) $(CFLAGS) -DL$${name} $(srcdir)/f2cext.c \
|
|
||||||
-o libE77/L$${name}.lo ; \
|
|
||||||
if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
|
|
||||||
echo libE77/L$${name}.lo >> $@.T; \
|
|
||||||
done
|
|
||||||
mv $@.T $@
|
|
||||||
|
|
||||||
f2cext.c: g2c.h
|
|
||||||
|
|
||||||
${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
|
|
||||||
# $(SHELL) $(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)?
|
|
||||||
$(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
|
|
||||||
$(SHELL) $(toplevel_srcdir)/mkinstalldirs $(DESTDIR)$(glibcpp_toolexeclibdir)
|
|
||||||
$(LIBTOOL) --mode=install $(INSTALL) $(LIBG2C) $(DESTDIR)$(glibcpp_toolexeclibdir)
|
|
||||||
$(INSTALL_DATA) libfrtbegin.a $(DESTDIR)$(glibcpp_toolexeclibdir)
|
|
||||||
$(RANLIB) $(DESTDIR)$(glibcpp_toolexeclibdir)/libfrtbegin.a
|
|
||||||
$(INSTALL_DATA) g2c.h $(DESTDIR)$(libsubdir)/include/g2c.h
|
|
||||||
$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@"
|
|
||||||
@-$(LIBTOOL) --mode=finish $(DESTDIR)$(glibcpp_toolexeclibdir)
|
|
||||||
|
|
||||||
install-strip:
|
|
||||||
$(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install
|
|
||||||
|
|
||||||
uninstall:
|
|
||||||
rm -f $(DESTDIR)$(libsubdir)/include/g2c.h
|
|
||||||
rm -f $(DESTDIR)$(glibcpp_toolexeclibdir)/libfrtbegin.a
|
|
||||||
$(LIBTOOL) --mode=uninstall rm -f $(DESTDIR)$(glibcpp_toolexeclibdir)$(LIBG2C_BASE).la
|
|
||||||
$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO="$@"
|
|
||||||
|
|
||||||
mostlyclean:
|
|
||||||
rm -f $(LIBG2C) objlist
|
|
||||||
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
|
|
||||||
$(MULTICLEAN) multi-clean DO=$@
|
|
||||||
rm -fr libE77 s-libe77
|
|
||||||
|
|
||||||
clean: mostlyclean
|
|
||||||
rm -f config.log
|
|
||||||
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
|
|
||||||
$(MULTICLEAN) multi-clean DO=$@
|
|
||||||
rm -rf .libs
|
|
||||||
|
|
||||||
distclean: clean
|
|
||||||
rm -f g2c.h s-libe77
|
|
||||||
$(MAKE) DO=$@ DODIRS="$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do; \
|
|
||||||
$(MULTICLEAN) multi-clean DO=distclean
|
|
||||||
rm -f config.cache config.status Makefile
|
|
||||||
|
|
||||||
maintainer-clean:
|
|
||||||
|
|
||||||
rebuilt: configure
|
|
||||||
|
|
||||||
.PHONY: rebuilt mostlyclean clean distclean maintainer-clean all \
|
|
||||||
i77 f77 u77 check uninstall install-strip dist \
|
|
||||||
installcheck installdirs all-unilib
|
|
||||||
|
|
||||||
subdir_do:
|
|
||||||
@rootpre=`${PWD_COMMAND}`/; export rootpre; \
|
|
||||||
srcrootpre=`cd $(srcdir); ${PWD_COMMAND}`/; export srcrootpre; \
|
|
||||||
for i in .. $(DODIRS); do \
|
|
||||||
if [ x$$i != x.. ]; then \
|
|
||||||
if [ -f ./$$i/Makefile ]; then \
|
|
||||||
if (cd ./$$i; $(MAKE) $(FLAGS_TO_PASS) $(DO)); then \
|
|
||||||
true; \
|
|
||||||
else \
|
|
||||||
exit 1; \
|
|
||||||
fi; \
|
|
||||||
else true; fi; \
|
|
||||||
else true; fi; \
|
|
||||||
done
|
|
||||||
|
|
||||||
# multidoings may be added here by configure.
|
|
||||||
109
libf2c/README
109
libf2c/README
|
|
@ -1,109 +0,0 @@
|
||||||
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
libf2c/TODO
14
libf2c/TODO
|
|
@ -1,14 +0,0 @@
|
||||||
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.
|
|
||||||
|
|
@ -1,236 +0,0 @@
|
||||||
dnl Copyright (C) 1994, 1995-8, 1999, 2001, 2002 Free Software Foundation, Inc.
|
|
||||||
dnl This file is free software; the Free Software Foundation
|
|
||||||
dnl gives unlimited permission to copy and/or distribute it,
|
|
||||||
dnl with or without modifications, as long as this notice is preserved.
|
|
||||||
|
|
||||||
dnl This program is distributed in the hope that it will be useful,
|
|
||||||
dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
|
|
||||||
dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
|
||||||
dnl PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
dnl
|
|
||||||
dnl Initialize configure bits.
|
|
||||||
dnl
|
|
||||||
dnl GLIBCPP_TOPREL_CONFIGURE
|
|
||||||
AC_DEFUN(GLIBCPP_TOPREL_CONFIGURE, [
|
|
||||||
dnl Default to --enable-multilib
|
|
||||||
AC_ARG_ENABLE(multilib,
|
|
||||||
[ --enable-multilib build hella library versions (default)],
|
|
||||||
[case "${enableval}" in
|
|
||||||
yes) multilib=yes ;;
|
|
||||||
no) multilib=no ;;
|
|
||||||
*) AC_MSG_ERROR(bad value ${enableval} for multilib option) ;;
|
|
||||||
esac], [multilib=yes])dnl
|
|
||||||
|
|
||||||
# When building with srcdir == objdir, links to the source files will
|
|
||||||
# be created in directories within the target_subdir. We have to
|
|
||||||
# adjust toplevel_srcdir accordingly, so that configure finds
|
|
||||||
# install-sh and other auxiliary files that live in the top-level
|
|
||||||
# source directory.
|
|
||||||
if test "${srcdir}" = "."; then
|
|
||||||
if test -z "${with_target_subdir}"; then
|
|
||||||
toprel=".."
|
|
||||||
else
|
|
||||||
if test "${with_target_subdir}" != "."; then
|
|
||||||
toprel="${with_multisrctop}../.."
|
|
||||||
else
|
|
||||||
toprel="${with_multisrctop}.."
|
|
||||||
fi
|
|
||||||
fi
|
|
||||||
else
|
|
||||||
toprel=".."
|
|
||||||
fi
|
|
||||||
AC_CONFIG_AUX_DIR(${srcdir}/$toprel)
|
|
||||||
toplevel_srcdir=\${top_srcdir}/$toprel
|
|
||||||
AC_SUBST(toplevel_srcdir)
|
|
||||||
])
|
|
||||||
|
|
||||||
dnl
|
|
||||||
dnl Initialize configure bits.
|
|
||||||
dnl
|
|
||||||
dnl GLIBCPP_CONFIGURE
|
|
||||||
AC_DEFUN(GLIBCPP_CONFIGURE, [
|
|
||||||
# Export build and source directories.
|
|
||||||
# These need to be absolute paths, yet at the same time need to
|
|
||||||
# canonicalize only relative paths, because then amd will not unmount
|
|
||||||
# drives. Thus the use of PWDCMD: set it to 'pawd' or 'amq -w' if using amd.
|
|
||||||
glibcpp_builddir=`${PWDCMD-pwd}`
|
|
||||||
case $srcdir in
|
|
||||||
[\\/$]* | ?:[\\/]*) glibcpp_srcdir=${srcdir} ;;
|
|
||||||
*) glibcpp_srcdir=`cd "$srcdir" && ${PWDCMD-pwd} || echo "$srcdir"` ;;
|
|
||||||
esac
|
|
||||||
AC_SUBST(glibcpp_builddir)
|
|
||||||
AC_SUBST(glibcpp_srcdir)
|
|
||||||
|
|
||||||
dnl This is here just to satisfy automake.
|
|
||||||
ifelse(not,equal,[AC_CONFIG_AUX_DIR(..)])
|
|
||||||
|
|
||||||
# Will set LN_S to either 'ln -s' or 'ln'. With autoconf 2.50+, can also
|
|
||||||
# be 'cp -p' if linking isn't available.
|
|
||||||
#ac_cv_prog_LN_S='cp -p'
|
|
||||||
AC_PROG_LN_S
|
|
||||||
|
|
||||||
# We use these options to decide which functions to include.
|
|
||||||
AC_ARG_WITH(target-subdir,
|
|
||||||
[ --with-target-subdir=SUBDIR
|
|
||||||
configuring in a subdirectory])
|
|
||||||
AC_ARG_WITH(cross-host,
|
|
||||||
[ --with-cross-host=HOST configuring with a cross compiler])
|
|
||||||
|
|
||||||
# Never versions of autoconf add an underscore to these functions.
|
|
||||||
# Prevent future problems ...
|
|
||||||
ifdef([AC_PROG_CC_G],[],[define([AC_PROG_CC_G],defn([_AC_PROG_CC_G]))])
|
|
||||||
ifdef([AC_PROG_CC_GNU],[],[define([AC_PROG_CC_GNU],defn([_AC_PROG_CC_GNU]))])
|
|
||||||
ifdef([AC_PROG_CXX_G],[],[define([AC_PROG_CXX_G],defn([_AC_PROG_CXX_G]))])
|
|
||||||
ifdef([AC_PROG_CXX_GNU],[],[define([AC_PROG_CXX_GNU],defn([_AC_PROG_CXX_GNU]))])
|
|
||||||
|
|
||||||
# AC_PROG_CC
|
|
||||||
|
|
||||||
# FIXME: We temporarily define our own version of AC_PROG_CC. This is
|
|
||||||
# copied from autoconf 2.12, but does not call AC_PROG_CC_WORKS. We
|
|
||||||
# are probably using a cross compiler, which will not be able to fully
|
|
||||||
# link an executable. This should really be fixed in autoconf
|
|
||||||
# itself.
|
|
||||||
|
|
||||||
AC_DEFUN(LIB_AC_PROG_CC,
|
|
||||||
[AC_BEFORE([$0], [AC_PROG_CPP])dnl
|
|
||||||
dnl Fool anybody using AC_PROG_CC.
|
|
||||||
AC_PROVIDE([AC_PROG_CC])
|
|
||||||
AC_CHECK_PROG(CC, gcc, gcc)
|
|
||||||
if test -z "$CC"; then
|
|
||||||
AC_CHECK_PROG(CC, cc, cc, , , /usr/ucb/cc)
|
|
||||||
test -z "$CC" && AC_MSG_ERROR([no acceptable cc found in \$PATH])
|
|
||||||
fi
|
|
||||||
|
|
||||||
AC_PROG_CC_GNU
|
|
||||||
|
|
||||||
if test $ac_cv_prog_gcc = yes; then
|
|
||||||
GCC=yes
|
|
||||||
dnl Check whether -g works, even if CFLAGS is set, in case the package
|
|
||||||
dnl plays around with CFLAGS (such as to build both debugging and
|
|
||||||
dnl normal versions of a library), tasteless as that idea is.
|
|
||||||
ac_test_CFLAGS="${CFLAGS+set}"
|
|
||||||
ac_save_CFLAGS="$CFLAGS"
|
|
||||||
CFLAGS=
|
|
||||||
AC_PROG_CC_G
|
|
||||||
if test "$ac_test_CFLAGS" = set; then
|
|
||||||
CFLAGS="$ac_save_CFLAGS"
|
|
||||||
elif test $ac_cv_prog_cc_g = yes; then
|
|
||||||
CFLAGS="-g -O2"
|
|
||||||
else
|
|
||||||
CFLAGS="-O2"
|
|
||||||
fi
|
|
||||||
else
|
|
||||||
GCC=
|
|
||||||
test "${CFLAGS+set}" = set || CFLAGS="-g"
|
|
||||||
fi
|
|
||||||
])
|
|
||||||
|
|
||||||
LIB_AC_PROG_CC
|
|
||||||
|
|
||||||
AC_CHECK_TOOL(AS, as)
|
|
||||||
AC_CHECK_TOOL(AR, ar)
|
|
||||||
AC_CHECK_TOOL(RANLIB, ranlib, ranlib-not-found-in-path-error)
|
|
||||||
AC_PROG_INSTALL
|
|
||||||
|
|
||||||
# We need AC_EXEEXT to keep automake happy in cygnus mode. However,
|
|
||||||
# at least currently, we never actually build a program, so we never
|
|
||||||
# need to use $(EXEEXT). Moreover, the test for EXEEXT normally
|
|
||||||
# fails, because we are probably configuring with a cross compiler
|
|
||||||
# which can't create executables. So we include AC_EXEEXT to keep
|
|
||||||
# automake happy, but we don't execute it, since we don't care about
|
|
||||||
# the result.
|
|
||||||
if false; then
|
|
||||||
# autoconf 2.50 runs AC_EXEEXT by default, and the macro expands
|
|
||||||
# to nothing, so nothing would remain between `then' and `fi' if it
|
|
||||||
# were not for the `:' below.
|
|
||||||
:
|
|
||||||
AC_EXEEXT
|
|
||||||
fi
|
|
||||||
])
|
|
||||||
|
|
||||||
|
|
||||||
dnl
|
|
||||||
dnl GLIBCPP_EXPORT_INSTALL_INFO
|
|
||||||
dnl calculates gxx_install_dir
|
|
||||||
dnl exports glibcpp_toolexecdir
|
|
||||||
dnl exports glibcpp_toolexeclibdir
|
|
||||||
dnl exports glibcpp_prefixdir
|
|
||||||
dnl
|
|
||||||
dnl Assumes cross_compiling bits already done, and with_cross_host in
|
|
||||||
dnl particular
|
|
||||||
dnl
|
|
||||||
dnl GLIBCPP_EXPORT_INSTALL_INFO
|
|
||||||
AC_DEFUN(GLIBCPP_EXPORT_INSTALL_INFO, [
|
|
||||||
# Assumes glibcpp_builddir, glibcpp_srcdir are alreay set up and
|
|
||||||
# exported correctly in GLIBCPP_CONFIGURE.
|
|
||||||
glibcpp_toolexecdir=no
|
|
||||||
glibcpp_toolexeclibdir=no
|
|
||||||
glibcpp_prefixdir=${prefix}
|
|
||||||
|
|
||||||
AC_MSG_CHECKING([for interface version number])
|
|
||||||
libstdcxx_interface=$INTERFACE
|
|
||||||
AC_MSG_RESULT($libstdcxx_interface)
|
|
||||||
|
|
||||||
# Process the option "--enable-version-specific-runtime-libs"
|
|
||||||
AC_MSG_CHECKING([for --enable-version-specific-runtime-libs])
|
|
||||||
AC_ARG_ENABLE(version-specific-runtime-libs,
|
|
||||||
[ --enable-version-specific-runtime-libs Specify that runtime libraries should be installed in a compiler-specific directory ],
|
|
||||||
[case "$enableval" in
|
|
||||||
yes) version_specific_libs=yes ;;
|
|
||||||
no) version_specific_libs=no ;;
|
|
||||||
*) AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);;
|
|
||||||
esac],
|
|
||||||
version_specific_libs=no)dnl
|
|
||||||
# Option set, now we can test it.
|
|
||||||
AC_MSG_RESULT($version_specific_libs)
|
|
||||||
|
|
||||||
gcc_version_trigger=${toplevel_srcdir}/gcc/version.c
|
|
||||||
gcc_version_full=`grep version_string ${gcc_version_trigger} | sed -e 's/.*\"\([[^ \"]]*\)[[ \"]].*/\1/'`
|
|
||||||
gcc_version=`echo ${gcc_version_full} | sed -e 's/\([^ ]*\) .*/\1/'`
|
|
||||||
AC_SUBST(gcc_version)
|
|
||||||
AC_SUBST(gcc_version_trigger)
|
|
||||||
|
|
||||||
if test $version_specific_libs = yes; then
|
|
||||||
# Need the gcc compiler version to know where to install libraries
|
|
||||||
# and header files if --enable-version-specific-runtime-libs option
|
|
||||||
# is selected. FIXME: "toolexecdir" is a misnomer, there are no
|
|
||||||
# executables installed there.
|
|
||||||
changequote(,)dnl
|
|
||||||
glibcpp_toolexecdir='$(libdir)/gcc/$(target_alias)'
|
|
||||||
glibcpp_toolexeclibdir='$(toolexecdir)/'${gcc_version}'$(MULTISUBDIR)'
|
|
||||||
changequote([,])dnl
|
|
||||||
fi
|
|
||||||
|
|
||||||
# Calculate glibcpp_toolexecdir, glibcpp_toolexeclibdir
|
|
||||||
# Install a library built with a cross compiler in tooldir, not libdir.
|
|
||||||
if test x"$glibcpp_toolexecdir" = x"no"; then
|
|
||||||
if test -n "$with_cross_host" &&
|
|
||||||
test x"$with_cross_host" != x"no"; then
|
|
||||||
glibcpp_toolexecdir='$(exec_prefix)/$(target_alias)'
|
|
||||||
glibcpp_toolexeclibdir='$(toolexecdir)/lib'
|
|
||||||
else
|
|
||||||
glibcpp_toolexecdir='$(libdir)/gcc/$(target_alias)'
|
|
||||||
glibcpp_toolexeclibdir='$(libdir)'
|
|
||||||
fi
|
|
||||||
multi_os_directory=`$CC -print-multi-os-directory`
|
|
||||||
case $multi_os_directory in
|
|
||||||
.) ;; # Avoid trailing /.
|
|
||||||
*) glibcpp_toolexeclibdir=$glibcpp_toolexeclibdir/$multi_os_directory ;;
|
|
||||||
esac
|
|
||||||
fi
|
|
||||||
|
|
||||||
AC_SUBST(glibcpp_prefixdir)
|
|
||||||
AC_SUBST(glibcpp_toolexecdir)
|
|
||||||
AC_SUBST(glibcpp_toolexeclibdir)
|
|
||||||
])
|
|
||||||
|
|
||||||
sinclude(../libtool.m4)
|
|
||||||
dnl The lines below arrange for aclocal not to bring an installed
|
|
||||||
dnl libtool.m4 into aclocal.m4, while still arranging for automake to
|
|
||||||
dnl add a definition of LIBTOOL to Makefile.in.
|
|
||||||
ifelse(,,,[AC_SUBST(LIBTOOL)
|
|
||||||
AC_DEFUN([AM_PROG_LIBTOOL])
|
|
||||||
AC_DEFUN([AC_LIBTOOL_DLOPEN])
|
|
||||||
AC_DEFUN([AC_PROG_LD])
|
|
||||||
])
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,121 +0,0 @@
|
||||||
# Process this file with autoconf to produce a configure script.
|
|
||||||
# Copyright (C) 1995, 1997, 1998, 1999, 2002, 2003
|
|
||||||
# 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_PREREQ(2.13)
|
|
||||||
AC_INIT(libF77/Version.c)
|
|
||||||
|
|
||||||
# This works around the fact that libtool configuration may change LD
|
|
||||||
# for this particular configuration, but some shells, instead of
|
|
||||||
# keeping the changes in LD private, export them just because LD is
|
|
||||||
# exported.
|
|
||||||
ORIGINAL_LD_FOR_MULTILIBS=$LD
|
|
||||||
|
|
||||||
GLIBCPP_TOPREL_CONFIGURE
|
|
||||||
|
|
||||||
AC_CANONICAL_SYSTEM
|
|
||||||
target_alias=${target_alias-$target}
|
|
||||||
AC_SUBST(target_alias)
|
|
||||||
|
|
||||||
GLIBCPP_CONFIGURE(.)
|
|
||||||
GLIBCPP_EXPORT_INSTALL_INFO
|
|
||||||
|
|
||||||
dnl Checks for programs.
|
|
||||||
|
|
||||||
AM_PROG_LIBTOOL
|
|
||||||
|
|
||||||
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'.])])
|
|
||||||
|
|
||||||
dnl Checks for g77 integer types built into gcc's C front end.
|
|
||||||
AC_MSG_CHECKING(for built-in g77 integer types)
|
|
||||||
AC_CACHE_VAL(libf2c_cv_has_g77_builtin_types,
|
|
||||||
[AC_TRY_COMPILE(,
|
|
||||||
[__g77_integer g77i;
|
|
||||||
__g77_uinteger g77ui;
|
|
||||||
__g77_longint g77l;
|
|
||||||
__g77_ulongint g77ul;],
|
|
||||||
libf2c_cv_has_g77_builtin_types=yes,
|
|
||||||
libf2c_cv_has_g77_builtin_types=no)])
|
|
||||||
AC_MSG_RESULT($libf2c_cv_has_g77_builtin_types)
|
|
||||||
if test $libf2c_cv_has_g77_builtin_types = no; then
|
|
||||||
AC_MSG_ERROR([gcc doesn't define all of the built in types __g77_integer,
|
|
||||||
__g77_uinteger, __g77_longint, and __g77_ulongint. You may not be using
|
|
||||||
a new enough version of gcc, or your target may not have type sizes which
|
|
||||||
accommodate those types.])
|
|
||||||
fi
|
|
||||||
|
|
||||||
# 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
|
|
||||||
|
|
||||||
AC_CONFIG_SUBDIRS(libU77 libI77 libF77)
|
|
||||||
# Do Makefile first since g2c.h depends on it and shouldn't get an
|
|
||||||
# earlier timestamp. Of course, it does when the multilib gunk below
|
|
||||||
# edits Makefile, sigh; see additional touch below.
|
|
||||||
AC_OUTPUT(Makefile g2c.h:g2c.hin,
|
|
||||||
[test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h
|
|
||||||
if test -n "$CONFIG_FILES"; then
|
|
||||||
LD="${ORIGINAL_LD_FOR_MULTILIBS}"
|
|
||||||
if test -n "${with_target_subdir}"; then
|
|
||||||
# FIXME: We shouldn't need to set ac_file
|
|
||||||
ac_file=Makefile
|
|
||||||
. ${toplevel_srcdir}/config-ml.in
|
|
||||||
touch g2c.h # to keep it more recent than Makefile
|
|
||||||
fi
|
|
||||||
fi],
|
|
||||||
srcdir=${srcdir}
|
|
||||||
host=${host}
|
|
||||||
target=${target}
|
|
||||||
with_target_subdir=${with_target_subdir}
|
|
||||||
with_multisubdir=${with_multisubdir}
|
|
||||||
ac_configure_args="--enable-multilib ${ac_configure_args}"
|
|
||||||
toplevel_srcdir=${toplevel_srcdir}
|
|
||||||
CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
|
|
||||||
ORIGINAL_LD_FOR_MULTILIBS="${ORIGINAL_LD_FOR_MULTILIBS}"
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
dnl Local Variables:
|
|
||||||
dnl comment-start: "dnl "
|
|
||||||
dnl comment-end: ""
|
|
||||||
dnl comment-start-skip: "\\bdnl\\b\\s *"
|
|
||||||
dnl End:
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
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
libf2c/f2c.h
64
libf2c/f2c.h
|
|
@ -1,64 +0,0 @@
|
||||||
/* f2c.h file for GNU Fortran run-time library
|
|
||||||
Copyright (C) 1998 Free Software Foundation, Inc.
|
|
||||||
Contributed by James Craig Burley.
|
|
||||||
|
|
||||||
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
|
|
||||||
582
libf2c/f2cext.c
582
libf2c/f2cext.c
|
|
@ -1,582 +0,0 @@
|
||||||
/* 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 <math.h> /* for j0 et al */
|
|
||||||
#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 __attribute__ ((__unused__))) {
|
|
||||||
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_y2kbuggy
|
|
||||||
int date_ (char *buf, ftnlen buf_len) {
|
|
||||||
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
|
|
||||||
routine. */
|
|
||||||
extern int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len);
|
|
||||||
return G77_date_y2kbuggy_0 (buf, buf_len);
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef Ldate_y2kbug
|
|
||||||
int date_y2kbug__ (char *buf, ftnlen buf_len) {
|
|
||||||
/* If user wants to invoke the non-Y2K-compliant routine via
|
|
||||||
an `EXTERNAL' interface, avoiding the warning via g77's
|
|
||||||
`INTRINSIC' interface, force coding of "y2kbug" string in
|
|
||||||
user's program. */
|
|
||||||
extern int G77_date_y2kbug_0 (char *buf, ftnlen buf_len);
|
|
||||||
return G77_date_y2kbug_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_y2kbuggy
|
|
||||||
int vxtidate_ (integer *m, integer *d, integer *y) {
|
|
||||||
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
|
|
||||||
routine. */
|
|
||||||
extern int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y);
|
|
||||||
return G77_vxtidate_y2kbuggy_0 (m, d, y);
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef Lvxtidt_y2kbug
|
|
||||||
int vxtidate_y2kbug__ (integer *m, integer *d, integer *y) {
|
|
||||||
/* If user wants to invoke the non-Y2K-compliant routine via
|
|
||||||
an `EXTERNAL' interface, avoiding the warning via g77's
|
|
||||||
`INTRINSIC' interface, force coding of "y2kbug" string in
|
|
||||||
user's program. */
|
|
||||||
extern int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y);
|
|
||||||
return G77_vxtidate_y2kbug_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
|
|
||||||
234
libf2c/g2c.hin
234
libf2c/g2c.hin
|
|
@ -1,234 +0,0 @@
|
||||||
/* 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 __g77_integer integer;
|
|
||||||
typedef __g77_uinteger 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 __g77_integer logical;
|
|
||||||
typedef short int shortlogical;
|
|
||||||
typedef char logical1;
|
|
||||||
typedef char integer1;
|
|
||||||
typedef __g77_longint longint; /* system-dependent */
|
|
||||||
typedef __g77_ulongint 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 __g77_integer flag;
|
|
||||||
typedef __g77_integer ftnlen;
|
|
||||||
typedef __g77_integer 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;
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
#undef abs
|
|
||||||
#undef min
|
|
||||||
#undef max
|
|
||||||
#include <stdio.h>
|
|
||||||
|
|
||||||
static integer memfailure = 3;
|
|
||||||
|
|
||||||
#include <stdlib.h>
|
|
||||||
extern void G77_exit_0 (integer *);
|
|
||||||
|
|
||||||
char *
|
|
||||||
F77_aloc (integer Len, char *whence)
|
|
||||||
{
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
@ -1,255 +0,0 @@
|
||||||
# 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, 2001 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@
|
|
||||||
|
|
||||||
F2C_H_DIR = @srcdir@/..
|
|
||||||
G2C_H_DIR = ..
|
|
||||||
CC = @CC@
|
|
||||||
CFLAGS = @CFLAGS@
|
|
||||||
CPPFLAGS = @CPPFLAGS@
|
|
||||||
AR = @AR@
|
|
||||||
ARFLAGS = rc
|
|
||||||
RANLIB = @RANLIB@
|
|
||||||
@SET_MAKE@
|
|
||||||
|
|
||||||
SHELL = @SHELL@
|
|
||||||
|
|
||||||
#### End of system configuration section. ####
|
|
||||||
|
|
||||||
ALL_CFLAGS = -I. -I$(srcdir) -I$(G2C_H_DIR) -I$(F2C_H_DIR) $(CPPFLAGS) $(DEFS) $(WARN_CFLAGS) $(CFLAGS)
|
|
||||||
|
|
||||||
.SUFFIXES:
|
|
||||||
.SUFFIXES: .c .lo
|
|
||||||
|
|
||||||
.c.lo:
|
|
||||||
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $<
|
|
||||||
|
|
||||||
MISC = F77_aloc.lo VersionF.lo s_rnge.lo abort_.lo getarg_.lo iargc_.lo\
|
|
||||||
getenv_.lo signal_.lo s_stop.lo s_paus.lo system_.lo cabs.lo\
|
|
||||||
derf_.lo derfc_.lo erf_.lo erfc_.lo sig_die.lo exit_.lo setarg.lo setsig.lo
|
|
||||||
POW = pow_ci.lo pow_dd.lo pow_di.lo pow_hh.lo pow_ii.lo pow_ri.lo pow_zi.lo pow_zz.lo \
|
|
||||||
pow_qq.lo
|
|
||||||
CX = c_abs.lo c_cos.lo c_div.lo c_exp.lo c_log.lo c_sin.lo c_sqrt.lo
|
|
||||||
DCX = z_abs.lo z_cos.lo z_div.lo z_exp.lo z_log.lo z_sin.lo z_sqrt.lo
|
|
||||||
REAL = r_abs.lo r_acos.lo r_asin.lo r_atan.lo r_atn2.lo r_cnjg.lo r_cos.lo\
|
|
||||||
r_cosh.lo r_dim.lo r_exp.lo r_imag.lo r_int.lo\
|
|
||||||
r_lg10.lo r_log.lo r_mod.lo r_nint.lo r_sign.lo\
|
|
||||||
r_sin.lo r_sinh.lo r_sqrt.lo r_tan.lo r_tanh.lo
|
|
||||||
DBL = d_abs.lo d_acos.lo d_asin.lo d_atan.lo d_atn2.lo\
|
|
||||||
d_cnjg.lo d_cos.lo d_cosh.lo d_dim.lo d_exp.lo\
|
|
||||||
d_imag.lo d_int.lo d_lg10.lo d_log.lo d_mod.lo\
|
|
||||||
d_nint.lo d_prod.lo d_sign.lo d_sin.lo d_sinh.lo\
|
|
||||||
d_sqrt.lo d_tan.lo d_tanh.lo
|
|
||||||
INT = i_abs.lo i_dim.lo i_dnnt.lo i_indx.lo i_len.lo i_mod.lo i_nint.lo i_sign.lo
|
|
||||||
HALF = h_abs.lo h_dim.lo h_dnnt.lo h_indx.lo h_len.lo h_mod.lo h_nint.lo h_sign.lo
|
|
||||||
CMP = l_ge.lo l_gt.lo l_le.lo l_lt.lo hl_ge.lo hl_gt.lo hl_le.lo hl_lt.lo
|
|
||||||
EFL = ef1asc_.lo ef1cmc_.lo
|
|
||||||
CHAR = s_cat.lo s_cmp.lo s_copy.lo
|
|
||||||
F90BIT = lbitbits.lo lbitshft.lo qbitbits.lo qbitshft.lo
|
|
||||||
|
|
||||||
OBJS = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
|
|
||||||
$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
|
|
||||||
|
|
||||||
all: ../s-libf77 ../libfrtbegin.a
|
|
||||||
|
|
||||||
../s-libf77: $(OBJS)
|
|
||||||
-rm -f $@.T $@
|
|
||||||
objs='$(OBJS)'; for name in $$objs; do \
|
|
||||||
echo libF77/$${name} >> $@.T; done
|
|
||||||
mv $@.T $@
|
|
||||||
|
|
||||||
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.lo: Version.c
|
|
||||||
@LIBTOOL@ --mode=compile $(CC) -c $(ALL_CFLAGS) $(srcdir)/Version.c -o $@
|
|
||||||
|
|
||||||
frtbegin.o : main.c
|
|
||||||
$(CC) -c $(ALL_CFLAGS) $(srcdir)/main.c -o $@
|
|
||||||
|
|
||||||
../libfrtbegin.a: frtbegin.o
|
|
||||||
-rm -f $@
|
|
||||||
$(AR) $(ARFLAGS) $@ frtbegin.o
|
|
||||||
$(RANLIB) $@
|
|
||||||
|
|
||||||
F77_aloc.lo: F77_aloc.c
|
|
||||||
s_rnge.lo: s_rnge.c
|
|
||||||
abort_.lo: abort_.c
|
|
||||||
getarg_.lo: getarg_.c
|
|
||||||
iargc_.lo: iargc_.c
|
|
||||||
getenv_.lo: getenv_.c
|
|
||||||
signal_.lo: signal_.c
|
|
||||||
s_stop.lo: s_stop.c
|
|
||||||
s_paus.lo: s_paus.c
|
|
||||||
system_.lo: system_.c
|
|
||||||
cabs.lo: cabs.c
|
|
||||||
derf_.lo: derf_.c
|
|
||||||
derfc_.lo: derfc_.c
|
|
||||||
erf_.lo: erf_.c
|
|
||||||
erfc_.lo: erfc_.c
|
|
||||||
sig_die.lo: sig_die.c
|
|
||||||
exit_.lo: exit_.c
|
|
||||||
setarg.lo: setarg.c
|
|
||||||
setsig.lo: setsig.c
|
|
||||||
pow_ci.lo: pow_ci.c
|
|
||||||
pow_dd.lo: pow_dd.c
|
|
||||||
pow_di.lo: pow_di.c
|
|
||||||
pow_hh.lo: pow_hh.c
|
|
||||||
pow_ii.lo: pow_ii.c
|
|
||||||
pow_ri.lo: pow_ri.c
|
|
||||||
pow_zi.lo: pow_zi.c
|
|
||||||
pow_zz.lo: pow_zz.c
|
|
||||||
pow_qq.lo: pow_qq.c
|
|
||||||
c_abs.lo: c_abs.c
|
|
||||||
c_cos.lo: c_cos.c
|
|
||||||
c_div.lo: c_div.c
|
|
||||||
c_exp.lo: c_exp.c
|
|
||||||
c_log.lo: c_log.c
|
|
||||||
c_sin.lo: c_sin.c
|
|
||||||
c_sqrt.lo: c_sqrt.c
|
|
||||||
z_abs.lo: z_abs.c
|
|
||||||
z_cos.lo: z_cos.c
|
|
||||||
z_div.lo: z_div.c
|
|
||||||
z_exp.lo: z_exp.c
|
|
||||||
z_log.lo: z_log.c
|
|
||||||
@LIBTOOL@ --mode=compile $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) -ffloat-store $(srcdir)/z_log.c
|
|
||||||
z_sin.lo: z_sin.c
|
|
||||||
z_sqrt.lo: z_sqrt.c
|
|
||||||
r_abs.lo: r_abs.c
|
|
||||||
r_acos.lo: r_acos.c
|
|
||||||
r_asin.lo: r_asin.c
|
|
||||||
r_atan.lo: r_atan.c
|
|
||||||
r_atn2.lo: r_atn2.c
|
|
||||||
r_cnjg.lo: r_cnjg.c
|
|
||||||
r_cos.lo: r_cos.c
|
|
||||||
r_cosh.lo: r_cosh.c
|
|
||||||
r_dim.lo: r_dim.c
|
|
||||||
r_exp.lo: r_exp.c
|
|
||||||
r_imag.lo: r_imag.c
|
|
||||||
r_int.lo: r_int.c
|
|
||||||
r_lg10.lo: r_lg10.c
|
|
||||||
r_log.lo: r_log.c
|
|
||||||
r_mod.lo: r_mod.c
|
|
||||||
r_nint.lo: r_nint.c
|
|
||||||
r_sign.lo: r_sign.c
|
|
||||||
r_sin.lo: r_sin.c
|
|
||||||
r_sinh.lo: r_sinh.c
|
|
||||||
r_sqrt.lo: r_sqrt.c
|
|
||||||
r_tan.lo: r_tan.c
|
|
||||||
r_tanh.lo: r_tanh.c
|
|
||||||
d_abs.lo: d_abs.c
|
|
||||||
d_acos.lo: d_acos.c
|
|
||||||
d_asin.lo: d_asin.c
|
|
||||||
d_atan.lo: d_atan.c
|
|
||||||
d_atn2.lo: d_atn2.c
|
|
||||||
d_cnjg.lo: d_cnjg.c
|
|
||||||
d_cos.lo: d_cos.c
|
|
||||||
d_cosh.lo: d_cosh.c
|
|
||||||
d_dim.lo: d_dim.c
|
|
||||||
d_exp.lo: d_exp.c
|
|
||||||
d_imag.lo: d_imag.c
|
|
||||||
d_int.lo: d_int.c
|
|
||||||
d_lg10.lo: d_lg10.c
|
|
||||||
d_log.lo: d_log.c
|
|
||||||
d_mod.lo: d_mod.c
|
|
||||||
d_nint.lo: d_nint.c
|
|
||||||
d_prod.lo: d_prod.c
|
|
||||||
d_sign.lo: d_sign.c
|
|
||||||
d_sin.lo: d_sin.c
|
|
||||||
d_sinh.lo: d_sinh.c
|
|
||||||
d_sqrt.lo: d_sqrt.c
|
|
||||||
d_tan.lo: d_tan.c
|
|
||||||
d_tanh.lo: d_tanh.c
|
|
||||||
i_abs.lo: i_abs.c
|
|
||||||
i_dim.lo: i_dim.c
|
|
||||||
i_dnnt.lo: i_dnnt.c
|
|
||||||
i_indx.lo: i_indx.c
|
|
||||||
i_len.lo: i_len.c
|
|
||||||
i_mod.lo: i_mod.c
|
|
||||||
i_nint.lo: i_nint.c
|
|
||||||
i_sign.lo: i_sign.c
|
|
||||||
h_abs.lo: h_abs.c
|
|
||||||
h_dim.lo: h_dim.c
|
|
||||||
h_dnnt.lo: h_dnnt.c
|
|
||||||
h_indx.lo: h_indx.c
|
|
||||||
h_len.lo: h_len.c
|
|
||||||
h_mod.lo: h_mod.c
|
|
||||||
h_nint.lo: h_nint.c
|
|
||||||
h_sign.lo: h_sign.c
|
|
||||||
l_ge.lo: l_ge.c
|
|
||||||
l_gt.lo: l_gt.c
|
|
||||||
l_le.lo: l_le.c
|
|
||||||
l_lt.lo: l_lt.c
|
|
||||||
hl_ge.lo: hl_ge.c
|
|
||||||
hl_gt.lo: hl_gt.c
|
|
||||||
hl_le.lo: hl_le.c
|
|
||||||
hl_lt.lo: hl_lt.c
|
|
||||||
ef1asc_.lo: ef1asc_.c
|
|
||||||
ef1cmc_.lo: ef1cmc_.c
|
|
||||||
s_cat.lo: s_cat.c
|
|
||||||
s_cmp.lo: s_cmp.c
|
|
||||||
s_copy.lo: s_copy.c
|
|
||||||
lbitbits.lo: lbitbits.c
|
|
||||||
lbitshft.lo: lbitshft.c
|
|
||||||
qbitbits.lo: qbitbits.c
|
|
||||||
qbitshft.lo: qbitshft.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 *.lo ../libfrtbegin.a
|
|
||||||
rm -rf .libs
|
|
||||||
|
|
||||||
clean: mostlyclean
|
|
||||||
rm -f config.log
|
|
||||||
rm -f ../s-libf77
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
/****************************************************************
|
|
||||||
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.
|
|
||||||
****************************************************************/
|
|
||||||
|
|
||||||
|
|
@ -1,112 +0,0 @@
|
||||||
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
|
|
||||||
|
|
||||||
If your compiler complains about the signal calls in main.c, s_paus.c,
|
|
||||||
and signal_.c, you may need to adjust signal1.h suitably. See the
|
|
||||||
comments in signal1.h.
|
|
||||||
|
|
@ -1,94 +0,0 @@
|
||||||
const char __LIBF77_VERSION__[] = "@(#) LIBF77 VERSION 20000929\n";
|
|
||||||
extern const char __LIBI77_VERSION__[];
|
|
||||||
extern const char __LIBU77_VERSION__[];
|
|
||||||
|
|
||||||
/*
|
|
||||||
2.00 11 June 1980. File version.c added to library.
|
|
||||||
2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed
|
|
||||||
[ d]erf[c ] added
|
|
||||||
8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
|
|
||||||
29 Nov. 1989: s_cmp returns long (for f2c)
|
|
||||||
30 Nov. 1989: arg types from f2c.h
|
|
||||||
12 Dec. 1989: s_rnge allows long names
|
|
||||||
19 Dec. 1989: getenv_ allows unsorted environment
|
|
||||||
28 Mar. 1990: add exit(0) to end of main()
|
|
||||||
2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main
|
|
||||||
17 Oct. 1990: abort() calls changed to sig_die(...,1)
|
|
||||||
22 Oct. 1990: separate sig_die from main
|
|
||||||
25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die
|
|
||||||
31 May 1991: make system_ return status
|
|
||||||
18 Dec. 1991: change long to ftnlen (for -i2) many places
|
|
||||||
28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer)
|
|
||||||
18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c
|
|
||||||
and m**n in pow_hh.c and pow_ii.c;
|
|
||||||
catch SIGTRAP in main() for error msg before abort
|
|
||||||
23 July 1992: switch to ANSI prototypes unless KR_headers is #defined
|
|
||||||
23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg);
|
|
||||||
change Cabs to f__cabs.
|
|
||||||
12 March 1993: various tweaks for C++
|
|
||||||
2 June 1994: adjust so abnormal terminations invoke f_exit just once
|
|
||||||
16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
|
|
||||||
19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
|
|
||||||
12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines
|
|
||||||
that sign-extend right shifts when i is the most
|
|
||||||
negative integer.
|
|
||||||
26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
|
|
||||||
of character assignments to appear on the right-hand
|
|
||||||
side (unless compiled with -DNO_OVERWRITE).
|
|
||||||
27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
|
|
||||||
possible (for better cache behavior).
|
|
||||||
30 May 1995: added subroutine exit(rc) integer rc. Version not changed.
|
|
||||||
29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
|
|
||||||
6 Sept. 1995: fix return type of system_ under -DKR_headers.
|
|
||||||
19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
|
|
||||||
19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
|
|
||||||
13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
|
|
||||||
19 June 1996: add casts to unsigned in [lq]bitshft.c.
|
|
||||||
26 Feb. 1997: adjust functions with a complex output argument
|
|
||||||
to permit aliasing it with input arguments.
|
|
||||||
(For now, at least, this is just for possible
|
|
||||||
benefit of g77.)
|
|
||||||
4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
|
|
||||||
affect systems using gratuitous extra precision).
|
|
||||||
19 Sept. 1997: [de]time_.c (Unix systems only): change return
|
|
||||||
type to double.
|
|
||||||
2 May 1999: getenv_.c: omit environ in favor of getenv().
|
|
||||||
c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c,
|
|
||||||
z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with
|
|
||||||
overlapping arguments caused by equivalence.
|
|
||||||
3 May 1999: "invisible" tweaks to omit compiler warnings in
|
|
||||||
abort_.c, ef1asc_.c, s_rnge.c, s_stop.c.
|
|
||||||
7 Sept. 1999: [cz]_div.c: arrange for compilation under
|
|
||||||
-DIEEE_COMPLEX_DIVIDE to make these routines
|
|
||||||
avoid calling sig_die when the denominator
|
|
||||||
vanishes; instead, they return pairs of NaNs
|
|
||||||
or Infinities, depending whether the numerator
|
|
||||||
also vanishes or not. VERSION not changed.
|
|
||||||
15 Nov. 1999: s_rnge.c: add casts for the case of
|
|
||||||
sizeof(ftnint) == sizeof(int) < sizeof(long).
|
|
||||||
10 March 2000: z_log.c: improve accuracy of Real(log(z)) for, e.g.,
|
|
||||||
z near (+-1,eps) with |eps| small. For the old
|
|
||||||
evaluation, compile with -DPre20000310 .
|
|
||||||
20 April 2000: s_cat.c: tweak argument types to accord with
|
|
||||||
calls by f2c when ftnint and ftnlen are of
|
|
||||||
different sizes (different numbers of bits).
|
|
||||||
4 July 2000: adjustments to permit compilation by C++ compilers;
|
|
||||||
VERSION string remains unchanged. NOT APPLIED FOR G77.
|
|
||||||
29 Sept. 2000: dtime_.c, etime_.c: use floating-point divide.
|
|
||||||
dtime_.d, erf_.c, erfc_.c, etime.c: for use with
|
|
||||||
"f2c -R", compile with -DREAL=float.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
|
|
||||||
void
|
|
||||||
g77__fvers__ ()
|
|
||||||
{
|
|
||||||
fputs ("GNU Fortran library.\n", stderr);
|
|
||||||
#if defined __GNUC__ && defined __VERSION__
|
|
||||||
fprintf (stderr, "Compiled by GCC %s\n", __VERSION__);
|
|
||||||
#endif
|
|
||||||
fputs (__LIBF77_VERSION__, stderr);
|
|
||||||
fputs (__LIBI77_VERSION__, stderr);
|
|
||||||
fputs (__LIBU77_VERSION__, stderr);
|
|
||||||
}
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
#include <stdio.h>
|
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern void sig_die (char *, int);
|
|
||||||
|
|
||||||
int
|
|
||||||
G77_abort_0 (void)
|
|
||||||
{
|
|
||||||
sig_die ("Fortran abort routine called", 1);
|
|
||||||
return 0; /* not reached */
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern double f__cabs (double, double);
|
|
||||||
|
|
||||||
double
|
|
||||||
c_abs (complex * z)
|
|
||||||
{
|
|
||||||
return (f__cabs (z->r, z->i));
|
|
||||||
}
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include "math.h"
|
|
||||||
|
|
||||||
void
|
|
||||||
c_cos (complex * r, complex * z)
|
|
||||||
{
|
|
||||||
double zi = z->i, zr = z->r;
|
|
||||||
r->r = cos (zr) * cosh (zi);
|
|
||||||
r->i = -sin (zr) * sinh (zi);
|
|
||||||
}
|
|
||||||
|
|
@ -1,43 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern void sig_die (char *, int);
|
|
||||||
void
|
|
||||||
c_div (complex * c, complex * a, complex * b)
|
|
||||||
{
|
|
||||||
double ratio, den;
|
|
||||||
double abr, abi, cr;
|
|
||||||
|
|
||||||
if ((abr = b->r) < 0.)
|
|
||||||
abr = -abr;
|
|
||||||
if ((abi = b->i) < 0.)
|
|
||||||
abi = -abi;
|
|
||||||
if (abr <= abi)
|
|
||||||
{
|
|
||||||
if (abi == 0)
|
|
||||||
{
|
|
||||||
#ifdef IEEE_COMPLEX_DIVIDE
|
|
||||||
float af, bf;
|
|
||||||
af = bf = abr;
|
|
||||||
if (a->i != 0 || a->r != 0)
|
|
||||||
af = 1.;
|
|
||||||
c->i = c->r = af / bf;
|
|
||||||
return;
|
|
||||||
#else
|
|
||||||
sig_die ("complex division by zero", 1);
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
ratio = (double) b->r / b->i;
|
|
||||||
den = b->i * (1 + ratio * ratio);
|
|
||||||
cr = (a->r * ratio + a->i) / den;
|
|
||||||
c->i = (a->i * ratio - a->r) / den;
|
|
||||||
}
|
|
||||||
|
|
||||||
else
|
|
||||||
{
|
|
||||||
ratio = (double) b->i / b->r;
|
|
||||||
den = b->r * (1 + ratio * ratio);
|
|
||||||
cr = (a->r + a->i * ratio) / den;
|
|
||||||
c->i = (a->i - a->r * ratio) / den;
|
|
||||||
}
|
|
||||||
c->r = cr;
|
|
||||||
}
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include "math.h"
|
|
||||||
|
|
||||||
void
|
|
||||||
c_exp (complex * r, complex * z)
|
|
||||||
{
|
|
||||||
double expx, zi = z->i;
|
|
||||||
|
|
||||||
expx = exp (z->r);
|
|
||||||
r->r = expx * cos (zi);
|
|
||||||
r->i = expx * sin (zi);
|
|
||||||
}
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include "math.h"
|
|
||||||
extern double f__cabs (double, double);
|
|
||||||
|
|
||||||
void
|
|
||||||
c_log (complex * r, complex * z)
|
|
||||||
{
|
|
||||||
double zi, zr;
|
|
||||||
r->i = atan2 (zi = z->i, zr = z->r);
|
|
||||||
r->r = log (f__cabs (zr, zi));
|
|
||||||
}
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include "math.h"
|
|
||||||
|
|
||||||
void
|
|
||||||
c_sin (complex * r, complex * z)
|
|
||||||
{
|
|
||||||
double zi = z->i, zr = z->r;
|
|
||||||
r->r = sin (zr) * cosh (zi);
|
|
||||||
r->i = cos (zr) * sinh (zi);
|
|
||||||
}
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include "math.h"
|
|
||||||
extern double f__cabs (double, double);
|
|
||||||
|
|
||||||
void
|
|
||||||
c_sqrt (complex * r, complex * z)
|
|
||||||
{
|
|
||||||
double mag, t;
|
|
||||||
double zi = z->i, zr = z->r;
|
|
||||||
|
|
||||||
if ((mag = f__cabs (zr, zi)) == 0.)
|
|
||||||
r->r = r->i = 0.;
|
|
||||||
else if (zr > 0)
|
|
||||||
{
|
|
||||||
r->r = t = sqrt (0.5 * (mag + zr));
|
|
||||||
t = zi / t;
|
|
||||||
r->i = 0.5 * t;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
t = sqrt (0.5 * (mag - zr));
|
|
||||||
if (zi < 0)
|
|
||||||
t = -t;
|
|
||||||
r->i = t;
|
|
||||||
t = zi / t;
|
|
||||||
r->r = 0.5 * t;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
f__cabs (double real, double imag)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,111 +0,0 @@
|
||||||
# Process this file with autoconf to produce a configure script.
|
|
||||||
# Copyright (C) 1995, 1997, 1998, 2001 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_PREREQ(2.13)
|
|
||||||
AC_INIT(getarg_.c)
|
|
||||||
|
|
||||||
dnl Checks for programs.
|
|
||||||
|
|
||||||
dnl FIXME AC_PROG_CC wants CC to be able to link things, but it may
|
|
||||||
dnl not be able to.
|
|
||||||
define([AC_PROG_CC_WORKS],[])
|
|
||||||
|
|
||||||
# For g77 we'll set CC to point at the built gcc, but this will get it into
|
|
||||||
# the makefiles
|
|
||||||
AC_PROG_CC
|
|
||||||
|
|
||||||
LIBTOOL='$(SHELL) ../libtool'
|
|
||||||
AC_SUBST(LIBTOOL)
|
|
||||||
|
|
||||||
test "$AR" || AR=ar
|
|
||||||
AC_SUBST(AR)
|
|
||||||
if test "$RANLIB"; then :
|
|
||||||
AC_SUBST(RANLIB)
|
|
||||||
else
|
|
||||||
AC_PROG_RANLIB
|
|
||||||
fi
|
|
||||||
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
|
|
||||||
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_DEFINE(IEEE_COMPLEX_DIVIDE)
|
|
||||||
|
|
||||||
AC_OUTPUT(Makefile)
|
|
||||||
|
|
||||||
dnl Local Variables:
|
|
||||||
dnl comment-start: "dnl "
|
|
||||||
dnl comment-end: ""
|
|
||||||
dnl comment-start-skip: "\\bdnl\\b\\s *"
|
|
||||||
dnl End:
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
d_abs (doublereal * x)
|
|
||||||
{
|
|
||||||
if (*x >= 0)
|
|
||||||
return (*x);
|
|
||||||
return (-*x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_acos (doublereal * x)
|
|
||||||
{
|
|
||||||
return (acos (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_asin (doublereal * x)
|
|
||||||
{
|
|
||||||
return (asin (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_atan (doublereal * x)
|
|
||||||
{
|
|
||||||
return (atan (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_atn2 (doublereal * x, doublereal * y)
|
|
||||||
{
|
|
||||||
return (atan2 (*x, *y));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
void
|
|
||||||
d_cnjg (doublecomplex * r, doublecomplex * z)
|
|
||||||
{
|
|
||||||
doublereal zi = z->i;
|
|
||||||
r->r = z->r;
|
|
||||||
r->i = -zi;
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_cos (doublereal * x)
|
|
||||||
{
|
|
||||||
return (cos (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_cosh (doublereal * x)
|
|
||||||
{
|
|
||||||
return (cosh (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
d_dim (doublereal * a, doublereal * b)
|
|
||||||
{
|
|
||||||
return (*a > *b ? *a - *b : 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_exp (doublereal * x)
|
|
||||||
{
|
|
||||||
return (exp (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
d_imag (doublecomplex * z)
|
|
||||||
{
|
|
||||||
return (z->i);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_int (doublereal * x)
|
|
||||||
{
|
|
||||||
return ((*x > 0) ? floor (*x) : -floor (-*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#define log10e 0.43429448190325182765
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_lg10 (doublereal * x)
|
|
||||||
{
|
|
||||||
return (log10e * log (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_log (doublereal * x)
|
|
||||||
{
|
|
||||||
return (log (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,33 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#ifdef IEEE_drem
|
|
||||||
double drem (double, double);
|
|
||||||
#else
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
#endif
|
|
||||||
double
|
|
||||||
d_mod (doublereal * x, doublereal * y)
|
|
||||||
{
|
|
||||||
#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
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_nint (doublereal * x)
|
|
||||||
{
|
|
||||||
return ((*x) >= 0 ? floor (*x + .5) : -floor (.5 - *x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
d_prod (real * x, real * y)
|
|
||||||
{
|
|
||||||
return ((*x) * (*y));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
d_sign (doublereal * a, doublereal * b)
|
|
||||||
{
|
|
||||||
double x;
|
|
||||||
x = (*a >= 0 ? *a : -*a);
|
|
||||||
return (*b >= 0 ? x : -x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_sin (doublereal * x)
|
|
||||||
{
|
|
||||||
return (sin (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_sinh (doublereal * x)
|
|
||||||
{
|
|
||||||
return (sinh (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_sqrt (doublereal * x)
|
|
||||||
{
|
|
||||||
return (sqrt (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_tan (doublereal * x)
|
|
||||||
{
|
|
||||||
return (tan (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
d_tanh (doublereal * x)
|
|
||||||
{
|
|
||||||
return (tanh (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern double erf (double);
|
|
||||||
double
|
|
||||||
G77_derf_0 (doublereal * x)
|
|
||||||
{
|
|
||||||
return (erf (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern double erfc (double);
|
|
||||||
|
|
||||||
double
|
|
||||||
G77_derfc_0 (doublereal * x)
|
|
||||||
{
|
|
||||||
return (erfc (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,49 +0,0 @@
|
||||||
#include "time.h"
|
|
||||||
|
|
||||||
#ifdef MSDOS
|
|
||||||
#undef USE_CLOCK
|
|
||||||
#define USE_CLOCK
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifndef USE_CLOCK
|
|
||||||
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
|
|
||||||
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
|
|
||||||
#include "sys/types.h"
|
|
||||||
#include "sys/times.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#undef Hz
|
|
||||||
#ifdef CLK_TCK
|
|
||||||
#define Hz CLK_TCK
|
|
||||||
#else
|
|
||||||
#ifdef HZ
|
|
||||||
#define Hz HZ
|
|
||||||
#else
|
|
||||||
#define Hz 60
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
double
|
|
||||||
dtime_ (float *tarray)
|
|
||||||
{
|
|
||||||
#ifdef USE_CLOCK
|
|
||||||
#ifndef CLOCKS_PER_SECOND
|
|
||||||
#define CLOCKS_PER_SECOND Hz
|
|
||||||
#endif
|
|
||||||
static double t0;
|
|
||||||
double t = clock ();
|
|
||||||
tarray[1] = 0;
|
|
||||||
tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
|
|
||||||
t0 = t;
|
|
||||||
return tarray[0];
|
|
||||||
#else
|
|
||||||
struct tms t;
|
|
||||||
static struct tms t0;
|
|
||||||
|
|
||||||
times (&t);
|
|
||||||
tarray[0] = (double) (t.tms_utime - t0.tms_utime) / Hz;
|
|
||||||
tarray[1] = (double) (t.tms_stime - t0.tms_stime) / Hz;
|
|
||||||
t0 = t;
|
|
||||||
return tarray[0] + tarray[1];
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
/* 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) )
|
|
||||||
|
|
||||||
extern void s_copy (char *, char *, ftnlen, ftnlen);
|
|
||||||
int
|
|
||||||
G77_ef1asc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
|
|
||||||
{
|
|
||||||
s_copy ((char *) a, (char *) b, EVEN (*la), *lb);
|
|
||||||
return 0; /* ignored return value */
|
|
||||||
}
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
/* EFL support routine to compare two character strings */
|
|
||||||
|
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
integer
|
|
||||||
G77_ef1cmc_0 (ftnint * a, ftnlen * la, ftnint * b, ftnlen * lb)
|
|
||||||
{
|
|
||||||
return (s_cmp ((char *) a, (char *) b, *la, *lb));
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern double erf (double);
|
|
||||||
double
|
|
||||||
G77_erf_0 (real * x)
|
|
||||||
{
|
|
||||||
return (erf (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern double erfc (double);
|
|
||||||
double
|
|
||||||
G77_erfc_0 (real * x)
|
|
||||||
{
|
|
||||||
return (erfc (*x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,43 +0,0 @@
|
||||||
#include "time.h"
|
|
||||||
|
|
||||||
#ifdef MSDOS
|
|
||||||
#undef USE_CLOCK
|
|
||||||
#define USE_CLOCK
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifndef USE_CLOCK
|
|
||||||
#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
|
|
||||||
#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
|
|
||||||
#include "sys/types.h"
|
|
||||||
#include "sys/times.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#undef Hz
|
|
||||||
#ifdef CLK_TCK
|
|
||||||
#define Hz CLK_TCK
|
|
||||||
#else
|
|
||||||
#ifdef HZ
|
|
||||||
#define Hz HZ
|
|
||||||
#else
|
|
||||||
#define Hz 60
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
double
|
|
||||||
etime_ (float *tarray)
|
|
||||||
{
|
|
||||||
#ifdef USE_CLOCK
|
|
||||||
#ifndef CLOCKS_PER_SECOND
|
|
||||||
#define CLOCKS_PER_SECOND Hz
|
|
||||||
#endif
|
|
||||||
double t = clock ();
|
|
||||||
tarray[1] = 0;
|
|
||||||
return tarray[0] = t / CLOCKS_PER_SECOND;
|
|
||||||
#else
|
|
||||||
struct tms t;
|
|
||||||
|
|
||||||
times (&t);
|
|
||||||
return (tarray[0] = (double) t.tms_utime / Hz)
|
|
||||||
+ (tarray[1] = (double) t.tms_stime / Hz);
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
/* 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
|
|
||||||
#include <stdlib.h>
|
|
||||||
extern void f_exit (void);
|
|
||||||
|
|
||||||
void
|
|
||||||
G77_exit_0 (integer * rc)
|
|
||||||
{
|
|
||||||
#ifdef NO_ONEXIT
|
|
||||||
f_exit ();
|
|
||||||
#endif
|
|
||||||
exit (*rc);
|
|
||||||
}
|
|
||||||
|
|
@ -1,163 +0,0 @@
|
||||||
/* 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
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
/*
|
|
||||||
* subroutine getarg(k, c)
|
|
||||||
* returns the kth unix command argument in fortran character
|
|
||||||
* variable argument c
|
|
||||||
*/
|
|
||||||
|
|
||||||
void
|
|
||||||
G77_getarg_0 (ftnint * n, register char *s, ftnlen ls)
|
|
||||||
{
|
|
||||||
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++ = ' ';
|
|
||||||
}
|
|
||||||
|
|
@ -1,49 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
#undef abs
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <string.h>
|
|
||||||
extern char *F77_aloc (ftnlen, char *);
|
|
||||||
|
|
||||||
/*
|
|
||||||
* getenv - f77 subroutine to return environment variables
|
|
||||||
*
|
|
||||||
* called by:
|
|
||||||
* call getenv (ENV_NAME, char_var)
|
|
||||||
* where:
|
|
||||||
* ENV_NAME is the name of an environment variable
|
|
||||||
* char_var is a character variable which will receive
|
|
||||||
* the current value of ENV_NAME, or all blanks
|
|
||||||
* if ENV_NAME is not defined
|
|
||||||
*/
|
|
||||||
|
|
||||||
void
|
|
||||||
G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
|
|
||||||
{
|
|
||||||
char buf[256], *ep, *fp;
|
|
||||||
integer i;
|
|
||||||
|
|
||||||
if (flen <= 0)
|
|
||||||
goto add_blanks;
|
|
||||||
for (i = 0; i < (integer) sizeof (buf); i++)
|
|
||||||
{
|
|
||||||
if (i == flen || (buf[i] = fname[i]) == ' ')
|
|
||||||
{
|
|
||||||
buf[i] = 0;
|
|
||||||
ep = getenv (buf);
|
|
||||||
goto have_ep;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
while (i < flen && fname[i] != ' ')
|
|
||||||
i++;
|
|
||||||
strncpy (fp = F77_aloc (i + 1, "getenv_"), fname, (int) i);
|
|
||||||
fp[i] = 0;
|
|
||||||
ep = getenv (fp);
|
|
||||||
free (fp);
|
|
||||||
have_ep:
|
|
||||||
if (ep)
|
|
||||||
while (*ep && vlen-- > 0)
|
|
||||||
*value++ = *ep++;
|
|
||||||
add_blanks:
|
|
||||||
while (vlen-- > 0)
|
|
||||||
*value++ = ' ';
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_abs (shortint * x)
|
|
||||||
{
|
|
||||||
if (*x >= 0)
|
|
||||||
return (*x);
|
|
||||||
return (-*x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_dim (shortint * a, shortint * b)
|
|
||||||
{
|
|
||||||
return (*a > *b ? *a - *b : 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
shortint
|
|
||||||
h_dnnt (doublereal * x)
|
|
||||||
{
|
|
||||||
return (shortint) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_indx (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_len (char *s __attribute__ ((__unused__)), ftnlen n)
|
|
||||||
{
|
|
||||||
return (n);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_mod (short *a, short *b)
|
|
||||||
{
|
|
||||||
return (*a % *b);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
shortint
|
|
||||||
h_nint (real * x)
|
|
||||||
{
|
|
||||||
return (shortint) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
h_sign (shortint * a, shortint * b)
|
|
||||||
{
|
|
||||||
shortint x;
|
|
||||||
x = (*a >= 0 ? *a : -*a);
|
|
||||||
return (*b >= 0 ? x : -x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
shortlogical
|
|
||||||
hl_ge (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) >= 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
shortlogical
|
|
||||||
hl_gt (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) > 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
shortlogical
|
|
||||||
hl_le (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) <= 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
shortlogical
|
|
||||||
hl_lt (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) < 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_abs (integer * x)
|
|
||||||
{
|
|
||||||
if (*x >= 0)
|
|
||||||
return (*x);
|
|
||||||
return (-*x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_dim (integer * a, integer * b)
|
|
||||||
{
|
|
||||||
return (*a > *b ? *a - *b : 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
integer
|
|
||||||
i_dnnt (doublereal * x)
|
|
||||||
{
|
|
||||||
return (integer) (*x >= 0. ? floor (*x + .5) : -floor (.5 - *x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_indx (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_len (char *s __attribute__ ((__unused__)), ftnlen n)
|
|
||||||
{
|
|
||||||
return (n);
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_mod (integer * a, integer * b)
|
|
||||||
{
|
|
||||||
return (*a % *b);
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
integer
|
|
||||||
i_nint (real * x)
|
|
||||||
{
|
|
||||||
return (integer) (*x >= 0 ? floor (*x + .5) : -floor (.5 - *x));
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
i_sign (integer * a, integer * b)
|
|
||||||
{
|
|
||||||
integer x;
|
|
||||||
x = (*a >= 0 ? *a : -*a);
|
|
||||||
return (*b >= 0 ? x : -x);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
ftnint
|
|
||||||
G77_iargc_0 (void)
|
|
||||||
{
|
|
||||||
extern int f__xargc;
|
|
||||||
return (f__xargc - 1);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
logical
|
|
||||||
l_ge (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) >= 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
logical
|
|
||||||
l_gt (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) > 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
logical
|
|
||||||
l_le (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) <= 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern integer s_cmp (char *, char *, ftnlen, ftnlen);
|
|
||||||
logical
|
|
||||||
l_lt (char *a, char *b, ftnlen la, ftnlen lb)
|
|
||||||
{
|
|
||||||
return (s_cmp (a, b, la, lb) < 0);
|
|
||||||
}
|
|
||||||
|
|
@ -1,58 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#ifndef LONGBITS
|
|
||||||
#define LONGBITS 32
|
|
||||||
#endif
|
|
||||||
|
|
||||||
integer
|
|
||||||
lbit_bits (integer a, integer b, integer len)
|
|
||||||
{
|
|
||||||
/* 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
|
|
||||||
lbit_cshift (integer a, integer b, integer len)
|
|
||||||
{
|
|
||||||
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))));
|
|
||||||
}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
lbit_shift (integer a, integer b)
|
|
||||||
{
|
|
||||||
return b >= 0 ? a << b : (integer) ((uinteger) a >> -b);
|
|
||||||
}
|
|
||||||
|
|
@ -1,35 +0,0 @@
|
||||||
/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
|
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
#include "signal1.h"
|
|
||||||
|
|
||||||
#include <stdlib.h>
|
|
||||||
|
|
||||||
extern void f_exit (void);
|
|
||||||
#ifndef NO_ONEXIT
|
|
||||||
#define ONEXIT atexit
|
|
||||||
extern int atexit (void (*)(void));
|
|
||||||
#endif
|
|
||||||
|
|
||||||
extern void f_init (void);
|
|
||||||
extern int MAIN__ (void);
|
|
||||||
extern void f_setarg (int, char **);
|
|
||||||
extern void f_setsig (void);
|
|
||||||
|
|
||||||
int
|
|
||||||
main (int argc, char **argv)
|
|
||||||
{
|
|
||||||
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. */
|
|
||||||
}
|
|
||||||
|
|
@ -1,103 +0,0 @@
|
||||||
.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
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern void pow_zi (doublecomplex *, doublecomplex *, integer *);
|
|
||||||
void
|
|
||||||
pow_ci (complex * p, complex * a, integer * b) /* p = a**b */
|
|
||||||
{
|
|
||||||
doublecomplex p1, a1;
|
|
||||||
|
|
||||||
a1.r = a->r;
|
|
||||||
a1.i = a->i;
|
|
||||||
|
|
||||||
pow_zi (&p1, &a1, b);
|
|
||||||
|
|
||||||
p->r = p1.r;
|
|
||||||
p->i = p1.i;
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
#undef abs
|
|
||||||
#include <math.h>
|
|
||||||
double
|
|
||||||
pow_dd (doublereal * ap, doublereal * bp)
|
|
||||||
{
|
|
||||||
return (pow (*ap, *bp));
|
|
||||||
}
|
|
||||||
|
|
@ -1,32 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
pow_di (doublereal * ap, integer * bp)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,31 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
shortint
|
|
||||||
pow_hh (shortint * ap, shortint * bp)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,31 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
integer
|
|
||||||
pow_ii (integer * ap, integer * bp)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,31 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
longint
|
|
||||||
pow_qq (longint * ap, longint * bp)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,32 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
double
|
|
||||||
pow_ri (real * ap, integer * bp)
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
||||||
#include "f2c.h"
|
|
||||||
|
|
||||||
extern void z_div (doublecomplex *, doublecomplex *, doublecomplex *);
|
|
||||||
void
|
|
||||||
pow_zi (doublecomplex * p, doublecomplex * a, integer * b) /* p = a**b */
|
|
||||||
{
|
|
||||||
integer n;
|
|
||||||
unsigned long u;
|
|
||||||
double t;
|
|
||||||
doublecomplex q, x;
|
|
||||||
static doublecomplex one = { 1.0, 0.0 };
|
|
||||||
|
|
||||||
n = *b;
|
|
||||||
q.r = 1;
|
|
||||||
q.i = 0;
|
|
||||||
|
|
||||||
if (n == 0)
|
|
||||||
goto done;
|
|
||||||
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 = q.r * x.r - q.i * x.i;
|
|
||||||
q.i = q.r * x.i + q.i * x.r;
|
|
||||||
q.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;
|
|
||||||
}
|
|
||||||
done:
|
|
||||||
p->i = q.i;
|
|
||||||
p->r = q.r;
|
|
||||||
}
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue