Add graph references

2026-06-28 13:49:01 +01:00
parent 0a9807e448
commit a11edf0c53
2578 changed files with 868045 additions and 0 deletions
@@ -0,0 +1,294 @@
+#include "f2c.h"
+#include "fio.h"
+
+#ifndef KR_headers
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#include "string.h"
+#endif
+
+#include "fmt.h"
+#include "fp.h"
+#ifndef VAX
+#include "ctype.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+ int
+#ifdef KR_headers
+wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
+#else
+wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
+#endif
+{
+	char buf[FMAX+EXPMAXDIGS+4], *s, *se;
+	int d1, delta, e1, i, sign, signspace;
+	double dd;
+#ifdef WANT_LEAD_0
+	int insert0 = 0;
+#endif
+#ifndef VAX
+	int e0 = e;
+#endif
+
+	if(e <= 0)
+		e = 2;
+	if(f__scale) {
+		if(f__scale >= d + 2 || f__scale <= -d)
+			goto nogood;
+		}
+	if(f__scale <= 0)
+		--d;
+	if (len == sizeof(real))
+		dd = p->pf;
+	else
+		dd = p->pd;
+	if (dd < 0.) {
+		signspace = sign = 1;
+		dd = -dd;
+		}
+	else {
+		sign = 0;
+		signspace = (int)f__cplus;
+#ifndef VAX
+		if (!dd) {
+#ifdef SIGNED_ZEROS
+			if (signbit_f2c(&dd))
+				signspace = sign = 1;
+#endif
+			dd = 0.;	/* avoid -0 */
+			}
+#endif
+		}
+	delta = w - (2 /* for the . and the d adjustment above */
+			+ 2 /* for the E+ */ + signspace + d + e);
+#ifdef WANT_LEAD_0
+	if (f__scale <= 0 && delta > 0) {
+		delta--;
+		insert0 = 1;
+		}
+	else
+#endif
+	if (delta < 0) {
+nogood:
+		while(--w >= 0)
+			PUT('*');
+		return(0);
+		}
+	if (f__scale < 0)
+		d += f__scale;
+	if (d > FMAX) {
+		d1 = d - FMAX;
+		d = FMAX;
+		}
+	else
+		d1 = 0;
+	sprintf(buf,"%#.*E", d, dd);
+#ifndef VAX
+	/* check for NaN, Infinity */
+	if (!isdigit(buf[0])) {
+		switch(buf[0]) {
+			case 'n':
+			case 'N':
+				signspace = 0;	/* no sign for NaNs */
+			}
+		delta = w - strlen(buf) - signspace;
+		if (delta < 0)
+			goto nogood;
+		while(--delta >= 0)
+			PUT(' ');
+		if (signspace)
+			PUT(sign ? '-' : '+');
+		for(s = buf; *s; s++)
+			PUT(*s);
+		return 0;
+		}
+#endif
+	se = buf + d + 3;
+#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
+	if (f__scale != 1 && dd)
+		sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+#else
+	if (dd)
+		sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+	else
+		strcpy(se, "+00");
+#endif
+	s = ++se;
+	if (e < 2) {
+		if (*s != '0')
+			goto nogood;
+		}
+#ifndef VAX
+	/* accommodate 3 significant digits in exponent */
+	if (s[2]) {
+#ifdef Pedantic
+		if (!e0 && !s[3])
+			for(s -= 2, e1 = 2; s[0] = s[1]; s++);
+
+	/* Pedantic gives the behavior that Fortran 77 specifies,	*/
+	/* i.e., requires that E be specified for exponent fields	*/
+	/* of more than 3 digits.  With Pedantic undefined, we get	*/
+	/* the behavior that Cray displays -- you get a bigger		*/
+	/* exponent field if it fits.	*/
+#else
+		if (!e0) {
+			for(s -= 2, e1 = 2; s[0] = s[1]; s++)
+#ifdef CRAY
+				delta--;
+			if ((delta += 4) < 0)
+				goto nogood
+#endif
+				;
+			}
+#endif
+		else if (e0 >= 0)
+			goto shift;
+		else
+			e1 = e;
+		}
+	else
+ shift:
+#endif
+		for(s += 2, e1 = 2; *s; ++e1, ++s)
+			if (e1 >= e)
+				goto nogood;
+	while(--delta >= 0)
+		PUT(' ');
+	if (signspace)
+		PUT(sign ? '-' : '+');
+	s = buf;
+	i = f__scale;
+	if (f__scale <= 0) {
+#ifdef WANT_LEAD_0
+		if (insert0)
+			PUT('0');
+#endif
+		PUT('.');
+		for(; i < 0; ++i)
+			PUT('0');
+		PUT(*s);
+		s += 2;
+		}
+	else if (f__scale > 1) {
+		PUT(*s);
+		s += 2;
+		while(--i > 0)
+			PUT(*s++);
+		PUT('.');
+		}
+	if (d1) {
+		se -= 2;
+		while(s < se) PUT(*s++);
+		se += 2;
+		do PUT('0'); while(--d1 > 0);
+		}
+	while(s < se)
+		PUT(*s++);
+	if (e < 2)
+		PUT(s[1]);
+	else {
+		while(++e1 <= e)
+			PUT('0');
+		while(*s)
+			PUT(*s++);
+		}
+	return 0;
+	}
+
+ int
+#ifdef KR_headers
+wrt_F(p,w,d,len) ufloat *p; ftnlen len;
+#else
+wrt_F(ufloat *p, int w, int d, ftnlen len)
+#endif
+{
+	int d1, sign, n;
+	double x;
+	char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
+
+	x= (len==sizeof(real)?p->pf:p->pd);
+	if (d < MAXFRACDIGS)
+		d1 = 0;
+	else {
+		d1 = d - MAXFRACDIGS;
+		d = MAXFRACDIGS;
+		}
+	if (x < 0.)
+		{ x = -x; sign = 1; }
+	else {
+		sign = 0;
+#ifndef VAX
+		if (!x) {
+#ifdef SIGNED_ZEROS
+			if (signbit_f2c(&x))
+				sign = 2;
+#endif
+			x = 0.;
+			}
+#endif
+		}
+
+	if (n = f__scale)
+		if (n > 0)
+			do x *= 10.; while(--n > 0);
+		else
+			do x *= 0.1; while(++n < 0);
+
+#ifdef USE_STRLEN
+	sprintf(b = buf, "%#.*f", d, x);
+	n = strlen(b) + d1;
+#else
+	n = sprintf(b = buf, "%#.*f", d, x) + d1;
+#endif
+
+#ifndef WANT_LEAD_0
+	if (buf[0] == '0' && d)
+		{ ++b; --n; }
+#endif
+	if (sign == 1) {
+		/* check for all zeros */
+		for(s = b;;) {
+			while(*s == '0') s++;
+			switch(*s) {
+				case '.':
+					s++; continue;
+				case 0:
+					sign = 0;
+				}
+			break;
+			}
+		}
+	if (sign || f__cplus)
+		++n;
+	if (n > w) {
+#ifdef WANT_LEAD_0
+		if (buf[0] == '0' && --n == w)
+			++b;
+		else
+#endif
+		{
+			while(--w >= 0)
+				PUT('*');
+			return 0;
+			}
+		}
+	for(w -= n; --w >= 0; )
+		PUT(' ');
+	if (sign)
+		PUT('-');
+	else if (f__cplus)
+		PUT('+');
+	while(n = *b++)
+		PUT(n);
+	while(--d1 >= 0)
+		PUT('0');
+	return 0;
+	}
+#ifdef __cplusplus
+}
+#endif