MFC: In honor of fortran programmers everywhere. :)

lib/libF77/F77_aloc.c

@@ -23,7 +23,7 @@ F77_aloc(integer Len, char *whence)
 	char *rv;
 	unsigned int uLen = (unsigned int) Len;	/* for K&R C */
 
-	if (!(rv = malloc(uLen))) {
+	if (!(rv = (char*)malloc(uLen))) {
 		fprintf(stderr, "malloc(%u) failure in %s\n",
 			uLen, whence);
 		exit_(&memfailure);

lib/libF77/README

@@ -31,7 +31,7 @@ To check for transmission errors, issue the command
 This assumes you have the xsum program whose source, xsum.c,
 is distributed as part of "all from f2c/src".  If you do not
 have xsum, you can obtain xsum.c by sending the following E-mail
-message to netlib@research.att.com
+message to netlib@netlib.bell-labs.com
 	send xsum.c from f2c/src
 
 The makefile assumes you have installed f2c.h in a standard
@@ -82,10 +82,11 @@ external Fortran routines.
 	cmd to the system's command processor (on systems where
 	this can be done).
 
-The makefile does not attempt to compile pow_qq.c, which is meant
-for use with INTEGER*8.  To use it, you must modify f2c.h to
-declare longint appropriately; then add pow_qq.o to the POW =
-line in the makefile.
+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
@@ -94,3 +95,14 @@ 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

lib/libF77/Version.c

@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#)LIBF77 VERSION 2.01 6 Sept. 1995\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 19970226\n";
 
 /*
 2.00	11 June 1980.  File version.c added to library.
@@ -38,4 +38,12 @@ static char junk[] = "\n@(#)LIBF77 VERSION 2.01 6 Sept. 1995\n";
 	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.)
 */

lib/libF77/abort_.c

@@ -12,5 +12,7 @@ int abort_(void)
 #endif
 {
 sig_die("Fortran abort routine called", 1);
+#ifdef __cplusplus
 return 0;
+#endif
 }

lib/libF77/c_cos.c

@@ -11,6 +11,7 @@ VOID c_cos(r, z) complex *r, *z;
 void c_cos(complex *r, complex *z)
 #endif
 {
-r->r = cos(z->r) * cosh(z->i);
-r->i = - sin(z->r) * sinh(z->i);
-}
+	double zr = z->r;
+	r->r =   cos(zr) * cosh(z->i);
+	r->i = - sin(zr) * sinh(z->i);
+	}

lib/libF77/c_div.c

@@ -9,28 +9,29 @@ extern void sig_die(char*,int);
 void c_div(complex *c, complex *a, complex *b)
 #endif
 {
-double ratio, den;
-double abr, abi;
+	double ratio, den;
+	double abr, abi;
+	double ai = a->i, ar = a->r, bi = b->i, br = b->r;
 
-if( (abr = b->r) < 0.)
-	abr = - abr;
-if( (abi = b->i) < 0.)
-	abi = - abi;
-if( abr <= abi )
-	{
-	if(abi == 0)
-		sig_die("complex division by zero", 1);
-	ratio = (double)b->r / b->i ;
-	den = b->i * (1 + ratio*ratio);
-	c->r = (a->r*ratio + a->i) / den;
-	c->i = (a->i*ratio - a->r) / den;
-	}
+	if( (abr = br) < 0.)
+		abr = - abr;
+	if( (abi = bi) < 0.)
+		abi = - abi;
+	if( abr <= abi )
+		{
+		if(abi == 0)
+			sig_die("complex division by zero", 1);
+		ratio = (double)br / bi ;
+		den = bi * (1 + ratio*ratio);
+		c->r = (ar*ratio + ai) / den;
+		c->i = (ai*ratio - ar) / den;
+		}
 
-else
-	{
-	ratio = (double)b->i / b->r ;
-	den = b->r * (1 + ratio*ratio);
-	c->r = (a->r + a->i*ratio) / den;
-	c->i = (a->i - a->r*ratio) / den;
+	else
+		{
+		ratio = (double)bi / br ;
+		den = br * (1 + ratio*ratio);
+		c->r = (ar + ai*ratio) / den;
+		c->i = (ai - ar*ratio) / den;
+		}
 	}
-}

