libf77

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

-#undef abs
-#include "math.h"
-double r_sin(real *x)
-#endif
-{
-return( sin(*x) );
-}
//GO.SYSIN DD libF77/r_sin.c
echo libF77/r_sinh.c 1>&2
sed >libF77/r_sinh.c <<'//GO.SYSIN DD libF77/r_sinh.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double sinh();
-double r_sinh(x) real *x;
-#else
-#undef abs
-#include "math.h"
-double r_sinh(real *x)
-#endif
-{
-return( sinh(*x) );
-}
//GO.SYSIN DD libF77/r_sinh.c
echo libF77/r_sqrt.c 1>&2
sed >libF77/r_sqrt.c <<'//GO.SYSIN DD libF77/r_sqrt.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double sqrt();
-double r_sqrt(x) real *x;
-#else
-#undef abs
-#include "math.h"
-double r_sqrt(real *x)
-#endif
-{
-return( sqrt(*x) );
-}
//GO.SYSIN DD libF77/r_sqrt.c
echo libF77/r_tan.c 1>&2
sed >libF77/r_tan.c <<'//GO.SYSIN DD libF77/r_tan.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double tan();
-double r_tan(x) real *x;
-#else
-#undef abs
-#include "math.h"
-double r_tan(real *x)
-#endif
-{
-return( tan(*x) );
-}
//GO.SYSIN DD libF77/r_tan.c
echo libF77/r_tanh.c 1>&2
sed >libF77/r_tanh.c <<'//GO.SYSIN DD libF77/r_tanh.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double tanh();
-double r_tanh(x) real *x;
-#else
-#undef abs
-#include "math.h"
-double r_tanh(real *x)
-#endif
-{
-return( tanh(*x) );
-}
//GO.SYSIN DD libF77/r_tanh.c
echo libF77/s_cat.c 1>&2
sed >libF77/s_cat.c <<'//GO.SYSIN DD libF77/s_cat.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-VOID s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
-#else
-VOID s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
-#endif
-{
-ftnlen i, n, nc;
-char *f__rp;
-
-n = *np;
-for(i = 0 ; i < n ; ++i)
-	{
-	nc = ll;
-	if(rnp[i] < nc)
-		nc = rnp[i];
-	ll -= nc;
-	f__rp = rpp[i];
-	while(--nc >= 0)
-		*lp++ = *f__rp++;
-	}
-while(--ll >= 0)
-	*lp++ = ' ';
-}
//GO.SYSIN DD libF77/s_cat.c
echo libF77/s_cmp.c 1>&2
sed >libF77/s_cmp.c <<'//GO.SYSIN DD libF77/s_cmp.c' 's/^-//'
-#include "f2c.h"
-
-/* compare two strings */
-
-#ifdef KR_headers
-integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb;
-#else
-integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
-#endif
-{
-register unsigned char *a, *aend, *b, *bend;
-a = (unsigned char *)a0;
-b = (unsigned char *)b0;
-aend = a + la;
-bend = b + lb;
-
-if(la <= lb)
-	{
-	while(a < aend)
-		if(*a != *b)
-			return( *a - *b );
-		else
-			{ ++a; ++b; }
-
-	while(b < bend)
-		if(*b != ' ')
-			return( ' ' - *b );
-		else	++b;
-	}
-
-else
-	{
-	while(b < bend)
-		if(*a == *b)
-			{ ++a; ++b; }
-		else
-			return( *a - *b );
-	while(a < aend)
-		if(*a != ' ')
-			return(*a - ' ');
-		else	++a;
-	}
-return(0);
-}
//GO.SYSIN DD libF77/s_cmp.c
echo libF77/s_copy.c 1>&2
sed >libF77/s_copy.c <<'//GO.SYSIN DD libF77/s_copy.c' 's/^-//'
-#include "f2c.h"
-
-/* assign strings:  a = b */
-
-#ifdef KR_headers
-VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
-#else
-void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
-#endif
-{
-register char *aend, *bend;
-
-aend = a + la;
-
-if(la <= lb)
-	while(a < aend)
-		*a++ = *b++;
-
-else
-	{
-	bend = b + lb;
-	while(b < bend)
-		*a++ = *b++;
-	while(a < aend)
-		*a++ = ' ';
-	}
-}
//GO.SYSIN DD libF77/s_copy.c
echo libF77/s_paus.c 1>&2
sed >libF77/s_paus.c <<'//GO.SYSIN DD libF77/s_paus.c' 's/^-//'
-#include "stdio.h"
-#include "f2c.h"
-#define PAUSESIG 15
-
-#ifdef KR_headers
-#define Void /* void */
-#define Int /* int */
-#else
-#define Void void
-#define Int int
-#undef abs
-#undef min
-#undef max
-#include "stdlib.h"
-#include "signal.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern int getpid(void), isatty(int), pause(void);
-#endif
-
-extern VOID f_exit(Void);
-
- static VOID
-waitpause(Int n)
-{	n = n; /* shut up compiler warning */
-	return;
-	}
-
- static VOID
-#ifdef KR_headers
-s_1paus(fin) FILE *fin;
-#else
-s_1paus(FILE *fin)
-#endif
-{
-	fprintf(stderr,
-	"To resume execution, type go.  Other input will terminate the job.\n");
-	fflush(stderr);
-	if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
-		fprintf(stderr, "STOP\n");
-#ifdef NO_ONEXIT
-		f_exit();
-#endif
-		exit(0);
-		}
-	}
-
- int
-#ifdef KR_headers
-s_paus(s, n) char *s; ftnlen n;
-#else
-s_paus(char *s, ftnlen n)
-#endif
-{
-	fprintf(stderr, "PAUSE ");
-	if(n > 0)
-		fprintf(stderr, " %.*s", (int)n, s);
-	fprintf(stderr, " statement executed\n");
-	if( isatty(fileno(stdin)) )
-		s_1paus(stdin);
-	else {
-#ifdef MSDOS
-		FILE *fin;
-		fin = fopen("con", "r");
-		if (!fin) {
-			fprintf(stderr, "s_paus: can't open con!\n");
-			fflush(stderr);
-			exit(1);
-			}
-		s_1paus(fin);
-		fclose(fin);
-#else
-		fprintf(stderr,
-		"To resume execution, execute a   kill -%d %d   command\n",
-			PAUSESIG, getpid() );
-		signal(PAUSESIG, waitpause);
-		fflush(stderr);
-		pause();
-#endif
-		}
-	fprintf(stderr, "Execution resumes after PAUSE.\n");
-	fflush(stderr);
-	return 0; /* NOT REACHED */
-#ifdef __cplusplus
-	}
-#endif
-}
//GO.SYSIN DD libF77/s_paus.c
echo libF77/s_rnge.c 1>&2
sed >libF77/s_rnge.c <<'//GO.SYSIN DD libF77/s_rnge.c' 's/^-//'
-#include "stdio.h"
-#include "f2c.h"
-
-/* called when a subscript is out of range */
-
-#ifdef KR_headers
-extern VOID sig_die();
-integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line;
-#else
-extern VOID sig_die(char*,int);
-integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line)
-#endif
-{
-register int i;
-
-fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line);
-while((i = *procn) && i != '_' && i != ' ')
-	putc(*procn++, stderr);
-fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
-while((i = *varn) && i != ' ')
-	putc(*varn++, stderr);
-sig_die(".", 1);
-#ifdef __cplusplus
-return 0;
-#endif
-}
//GO.SYSIN DD libF77/s_rnge.c
echo libF77/s_stop.c 1>&2
sed >libF77/s_stop.c <<'//GO.SYSIN DD libF77/s_stop.c' 's/^-//'
-#include "stdio.h"
-#include "f2c.h"
-
-#ifdef KR_headers
-extern void f_exit();
-VOID s_stop(s, n) char *s; ftnlen n;
-#else
-#undef abs
-#undef min
-#undef max
-#include "stdlib.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-void f_exit(void);
-
-int s_stop(char *s, ftnlen n)
-#endif
-{
-int i;
-
-if(n > 0)
-	{
-	fprintf(stderr, "STOP ");
-	for(i = 0; i<n ; ++i)
-		putc(*s++, stderr);
-	fprintf(stderr, " statement executed\n");
-	}
-#ifdef NO_ONEXIT
-f_exit();
-#endif
-exit(0);
-#ifdef __cplusplus
-return 0; /* NOT REACHED */
-}
-#endif
-}
//GO.SYSIN DD libF77/s_stop.c
echo libF77/sig_die.c 1>&2
sed >libF77/sig_die.c <<'//GO.SYSIN DD libF77/sig_die.c' 's/^-//'
-#include "stdio.h"
-#include "signal.h"
-
-#ifndef SIGIOT
-#ifdef SIGABRT
-#define SIGIOT SIGABRT
-#endif
-#endif
-
-#ifdef KR_headers
-void sig_die(s, kill) register char *s; int kill;
-#else
-#include "stdlib.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
- extern void f_exit(void);
-
-void sig_die(register char *s, int kill)
-#endif
-{
-	/* print error message, then clear buffers */
-	fprintf(stderr, "%s\n", s);
-
-	if(kill)
-		{
-		fflush(stderr);
-		f_exit();
-		fflush(stderr);
-		/* now get a core */
-#ifdef SIGIOT
-		signal(SIGIOT, SIG_DFL);
-#endif
-		abort();
-		}
-	else {
-#ifdef NO_ONEXIT
-		f_exit();
-#endif
-		exit(1);
-		}
-	}
-#ifdef __cplusplus
-}
-#endif
//GO.SYSIN DD libF77/sig_die.c
echo libF77/signal_.c 1>&2
sed >libF77/signal_.c <<'//GO.SYSIN DD libF77/signal_.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-typedef int (*sig_type)();
-extern sig_type signal();
-
-ftnint signal_(sigp, proc) integer *sigp; sig_type proc;
-#else
-#include "signal.h"
-typedef void (*sig_type)(int);
-
-ftnint signal_(integer *sigp, sig_type proc)
-#endif
-{
-	int sig;
-	sig = (int)*sigp;
-
-	return (ftnint)signal(sig, proc);
-	}
//GO.SYSIN DD libF77/signal_.c
echo libF77/system_.c 1>&2
sed >libF77/system_.c <<'//GO.SYSIN DD libF77/system_.c' 's/^-//'
-/* f77 interface to system routine */
-
-#include "f2c.h"
-
-#ifdef KR_headers
-system_(s, n) register char *s; ftnlen n;
-#else
-#undef abs
-#undef min
-#undef max
-#include "stdlib.h"
-system_(register char *s, ftnlen n)
-#endif
-{
-char buff[1000];
-register char *bp, *blast;
-
-blast = buff + (n < 1000 ? n : 1000);
-
-for(bp = buff ; bp<blast && *s!='\0' ; )
-	*bp++ = *s++;
-*bp = '\0';
-return system(buff);
-}
//GO.SYSIN DD libF77/system_.c
echo libF77/z_abs.c 1>&2
sed >libF77/z_abs.c <<'//GO.SYSIN DD libF77/z_abs.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double f__cabs();
-double z_abs(z) doublecomplex *z;
-#else
-double f__cabs(double, double);
-double z_abs(doublecomplex *z)
-#endif
-{
-return( f__cabs( z->r, z->i ) );
-}
//GO.SYSIN DD libF77/z_abs.c
echo libF77/z_cos.c 1>&2
sed >libF77/z_cos.c <<'//GO.SYSIN DD libF77/z_cos.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double sin(), cos(), sinh(), cosh();
-VOID z_cos(r, z) doublecomplex *r, *z;
-#else
-#undef abs
-#include "math.h"
-void z_cos(doublecomplex *r, doublecomplex *z)
-#endif
-{
-r->r = cos(z->r) * cosh(z->i);
-r->i = - sin(z->r) * sinh(z->i);
-}
//GO.SYSIN DD libF77/z_cos.c
echo libF77/z_div.c 1>&2
sed >libF77/z_div.c <<'//GO.SYSIN DD libF77/z_div.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-extern void sig_die();
-VOID z_div(c, a, b) doublecomplex *a, *b, *c;
-#else
-extern void sig_die(char*, int);
-void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
-#endif
-{
-double ratio, den;
-double abr, abi;
-
-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 = 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;
-	}
-
-else
-	{
-	ratio = 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;
-	}
-
-}
//GO.SYSIN DD libF77/z_div.c
echo libF77/z_exp.c 1>&2
sed >libF77/z_exp.c <<'//GO.SYSIN DD libF77/z_exp.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double exp(), cos(), sin();
-VOID z_exp(r, z) doublecomplex *r, *z;
-#else
-#undef abs
-#include "math.h"
-void z_exp(doublecomplex *r, doublecomplex *z)
-#endif
-{
-double expx;
-
-expx = exp(z->r);
-r->r = expx * cos(z->i);
-r->i = expx * sin(z->i);
-}
//GO.SYSIN DD libF77/z_exp.c
echo libF77/z_log.c 1>&2
sed >libF77/z_log.c <<'//GO.SYSIN DD libF77/z_log.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double log(), f__cabs(), atan2();
-VOID z_log(r, z) doublecomplex *r, *z;
-#else
-#undef abs
-#include "math.h"
-extern double f__cabs(double, double);
-void z_log(doublecomplex *r, doublecomplex *z)
-#endif
-{
-
-r->i = atan2(z->i, z->r);
-r->r = log( f__cabs( z->r, z->i ) );
-}
//GO.SYSIN DD libF77/z_log.c
echo libF77/z_sin.c 1>&2
sed >libF77/z_sin.c <<'//GO.SYSIN DD libF77/z_sin.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double sin(), cos(), sinh(), cosh();
-VOID z_sin(r, z) doublecomplex *r, *z;
-#else
-#undef abs
-#include "math.h"
-void z_sin(doublecomplex *r, doublecomplex *z)
-#endif
-{
-r->r = sin(z->r) * cosh(z->i);
-r->i = cos(z->r) * sinh(z->i);
-}
//GO.SYSIN DD libF77/z_sin.c
echo libF77/z_sqrt.c 1>&2
sed >libF77/z_sqrt.c <<'//GO.SYSIN DD libF77/z_sqrt.c' 's/^-//'
-#include "f2c.h"
-
-#ifdef KR_headers
-double sqrt(), f__cabs();
-VOID z_sqrt(r, z) doublecomplex *r, *z;
-#else
-#undef abs
-#include "math.h"
-