diff options
| -rw-r--r-- | libf2c/ChangeLog | 18 | ||||
| -rw-r--r-- | libf2c/libF77/Version.c | 13 | ||||
| -rw-r--r-- | libf2c/libF77/dtime_.c | 4 | ||||
| -rw-r--r-- | libf2c/libF77/etime_.c | 3 | ||||
| -rw-r--r-- | libf2c/libF77/s_cat.c | 4 | ||||
| -rw-r--r-- | libf2c/libF77/z_log.c | 47 | ||||
| -rw-r--r-- | libf2c/libI77/Version.c | 11 | ||||
| -rw-r--r-- | libf2c/libI77/lread.c | 96 | ||||
| -rw-r--r-- | libf2c/libI77/rsne.c | 8 | ||||
| -rw-r--r-- | libf2c/libI77/xwsne.c | 7 |
10 files changed, 193 insertions, 18 deletions
diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog index 0da1c9712ea..0b6e261d3bc 100644 --- a/libf2c/ChangeLog +++ b/libf2c/ChangeLog @@ -1,3 +1,21 @@ +2000-12-09 Toon Moene <toon@moene.indiv.nluug.nl> + + Update to Netlib version 20001205. + Thanks go to David M. Gay for these updates. + + * libF77/Version.c: Update version information. + * libF77/z_log.c: Improve accuracy of real(log(z)) for + z near (+-1,eps) with |eps| small. + * libF77/s_cat.c: Adjust call when ftnint and ftnlen are + of different size. + * libF77/dtime_.c, libF77/etime_.c: Use floating point divide. + + * libI77/Version.c: Update version information. + * libI77/rsne.c, libI77/xwsne.c: Adjust code for when ftnint + and ftnlen differ in size. + * libI77/lread.c: Fix reading of namelist logical values followed + by <name>= where <name> starts with T or F. + 2000-11-26 Toon Moene <toon@moene.indiv.nluug.nl> * libI77/Version.c, libF77/Version.c, libU77/Version.c: diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c index 1f4a1786939..aa32ebfc4e6 100644 --- a/libf2c/libF77/Version.c +++ b/libf2c/libF77/Version.c @@ -1,4 +1,4 @@ -static char junk[] = "\n@(#)LIBF77 VERSION 19991115\n"; +static char junk[] = "\n@(#)LIBF77 VERSION 20000929\n"; /* */ @@ -69,6 +69,17 @@ char __G77_LIBF77_VERSION__[] = "0.5.26 20001209 (experimental)"; 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> diff --git a/libf2c/libF77/dtime_.c b/libf2c/libF77/dtime_.c index 4b37320d43b..e2c3a03cb7a 100644 --- a/libf2c/libF77/dtime_.c +++ b/libf2c/libF77/dtime_.c @@ -45,8 +45,8 @@ dtime_(float *tarray) static struct tms t0; times(&t); - tarray[0] = (t.tms_utime - t0.tms_utime) / Hz; - tarray[1] = (t.tms_stime - t0.tms_stime) / Hz; + 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 diff --git a/libf2c/libF77/etime_.c b/libf2c/libF77/etime_.c index e88cfd88648..0c3209d2612 100644 --- a/libf2c/libF77/etime_.c +++ b/libf2c/libF77/etime_.c @@ -41,6 +41,7 @@ etime_(float *tarray) struct tms t; times(&t); - return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz); + return (tarray[0] = (double)t.tms_utime/Hz) + + (tarray[1] = (double)t.tms_stime/Hz); #endif } diff --git a/libf2c/libF77/s_cat.c b/libf2c/libF77/s_cat.c index f462fd24945..77a94f64745 100644 --- a/libf2c/libF77/s_cat.c +++ b/libf2c/libF77/s_cat.c @@ -22,9 +22,9 @@ VOID #ifdef KR_headers -s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; +s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll; #else -s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) +s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll) #endif { ftnlen i, nc; diff --git a/libf2c/libF77/z_log.c b/libf2c/libF77/z_log.c index 34c56d42a8c..9dcc7f73fe5 100644 --- a/libf2c/libF77/z_log.c +++ b/libf2c/libF77/z_log.c @@ -10,7 +10,54 @@ extern double f__cabs(double, double); void z_log(doublecomplex *r, doublecomplex *z) #endif { + double s, s0, t, t2, u, v; double zi = z->i, zr = z->r; + r->i = atan2(zi, zr); +#ifdef Pre20000310 r->r = log( f__cabs( zr, zi ) ); +#else + if (zi < 0) + zi = -zi; + if (zr < 0) + zr = -zr; + if (zr < zi) { + t = zi; + zi = zr; + zr = t; + } + t = zi/zr; + s = zr * sqrt(1 + t*t); + /* now s = f__cabs(zi,zr), and zr = |zr| >= |zi| = zi */ + if ((t = s - 1) < 0) + t = -t; + if (t > .01) + r->r = log(s); + else { + +#ifdef Comment + + log(1+x) = x - x^2/2 + x^3/3 - x^4/4 + - ... + + = x(1 - x/2 + x^2/3 -+...) + + [sqrt(y^2 + z^2) - 1] * [sqrt(y^2 + z^2) + 1] = y^2 + z^2 - 1, so + + sqrt(y^2 + z^2) - 1 = (y^2 + z^2 - 1) / [sqrt(y^2 + z^2) + 1] + +#endif /*Comment*/ + + t = ((zr*zr - 1.) + zi*zi) / (s + 1); + t2 = t*t; + s = 1. - 0.5*t; + u = v = 1; + do { + s0 = s; + u *= t2; + v += 2; + s += u/v - t*u/(v+1); + } while(s > s0); + r->r = s*t; + } +#endif } diff --git a/libf2c/libI77/Version.c b/libf2c/libI77/Version.c index 5cb46a68256..1d994a1318d 100644 --- a/libf2c/libI77/Version.c +++ b/libf2c/libI77/Version.c @@ -1,4 +1,4 @@ -static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19991115\n"; +static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 20001205\n"; /* */ @@ -314,6 +314,15 @@ wrtfmt.c: /* Compiling libf2c with -DALWAYS_FLUSH should prevent losing */ /* any data in buffers should the program fault. It also */ /* makes the program run more slowly. */ +/* 20 April 2000: rsne.c, xwsne.c: tweaks that only matter if ftnint and */ +/* ftnlen are of different fundamental types (different numbers */ +/* of bits). Since these files will not compile when this */ +/* change matters, the above VERSION string remains unchanged. */ +/* 4 July 2000: adjustments to permit compilation by C++ compilers; */ +/* VERSION string remains unchanged. NOT APPLIED FOR G77 */ +/* 5 Dec. 2000: lread.c: under namelist input, when reading a logical array, */ +/* treat Tstuff= and Fstuff= as new assignments rather than as */ +/* logical constants. */ diff --git a/libf2c/libI77/lread.c b/libf2c/libI77/lread.c index 3d400596224..4b62a5cbadf 100644 --- a/libf2c/libI77/lread.c +++ b/libf2c/libI77/lread.c @@ -339,11 +339,93 @@ l_C(Void) return(0); } + static char nmLbuf[256], *nmL_next; + static int (*nmL_getc_save)(Void); +#ifdef KR_headers + static int (*nmL_ungetc_save)(/* int, FILE* */); +#else + static int (*nmL_ungetc_save)(int, FILE*); +#endif + + static int +nmL_getc(Void) +{ + int rv; + if (rv = *nmL_next++) + return rv; + l_getc = nmL_getc_save; + l_ungetc = nmL_ungetc_save; + return (*l_getc)(); + } + + static int +#ifdef KR_headers +nmL_ungetc(x, f) int x; FILE *f; +#else +nmL_ungetc(int x, FILE *f) +#endif +{ + f = f; /* banish non-use warning */ + return *--nmL_next = x; + } + + static int +#ifdef KR_headers +Lfinish(ch, dot, rvp) int ch, dot, *rvp; +#else +Lfinish(int ch, int dot, int *rvp) +#endif +{ + char *s, *se; + static char what[] = "namelist input"; + + s = nmLbuf + 2; + se = nmLbuf + sizeof(nmLbuf) - 1; + *s++ = ch; + while(!issep(GETC(ch)) && ch!=EOF) { + if (s >= se) { + nmLbuf_ovfl: + return *rvp = err__fl(f__elist->cierr,131,what); + } + *s++ = ch; + if (ch != '=') + continue; + if (dot) + return *rvp = err__fl(f__elist->cierr,112,what); + got_eq: + *s = 0; + nmL_getc_save = l_getc; + l_getc = nmL_getc; + nmL_ungetc_save = l_ungetc; + l_ungetc = nmL_ungetc; + nmLbuf[1] = *(nmL_next = nmLbuf) = ','; + *rvp = f__lcount = 0; + return 1; + } + if (dot) + goto done; + for(;;) { + if (s >= se) + goto nmLbuf_ovfl; + *s++ = ch; + if (!isblnk(ch)) + break; + if (GETC(ch) == EOF) + goto done; + } + if (ch == '=') + goto got_eq; + done: + Ungetc(ch, f__cf); + return 0; + } + static int l_L(Void) { - int ch; - if(f__lcount>0) return(0); + int ch, rv, sawdot; + if(f__lcount>0) + return(0); f__lcount = 1; f__ltype=0; GETC(ch); @@ -357,15 +439,23 @@ l_L(Void) err(f__elist->cierr,(EOF),"lread"); GETC(ch); } - if(ch == '.') GETC(ch); + sawdot = 0; + if(ch == '.') { + sawdot = 1; + GETC(ch); + } switch(ch) { case 't': case 'T': + if (nml_read && Lfinish(ch, sawdot, &rv)) + return rv; f__lx=1; break; case 'f': case 'F': + if (nml_read && Lfinish(ch, sawdot, &rv)) + return rv; f__lx=0; break; default: diff --git a/libf2c/libI77/rsne.c b/libf2c/libI77/rsne.c index c9d5f1015f4..77ffdf70bd2 100644 --- a/libf2c/libI77/rsne.c +++ b/libf2c/libI77/rsne.c @@ -302,8 +302,8 @@ x_rsne(cilist *a) Vardesc *v; dimen *dn, *dn0, *dn1; ftnlen *dims, *dims1; - ftnlen b, b0, b1, ex, no, no1, nomax, size, span; - ftnint type; + ftnlen b, b0, b1, ex, no, nomax, size, span; + ftnint no1, type; char *vaddr; long iva, ivae; dimen dimens[MAXDIM], substr; @@ -338,7 +338,7 @@ x_rsne(cilist *a) #endif } have_amp: - if (ch = getname(buf,(int) sizeof(buf))) + if (ch = getname(buf,sizeof(buf))) return ch; nl = (Namelist *)a->cifmt; if (strcmp(buf, nl->name)) @@ -393,7 +393,7 @@ x_rsne(cilist *a) if (ch <= ' ' && ch >= 0 || ch == ',') continue; Ungetc(ch,f__cf); - if (ch = getname(buf,(int) sizeof(buf))) + if (ch = getname(buf,sizeof(buf))) return ch; goto havename; } diff --git a/libf2c/libI77/xwsne.c b/libf2c/libI77/xwsne.c index 71f6f1d5da5..babec475325 100644 --- a/libf2c/libI77/xwsne.c +++ b/libf2c/libI77/xwsne.c @@ -24,10 +24,9 @@ x_wsne(cilist *a) Namelist *nl; char *s; Vardesc *v, **vd, **vde; - ftnint *number, type; + ftnint number, type; ftnlen *dims; ftnlen size; - static ftnint one = 1; extern ftnlen f__typesize[]; nl = (Namelist *)a->cifmt; @@ -49,7 +48,7 @@ x_wsne(cilist *a) PUT(*s++); PUT(' '); PUT('='); - number = (dims = v->dims) ? dims + 1 : &one; + number = (dims = v->dims) ? dims[1] : 1; type = v->type; if (type < 0) { size = -type; @@ -57,7 +56,7 @@ x_wsne(cilist *a) } else size = f__typesize[type]; - l_write(number, v->addr, size, type); + l_write(&number, v->addr, size, type); if (vd < vde) { if (f__recpos+2 >= L_len) nl_donewrec(); |