lib/libF77/c_log.c

@@ -11,6 +11,7 @@ extern double f__cabs(double, double);
 void c_log(complex *r, complex *z)
 #endif
 {
-r->i = atan2(z->i, z->r);
-r->r = log( f__cabs(z->r, z->i) );
-}
+	double zi;
+	r->i = atan2(zi = z->i, z->r);
+	r->r = log( f__cabs(z->r, zi) );
+	}

lib/libF77/c_sin.c

@@ -11,6 +11,7 @@ VOID c_sin(r, z) complex *r, *z;
 void c_sin(complex *r, complex *z)
 #endif
 {
-r->r = sin(z->r) * cosh(z->i);
-r->i = cos(z->r) * sinh(z->i);
-}
+	double zr = z->r;
+	r->r = sin(zr) * cosh(z->i);
+	r->i = cos(zr) * sinh(z->i);
+	}

lib/libF77/c_sqrt.c

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

lib/libF77/ef1asc_.c

@@ -8,12 +8,14 @@
 
 #ifdef KR_headers
 extern VOID s_copy();
-int ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
+ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
 #else
 extern void s_copy(char*,char*,ftnlen,ftnlen);
 int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
 #endif
 {
 s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
+#ifdef __cplusplus
 return 0;
+#endif
 }

lib/libF77/exit.c

@@ -1,37 +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
-#ifndef KR_headers
-#include "stdlib.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern void f_exit(void);
-#endif
-
- void
-#ifdef KR_headers
-exit_(rc) integer *rc;
-#else
-exit_(integer *rc)
-#endif
-{
-#ifdef NO_ONEXIT
-	f_exit();
-#endif
-	exit(*rc);
-	}
-#ifdef __cplusplus
-}
-#endif

lib/libF77/f2ch.add

@@ -150,7 +150,7 @@ extern integer s_wsni(icilist *);
 extern integer s_wsue(cilist *);
 extern void sig_die(char *, int);
 extern integer signal_(integer *, void (*)(int));
-extern int system_(char *, ftnlen);
+extern integer system_(char *, ftnlen);
 extern double z_abs(doublecomplex *);
 extern void z_cos(doublecomplex *, doublecomplex *);
 extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);

lib/libF77/getenv_.c

@@ -30,7 +30,7 @@ for(fp = fname ; fp < flast ; ++fp)
 		break;
 		}
 
