libi77

把fortran语言编的程序转为c语言编的程序, 运行环境linux

-		z_endp();
-	f__hiwater = f__recpos = f__cursor = 0;
-	return(f__workdone=0);
-	}
-
-#ifdef KR_headers
-integer s_rsfi(a) icilist *a;
-#else
-integer s_rsfi(icilist *a)
-#endif
-{	int n;
-	if(n=c_si(a)) return(n);
-	f__reading=1;
-	f__doed=rd_ed;
-	f__doned=rd_ned;
-	f__getn=z_getc;
-	f__dorevert = z_endp;
-	f__donewrec = z_rnew;
-	f__doend = z_endp;
-	return(0);
-}
-
-z_wnew(Void)
-{
-	while(f__recpos++ < f__svic->icirlen)
-		*f__icptr++ = ' ';
-	f__recpos = 0;
-	f__cursor = 0;
-	f__hiwater = 0;
-	f__icnum++;
-	return 1;
-}
-#ifdef KR_headers
-integer s_wsfi(a) icilist *a;
-#else
-integer s_wsfi(icilist *a)
-#endif
-{	int n;
-	if(n=c_si(a)) return(n);
-	f__reading=0;
-	f__doed=w_ed;
-	f__doned=w_ned;
-	f__putn=z_putc;
-	f__dorevert = iw_rev;
-	f__donewrec = z_wnew;
-	f__doend = z_endp;
-	return(0);
-}
-integer e_rsfi(Void)
-{	int n;
-	n = en_fio();
-	f__fmtbuf = NULL;
-	return(n);
-}
-integer e_wsfi(Void)
-{
-	int n;
-	n = en_fio();
-	f__fmtbuf = NULL;
-	if(f__icnum >= f__svic->icirnum)
-		return(n);
-	while(f__recpos++ < f__svic->icirlen)
-		*f__icptr++ = ' ';
-	return(n);
-}
//GO.SYSIN DD libI77/iio.c
echo libI77/ilnw.c 1>&2
sed >libI77/ilnw.c <<'//GO.SYSIN DD libI77/ilnw.c' 's/^-//'
-#include "f2c.h"
-#include "fio.h"
-#include "lio.h"
-extern char *f__icptr;
-extern char *f__icend;
-extern icilist *f__svic;
-extern int f__icnum;
-#ifdef KR_headers
-extern int z_putc();
-#else
-extern int z_putc(int);
-#endif
-
- static int
-z_wSL(Void)
-{
-	while(f__recpos < f__svic->icirlen)
-		z_putc(' ');
-	return z_rnew();
-	}
-
- VOID
-#ifdef KR_headers
-c_liw(a) icilist *a;
-#else
-c_liw(icilist *a)
-#endif
-{
-	f__reading = 0;
-	f__external = 0;
-	f__formatted = 1;
-	f__putn = z_putc;
-	L_len = a->icirlen;
-	f__donewrec = z_wSL;
-	f__svic = a;
-	f__icnum = f__recpos = 0;
-	f__cursor = 0;
-	f__cf = 0;
-	f__curunit = 0;
-	f__icptr = a->iciunit;
-	f__icend = f__icptr + a->icirlen*a->icirnum;
-	f__elist = (cilist *)a;
-	}
-
- integer
-#ifdef KR_headers
-s_wsni(a) icilist *a;
-#else
-s_wsni(icilist *a)
-#endif
-{
-	cilist ca;
-
-	c_liw(a);
-	ca.cifmt = a->icifmt;
-	x_wsne(&ca);
-	z_wSL();
-	return 0;
-	}
-
- integer
-#ifdef KR_headers
-s_wsli(a) icilist *a;
-#else
-s_wsli(icilist *a)
-#endif
-{
-	f__lioproc = l_write;
-	c_liw(a);
-	return(0);
-	}
-
-integer e_wsli(Void)
-{
-	z_wSL();
-	return(0);
-	}
//GO.SYSIN DD libI77/ilnw.c
echo libI77/inquire.c 1>&2
sed >libI77/inquire.c <<'//GO.SYSIN DD libI77/inquire.c' 's/^-//'
-#include "f2c.h"
-#include "fio.h"
-#ifdef KR_headers
-integer f_inqu(a) inlist *a;
-#else
-#ifdef MSDOS
-#undef abs
-#undef min
-#undef max
-#include "string.h"
-#include "io.h"
-#endif
-integer f_inqu(inlist *a)
-#endif
-{	flag byfile;
-	int i, n;
-	unit *p;
-	char buf[256];
-	long x;
-	if(a->infile!=NULL)
-	{	byfile=1;
-		g_char(a->infile,a->infilen,buf);
-#ifdef NON_UNIX_STDIO
-		x = access(buf,0) ? -1 : 0;
-		for(i=0,p=NULL;i<MXUNIT;i++)
-			if(f__units[i].ufd != NULL
-			 && f__units[i].ufnm != NULL
-			 && !strcmp(f__units[i].ufnm,buf)) {
-				p = &f__units[i];
-				break;
-				}
-#else
-		x=f__inode(buf, &n);
-		for(i=0,p=NULL;i<MXUNIT;i++)
-			if(f__units[i].uinode==x
-			&& f__units[i].ufd!=NULL
-			&& f__units[i].udev == n) {
-				p = &f__units[i];
-				break;
-				}
-#endif
-	}
-	else
-	{
-		byfile=0;
-		if(a->inunit<MXUNIT && a->inunit>=0)
-		{
-			p= &f__units[a->inunit];
-		}
-		else
-		{
-			p=NULL;
-		}
-	}
-	if(a->inex!=NULL)
-		if(byfile && x != -1 || !byfile && p!=NULL)
-			*a->inex=1;
-		else *a->inex=0;
-	if(a->inopen!=NULL)
-		if(byfile) *a->inopen=(p!=NULL);
-		else *a->inopen=(p!=NULL && p->ufd!=NULL);
-	if(a->innum!=NULL) *a->innum= p-f__units;
-	if(a->innamed!=NULL)
-		if(byfile || p!=NULL && p->ufnm!=NULL)
-			*a->innamed=1;
-		else	*a->innamed=0;
-	if(a->inname!=NULL)
-		if(byfile)
-			b_char(buf,a->inname,a->innamlen);
-		else if(p!=NULL && p->ufnm!=NULL)
-			b_char(p->ufnm,a->inname,a->innamlen);
-	if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL)
-		if(p->url)
-			b_char("DIRECT",a->inacc,a->inacclen);
-		else	b_char("SEQUENTIAL",a->inacc,a->inacclen);
-	if(a->inseq!=NULL)
-		if(p!=NULL && p->url)
-			b_char("NO",a->inseq,a->inseqlen);
-		else	b_char("YES",a->inseq,a->inseqlen);
-	if(a->indir!=NULL)
-		if(p==NULL || p->url)
-			b_char("YES",a->indir,a->indirlen);
-		else	b_char("NO",a->indir,a->indirlen);
-	if(a->infmt!=NULL)
-		if(p!=NULL && p->ufmt==0)
-			b_char("UNFORMATTED",a->infmt,a->infmtlen);
-		else	b_char("FORMATTED",a->infmt,a->infmtlen);
-	if(a->inform!=NULL)
-		if(p!=NULL && p->ufmt==0)
-		b_char("NO",a->inform,a->informlen);
-		else b_char("YES",a->inform,a->informlen);
-	if(a->inunf)
-		if(p!=NULL && p->ufmt==0)
-			b_char("YES",a->inunf,a->inunflen);
-		else if (p!=NULL) b_char("NO",a->inunf,a->inunflen);
-		else b_char("UNKNOWN",a->inunf,a->inunflen);
-	if(a->inrecl!=NULL && p!=NULL)
-		*a->inrecl=p->url;
-	if(a->innrec!=NULL && p!=NULL && p->url>0)
-		*a->innrec=ftell(p->ufd)/p->url+1;
-	if(a->inblank && p!=NULL && p->ufmt)
-		if(p->ublnk)
-			b_char("ZERO",a->inblank,a->inblanklen);
-		else	b_char("NULL",a->inblank,a->inblanklen);
-	return(0);
-}
//GO.SYSIN DD libI77/inquire.c
echo libI77/lio.h 1>&2
sed >libI77/lio.h <<'//GO.SYSIN DD libI77/lio.h' 's/^-//'
-/*	copy of ftypes from the compiler */
-/* variable types
- * numeric assumptions:
- *	int < reals < complexes
- *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
- */
-
-/* 0-10 retain their old (pre LOGICAL*1, etc.) */
-/* values to allow mixing old and new objects. */
-
-#define TYUNKNOWN 0
-#define TYADDR 1
-#define TYSHORT 2
-#define TYLONG 3
-#define TYREAL 4
-#define TYDREAL 5
-#define TYCOMPLEX 6
-#define TYDCOMPLEX 7
-#define TYLOGICAL 8
-#define TYCHAR 9
-#define TYSUBR 10
-#define TYINT1 11
-#define TYLOGICAL1 12
-#define TYLOGICAL2 13
-#ifdef Allow_TYQUAD
-#define TYQUAD 14
-#endif
-
-#define	LINTW	24
-#define	LINE	80
-#define	LLOGW	2
-#ifdef Old_list_output
-#define	LLOW	1.0
-#define	LHIGH	1.e9
-#define	LEFMT	" %# .8E"
-#define	LFFMT	" %# .9g"
-#else
-#define	LGFMT	"%.9G"
-#endif
-/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */
-#define	LEFBL	24
-
-typedef union
-{
-	char	flchar;
-	short	flshort;
-	ftnint	flint;
-#ifdef Allow_TYQUAD
-	longint fllongint;
-#endif
-	real	flreal;
-	doublereal	fldouble;
-} flex;
-extern int f__scale;
-#ifdef KR_headers
-extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
-extern int l_read(), l_write();
-#else
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint);
-extern int l_write(ftnint*, char*, ftnlen, ftnint);
-extern void x_wsne(cilist*);
-extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*);
-extern int l_read(ftnint*,char*,ftnlen,ftnint);
-extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*);
-extern int z_rnew(void);
-#ifdef __cplusplus
-	}
-#endif
-#endif
-extern ftnint L_len;
//GO.SYSIN DD libI77/lio.h
echo libI77/lread.c 1>&2
sed >libI77/lread.c <<'//GO.SYSIN DD libI77/lread.c' 's/^-//'
-#include "f2c.h"
-#include "fio.h"
-#include "fmt.h"
-#include "lio.h"
-#include "ctype.h"
-#include "fp.h"
-
-extern char *f__fmtbuf;
-#ifdef KR_headers
-extern double atof();
-extern char *malloc(), *realloc();
-int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
-#else
-#undef abs
-#undef min
-#undef max
-#include "stdlib.h"
-int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void),
-	(*l_ungetc)(int,FILE*);
-#endif
-int l_eof;
-
-#define isblnk(x) (f__ltab[x+1]&B)
-#define issep(x) (f__ltab[x+1]&SX)
-#define isapos(x) (f__ltab[x+1]&AX)
-#define isexp(x) (f__ltab[x+1]&EX)
-#define issign(x) (f__ltab[x+1]&SG)
-#define iswhit(x) (f__ltab[x+1]&WH)
-#define SX 1
-#define B 2
-#define AX 4
-#define EX 8
-#define SG 16
-#define WH 32
-char f__ltab[128+1] = {	/* offset one for EOF */
-	0,
-	0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0,
-	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-	SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX,
-	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-	0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
-	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-	AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
-	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
-};
-
-#ifdef ungetc
- static int
-#ifdef KR_headers
-un_getc(x,f__cf) int x; FILE *f__cf;
-#else
-un_getc(int x, FILE *f__cf)
-#endif
-{ return ungetc(x,f__cf); }
-#else
-#define un_getc ungetc
-#ifdef KR_headers
- extern int ungetc();
-#else
-extern int ungetc(int, FILE*);	/* for systems with a buggy stdio.h */
-#endif
-#endif
-
-t_getc(Void)
-{	int ch;
-	if(f__curunit->uend) return(EOF);
-	if((ch=getc(f__cf))!=EOF) return(ch);
-	if(feof(f__cf))
-		f__curunit->uend = l_eof = 1;
-	return(EOF);
-}
-integer e_rsle(Void)
-{
-	int ch;
-	if(f__curunit->uend) return(0);
-	while((ch=t_getc())!='\n' && ch!=EOF);
-	return(0);
-}
-
-flag f__lquit;
-int f__lcount,f__ltype,nml_read;
-char *f__lchar;
-double f__lx,f__ly;
-#define ERR(x) if(n=(x)) return(n)
-#define GETC(x) (x=(*l_getc)())
-#define Ungetc(x,y) (*l_ungetc)(x,y)
-
-#ifdef KR_headers
-l_R(poststar) int poststar;
-#else
-l_R(int poststar)
-#endif
-{
-	char s[FMAX+EXPMAXDIGS+4];
-	register int ch;
-	register char *sp, *spe, *sp1;
-	long e, exp;
-	int havenum, havestar, se;
-
-	if (!poststar) {
-		if (f__lcount > 0)
-			return(0);
-		f__lcount = 1;
-		}
-	f__ltype = 0;
-	exp = 0;
-	havestar = 0;
-retry:
-	sp1 = sp = s;
-	spe = sp + FMAX;
-	havenum = 0;
-
-	switch(GETC(ch)) {
-		case '-': *sp++ = ch; sp1++; spe++;
-		case '+':
-			GETC(ch);
-		}
-	while(ch == '0') {
-		++havenum;
-		GETC(ch);
-		}
-	while(isdigit(ch)) {
-		if (sp < spe) *sp++ = ch;
-		else ++exp;
-		GETC(ch);
-		}
-	if (ch == '*' && !poststar) {
-		if (sp == sp1 || exp || *s == '-') {
-			errfl(f__elist->cierr,112,"bad repetition count");
-			}
-		poststar = havestar = 1;
-		*sp = 0;
-		f__lcount = atoi(s);
-		goto retry;
-		}
-	if (ch == '.') {
-		GETC(ch);
-		if (sp == sp1)
-			while(ch == '0') {
-				++havenum;
-				--exp;
-				GETC(ch);
-				}
-		while(isdigit(ch)) {
-			if (sp < spe)
-				{ *sp++ = ch; --exp; }
-			GETC(ch);
-			}
-		}
-	havenum += sp - sp1;
-	se = 0;
-	if (issign(ch))
-		goto signonly;
-	if (havenum && isexp(ch)) {
-		GETC(ch);
-		if (issign(ch)) {
-signonly:
-			if (ch == '-') se = 1;
-			GETC(ch);
-			}
-		if (!isdigit(ch)) {
-bad:
-			errfl(f__elist->cierr,112,"exponent field");
-			}
-
-		e = ch - '0';
-		while(isdigit(GETC(ch))) {
-			e = 10*e + ch - '0';
-			if (e > EXPMAX)
-				goto bad;
-			}
-		if (se)
-			exp -= e;
-		else
-			exp += e;
-		}
-	(void) Ungetc(ch, f__cf);
-	if (sp > sp1) {
-		++havenum;
-		while(*--sp == '0')
-			++exp;
-		if (exp)
-			sprintf(sp+1, "e%ld", exp);
-		else
-			sp[1] = 0;
-		f__lx = atof(s);
-		}
-	else
-		f__lx = 0.;
-	if (havenum)
-		f__ltype = TYLONG;
-	else
-		switch(ch) {
-			case ',':
-			case '/':
-				break;
-			default:
-				if (havestar && ( ch == ' '
-						||ch == '\t'
-						||ch == '\n'))
-					break;
-				if (nml_read > 1) {
-					f__lquit =