-while ( (ep = *env++) )
+while (ep = *env++)
 	{
 	for(fp = fname; fp<flast ; )
 		if(*fp++ != *ep++)

lib/libF77/libF77.xsum

@@ -1,120 +0,0 @@
-F77_aloc.c	fc8e8844	536
-Notice	1211689a	1195
-README	1d306d9d	4130
-Version.c	f329c4b2	2060
-abort_.c	eaf90dc0	239
-c_abs.c	ecce7a47	205
-c_cos.c	f2338a46	260
-c_div.c	f780c50e	665
-c_exp.c	e1b005d5	270
-c_log.c	4050533	292
-c_sin.c	f19855c9	258
-c_sqrt.c	4e1ad71	505
-cabs.c	abac46c	427
-d_abs.c	ed70186c	151
-d_acos.c	e5d8cdee	178
-d_asin.c	f1c92f52	178
-d_atan.c	fe8cfd3f	178
-d_atn2.c	fa5f66a9	204
-d_cnjg.c	16aaf72f	165
-d_cos.c	f37be16	174
-d_cosh.c	a2f7dcf	178
-d_dim.c	1dfe4b39	165
-d_exp.c	fb0efb6d	174
-d_imag.c	ff9da248	134
-d_int.c	e10c5fc2	202
-d_lg10.c	1381342c	224
-d_log.c	ec2a8447	174
-d_mod.c	e30684f1	621
-d_nint.c	ffa7895c	214
-d_prod.c	e3b5d46a	140
-d_sign.c	1782063b	199
-d_sin.c	ef24638e	174
-d_sinh.c	e0ec938a	178
-d_sqrt.c	1ff988eb	178
-d_tan.c	ffc9a88e	174
-d_tanh.c	e5e0cbbd	178
-derf_.c	fdf1917c	172
-derfc_.c	4cb5ea3	186
-ef1asc_.c	f14b3469	453
-ef1cmc_.c	1e0b86e3	360
-erf_.c	7a407d	158
-erfc_.c	fb488e22	163
-exit.c	eaf1e4de	476
-f2ch.add	fed3bb7b	6056
-getarg_.c	edcf61f8	495
-getenv_.c	eaafcc11	975
-h_abs.c	8383aa6	151
-h_dim.c	9f9a693	163
-h_dnnt.c	d754cc8	218
-h_indx.c	145ff2e8	375
-h_len.c	e85aa13f	138
-h_mod.c	feacad2a	140
-h_nint.c	eb54a855	206
-h_sign.c	e7d69d03	199
-hl_ge.c	26bca46	279
-hl_gt.c	f5426c57	278
-hl_le.c	ff67a970	279
-hl_lt.c	f8842102	278
-i_abs.c	f6c3045e	147
-i_dim.c	ae23de2	158
-i_dnnt.c	e0c7e5e4	216
-i_indx.c	19177d0c	363
-i_len.c	e32e1f92	136
-i_mod.c	8bb577c	144
-i_nint.c	e0a366e8	204
-i_sign.c	1f26e421	193
-iargc_.c	324b252	129
-l_ge.c	5b7cb55	267
-l_gt.c	ad1b388	266
-l_le.c	f5407149	267
-l_lt.c	f81a93f8	266
-main.c	1144a505	2064
-makefile	e4156396	3063
-pow_ci.c	f593b0b9	345
-pow_dd.c	e451857d	209
-pow_di.c	11a1842e	381
-pow_hh.c	e0cb1b69	422
-pow_ii.c	17c60a01	421
-pow_qq.c	ffbbdec9	449
-pow_ri.c	eacf8350	369
-pow_zi.c	fe9073e4	715
-pow_zz.c	f0e5f141	482
-r_abs.c	1a4e3da	139
-r_acos.c	ca67f96	166
-r_asin.c	188a2306	166
-r_atan.c	fadda9d5	166
-r_atn2.c	e97a5392	186
-r_cnjg.c	f1c1fd80	151
-r_cos.c	f19d771e	162
-r_cosh.c	e20187a0	166
-r_dim.c	ef5e869	147
-r_exp.c	18979beb	162
-r_imag.c	e45086cf	122
-r_int.c	f2c2f39c	190
-r_lg10.c	1279226d	212
-r_log.c	2682a0d	162
-r_mod.c	f28ec59a	611
-r_nint.c	69d11bb	202
-r_sign.c	eddb76f9	181
-r_sin.c	10007227	162
-r_sinh.c	f21a38b8	166
-r_sqrt.c	f24b8aa4	166
-r_tan.c	e60b7778	162
-r_tanh.c	f22ec5c	166
-s_cat.c	151033e2	1304
-s_cmp.c	ff4f2982	655
-s_copy.c	e10dd76f	957
-s_paus.c	e726a719	1552
-s_rnge.c	1d6cada2	680
-s_stop.c	1f5aaac8	511
-sig_die.c	e934624a	634
-signal_.c	fde97f5f	395
-system_.c	e4ed54ab	579
-z_abs.c	f71a28c1	201
-z_cos.c	110bc444	269
-z_div.c	ff56b823	675
-z_exp.c	ced892b	278
-z_log.c	4ea97f4	305
-z_sin.c	1215f0b4	267
-z_sqrt.c	e8d24b0	492