Bell 32V development

Work on file usr/src/libF77/abort_.c
Work on file usr/src/libF77/c_abs.c
Work on file usr/src/libF77/c_log.c
Work on file usr/src/libF77/c_div.c
Work on file usr/src/libF77/c_exp.c
Work on file usr/src/libF77/c_cos.c
Work on file usr/src/libF77/c_sin.c
Work on file usr/src/libF77/c_sqrt.c
Work on file usr/src/libF77/cabs.c
Work on file usr/src/libF77/d_acos.c
Work on file usr/src/libF77/complex
Work on file usr/src/libF77/d_abs.c
Work on file usr/src/libF77/d_asin.c
Work on file usr/src/libF77/d_atan.c
Work on file usr/src/libF77/d_cos.c
Work on file usr/src/libF77/d_dim.c
Work on file usr/src/libF77/d_cnjg.c
Work on file usr/src/libF77/d_atn2.c
Work on file usr/src/libF77/d_cosh.c
Work on file usr/src/libF77/d_int.c
Work on file usr/src/libF77/d_exp.c
Work on file usr/src/libF77/d_imag.c
Work on file usr/src/libF77/d_lg10.c
Work on file usr/src/libF77/d_prod.c
Work on file usr/src/libF77/d_nint.c
Work on file usr/src/libF77/d_sinh.c
Work on file usr/src/libF77/d_mod.c
Work on file usr/src/libF77/d_sin.c
Work on file usr/src/libF77/d_sqrt.c
Work on file usr/src/libF77/d_log.c
Work on file usr/src/libF77/d_sign.c
Work on file usr/src/libF77/h_indx.c
Work on file usr/src/libF77/h_abs.c
Work on file usr/src/libF77/h_dnnt.c
Work on file usr/src/libF77/h_dim.c
Work on file usr/src/libF77/h_len.c
Work on file usr/src/libF77/d_tan.c
Work on file usr/src/libF77/d_tanh.c
Work on file usr/src/libF77/i_dnnt.c
Work on file usr/src/libF77/h_sign.c
Work on file usr/src/libF77/i_len.c
Work on file usr/src/libF77/h_nint.c
Work on file usr/src/libF77/i_indx.c
Work on file usr/src/libF77/i_abs.c
Work on file usr/src/libF77/i_dim.c
Work on file usr/src/libF77/h_mod.c
Work on file usr/src/libF77/l_le.c
Work on file usr/src/libF77/i_mod.c
Work on file usr/src/libF77/l_ge.c
Work on file usr/src/libF77/i_nint.c
Work on file usr/src/libF77/i_sign.c
Work on file usr/src/libF77/iargc_.c
Work on file usr/src/libF77/l_gt.c
Work on file usr/src/libF77/pow_hh.c
Work on file usr/src/libF77/pow_ci.c
Work on file usr/src/libF77/pow_ii.c
Work on file usr/src/libF77/l_lt.c
Work on file usr/src/libF77/pow_di.c
Work on file usr/src/libF77/main.c
Work on file usr/src/libF77/pow_dd.c
Work on file usr/src/libF77/pow_ri.c
Work on file usr/src/libF77/r_asin.c
Work on file usr/src/libF77/pow_zz.c
Work on file usr/src/libF77/r_abs.c
Work on file usr/src/libF77/pow_zi.c
Work on file usr/src/libF77/r_atn2.c
Work on file usr/src/libF77/r_atan.c
Work on file usr/src/libF77/r_acos.c
Work on file usr/src/libF77/r_cos.c
Work on file usr/src/libF77/r_imag.c
Work on file usr/src/libF77/r_cosh.c
Work on file usr/src/libF77/r_dim.c
Work on file usr/src/libF77/r_exp.c
Work on file usr/src/libF77/r_cnjg.c
Work on file usr/src/libF77/r_sign.c
Work on file usr/src/libF77/r_lg10.c
Work on file usr/src/libF77/r_sinh.c
Work on file usr/src/libF77/r_int.c
Work on file usr/src/libF77/r_mod.c
Work on file usr/src/libF77/r_sin.c
Work on file usr/src/libF77/r_log.c
Work on file usr/src/libF77/r_nint.c
Work on file usr/src/libF77/r_tanh.c
Work on file usr/src/libF77/s_cat.c
Work on file usr/src/libF77/r_tan.c
Work on file usr/src/libF77/s_cmp.c
Work on file usr/src/libF77/r_sqrt.c
Work on file usr/src/libF77/s_stop.c
Work on file usr/src/libF77/z_cos.c
Work on file usr/src/libF77/s_copy.c
Work on file usr/src/libF77/sinh.c
Work on file usr/src/libF77/z_abs.c
Work on file usr/src/libF77/z_div.c
Work on file usr/src/libF77/signal_.c
Work on file usr/src/libF77/tanh.c
Work on file usr/src/libF77/z_sqrt.c
Work on file usr/src/libF77/z_exp.c
Work on file usr/src/libF77/z_log.c
Work on file usr/src/libF77/z_sin.c

Co-Authored-By: John Reiser <jfr@research.uucp>
Synthesized-from: 32v

diff --git a/usr/src/libF77/abort_.c b/usr/src/libF77/abort_.c
new file mode 100644 (file)
index 0000000..21a7b01
--- /dev/null
+++ b/usr/src/libF77/abort_.c
@@ -0,0 +1,8 @@
+#include <stdio.h>
+
+abort_()
+{
+fprintf(stderr, "Fortran abort routine called\n");
+_cleanup();
+abort();
+}

diff --git a/usr/src/libF77/c_abs.c b/usr/src/libF77/c_abs.c
new file mode 100644 (file)
index 0000000..79cfa80
--- /dev/null
+++ b/usr/src/libF77/c_abs.c
@@ -0,0 +1,9 @@
+#include "complex"
+
+float c_abs(z)
+complex *z;
+{
+double cabs();
+
+return( cabs( z->real, z->imag ) );
+}

diff --git a/usr/src/libF77/c_cos.c b/usr/src/libF77/c_cos.c
new file mode 100644 (file)
index 0000000..5927542
--- /dev/null
+++ b/usr/src/libF77/c_cos.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+c_cos(r, z)
+complex *r, *z;
+{
+double sin(), cos(), sinh(), cosh();
+
+r->real = cos(z->real) * cosh(z->imag);
+r->imag = - sin(z->real) * sinh(z->imag);
+}

diff --git a/usr/src/libF77/c_div.c b/usr/src/libF77/c_div.c
new file mode 100644 (file)
index 0000000..8e959d7
--- /dev/null
+++ b/usr/src/libF77/c_div.c
@@ -0,0 +1,31 @@
+struct complex { float real, imag; };
+
+c_div(c, a, b)
+struct complex *a, *b, *c;
+{
+double ratio, den;
+double abr, abi;
+
+if( (abr = b->real) < 0.)
+       abr = - abr;
+if( (abi = b->imag) < 0.)
+       abi = - abi;
+if( abr <= abi )
+       {
+       if(abi == 0)
+               abort(); /* fatal("complex division by zero"); */
+       ratio = b->real / b->imag ;
+       den = b->imag * (1 + ratio*ratio);
+       c->real = (a->real*ratio + a->imag) / den;
+       c->imag = (a->imag*ratio - a->real) / den;
+       }
+
+else
+       {
+       ratio = b->imag / b->real ;
+       den = b->real * (1 + ratio*ratio);
+       c->real = (a->real + a->imag*ratio) / den;
+       c->imag = (a->imag - a->real*ratio) / den;
+       }
+
+}

diff --git a/usr/src/libF77/c_exp.c b/usr/src/libF77/c_exp.c
new file mode 100644 (file)
index 0000000..a109156
--- /dev/null
+++ b/usr/src/libF77/c_exp.c
@@ -0,0 +1,12 @@
+#include "complex"
+
+c_exp(r, z)
+complex *r, *z;
+{
+double expx;
+double exp(), cos(), sin();
+
+expx = exp(z->real);
+r->real = expx * cos(z->imag);
+r->imag = expx * sin(z->imag);
+}

diff --git a/usr/src/libF77/c_log.c b/usr/src/libF77/c_log.c
new file mode 100644 (file)
index 0000000..fca24c1
--- /dev/null
+++ b/usr/src/libF77/c_log.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+c_log(r, z)
+complex *r, *z;
+{
+double log(), cabs(), atan2();
+
+r->imag = atan2(z->imag, z->real);
+r->real = log( cabs(z->real, z->imag) );
+}

diff --git a/usr/src/libF77/c_sin.c b/usr/src/libF77/c_sin.c
new file mode 100644 (file)
index 0000000..c4a2765
--- /dev/null
+++ b/usr/src/libF77/c_sin.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+c_sin(r, z)
+complex *r, *z;
+{
+double sin(), cos(), sinh(), cosh();
+
+r->real = sin(z->real) * cosh(z->imag);
+r->imag = cos(z->real) * sinh(z->imag);
+}

diff --git a/usr/src/libF77/c_sqrt.c b/usr/src/libF77/c_sqrt.c
new file mode 100644 (file)
index 0000000..60f42f7
--- /dev/null
+++ b/usr/src/libF77/c_sqrt.c
@@ -0,0 +1,22 @@
+#include "complex"
+
+c_sqrt(r, z)
+complex *r, *z;
+{
+double mag, sqrt(), cabs();
+
+if( (mag = cabs(z->real, z->imag)) == 0.)
+       r->real = r->imag = 0.;
+else if(z->real > 0)
+       {
+       r->real = sqrt(0.5 * (mag + z->real) );
+       r->imag = z->imag / r->real / 2;
+       }
+else
+       {
+       r->imag = sqrt(0.5 * (mag - z->real) );
+       if(z->imag < 0)
+               r->imag = - r->imag;
+       r->real = z->imag / r->imag /2;
+       }
+}

diff --git a/usr/src/libF77/cabs.c b/usr/src/libF77/cabs.c
new file mode 100644 (file)
index 0000000..b2b3e4f
--- /dev/null
+++ b/usr/src/libF77/cabs.c
@@ -0,0 +1,21 @@
+double cabs(real, imag)
+double real, imag;
+{
+double temp, sqrt();
+
+if(real < 0)
+       real = -real;
+if(imag < 0)
+       imag = -imag;
+if(imag > real){
+       temp = real;
+       real = imag;
+       imag = temp;
+}
+if((real+imag) == real)
+       return(real);
+
+temp = imag/real;
+temp = real*sqrt(1.0 + temp*temp);  /*overflow!!*/
+return(temp);
+}

diff --git a/usr/src/libF77/complex b/usr/src/libF77/complex
new file mode 100644 (file)
index 0000000..1bb1fb0
--- /dev/null
+++ b/usr/src/libF77/complex
@@ -0,0 +1,2 @@
+typedef struct { float real, imag; } complex;
+typedef struct { double dreal, dimag; } dcomplex;

diff --git a/usr/src/libF77/d_abs.c b/usr/src/libF77/d_abs.c
new file mode 100644 (file)
index 0000000..75c0172
--- /dev/null
+++ b/usr/src/libF77/d_abs.c
@@ -0,0 +1,7 @@
+double d_abs(x)
+double *x;
+{
+if(*x >= 0)
+       return(*x);
+return(- *x);
+}

diff --git a/usr/src/libF77/d_acos.c b/usr/src/libF77/d_acos.c
new file mode 100644 (file)
index 0000000..52c9021
--- /dev/null
+++ b/usr/src/libF77/d_acos.c
@@ -0,0 +1,6 @@
+double d_acos(x)
+double *x;
+{
+double acos();
+return( acos(*x) );
+}

diff --git a/usr/src/libF77/d_asin.c b/usr/src/libF77/d_asin.c
new file mode 100644 (file)
index 0000000..f3ba6e9
--- /dev/null
+++ b/usr/src/libF77/d_asin.c
@@ -0,0 +1,6 @@
+double d_asin(x)
+double *x;
+{
+double asin();
+return( asin(*x) );
+}

diff --git a/usr/src/libF77/d_atan.c b/usr/src/libF77/d_atan.c
new file mode 100644 (file)
index 0000000..6f56301
--- /dev/null
+++ b/usr/src/libF77/d_atan.c
@@ -0,0 +1,6 @@
+double d_atan(x)
+double *x;
+{
+double atan();
+return( atan(*x) );
+}

diff --git a/usr/src/libF77/d_atn2.c b/usr/src/libF77/d_atn2.c
new file mode 100644 (file)
index 0000000..4a6ce1a
--- /dev/null
+++ b/usr/src/libF77/d_atn2.c
@@ -0,0 +1,6 @@
+double d_atn2(x,y)
+double *x, *y;
+{
+double atan2();
+return( atan2(*x,*y) );
+}

diff --git a/usr/src/libF77/d_cnjg.c b/usr/src/libF77/d_cnjg.c
new file mode 100644 (file)
index 0000000..0f5c422
--- /dev/null
+++ b/usr/src/libF77/d_cnjg.c
@@ -0,0 +1,8 @@
+#include "complex"
+
+d_cnjg(r, z)
+dcomplex *r, *z;
+{
+r->dreal = z->dreal;
+r->dimag = - z->dimag;
+}

diff --git a/usr/src/libF77/d_cos.c b/usr/src/libF77/d_cos.c
new file mode 100644 (file)
index 0000000..81af954
--- /dev/null
+++ b/usr/src/libF77/d_cos.c
@@ -0,0 +1,6 @@
+double d_cos(x)
+double *x;
+{
+double cos();
+return( cos(*x) );
+}

diff --git a/usr/src/libF77/d_cosh.c b/usr/src/libF77/d_cosh.c
new file mode 100644 (file)
index 0000000..c6697ac
--- /dev/null
+++ b/usr/src/libF77/d_cosh.c
@@ -0,0 +1,6 @@
+double d_cosh(x)
+double *x;
+{
+double cosh();
+return( cosh(*x) );
+}

diff --git a/usr/src/libF77/d_dim.c b/usr/src/libF77/d_dim.c
new file mode 100644 (file)
index 0000000..2b19e05
--- /dev/null
+++ b/usr/src/libF77/d_dim.c
@@ -0,0 +1,5 @@
+double d_dim(a,b)
+double *a, *b;
+{
+return( *a > *b ? *a - *b : 0);
+}

diff --git a/usr/src/libF77/d_exp.c b/usr/src/libF77/d_exp.c
new file mode 100644 (file)
index 0000000..8e9d9ed
--- /dev/null
+++ b/usr/src/libF77/d_exp.c
@@ -0,0 +1,6 @@
+double d_exp(x)
+double *x;
+{
+double exp();
+return( exp(*x) );
+}

diff --git a/usr/src/libF77/d_imag.c b/usr/src/libF77/d_imag.c
new file mode 100644 (file)
index 0000000..3f47dd5
--- /dev/null
+++ b/usr/src/libF77/d_imag.c
@@ -0,0 +1,7 @@
+#include "complex"
+
+double d_imag(z)
+dcomplex *z;
+{
+return(z->dimag);
+}

diff --git a/usr/src/libF77/d_int.c b/usr/src/libF77/d_int.c
new file mode 100644 (file)
index 0000000..47b0d9e
--- /dev/null
+++ b/usr/src/libF77/d_int.c
@@ -0,0 +1,5 @@
+double d_int(x)
+double *x;
+{
+return( (long int) (*x) );
+}

diff --git a/usr/src/libF77/d_lg10.c b/usr/src/libF77/d_lg10.c
new file mode 100644 (file)
index 0000000..39dcb40
--- /dev/null
+++ b/usr/src/libF77/d_lg10.c
@@ -0,0 +1,9 @@
+#define log10e 0.43429448190325182765
+
+double d_lg10(x)
+double *x;
+{
+double log();
+
+return( log10e * log(*x) );
+}

diff --git a/usr/src/libF77/d_log.c b/usr/src/libF77/d_log.c
new file mode 100644 (file)
index 0000000..9771663
--- /dev/null
+++ b/usr/src/libF77/d_log.c
@@ -0,0 +1,6 @@
+double d_log(x)
+double *x;
+{
+double log();
+return( log(*x) );
+}

diff --git a/usr/src/libF77/d_mod.c b/usr/src/libF77/d_mod.c
new file mode 100644 (file)
index 0000000..24377d5
--- /dev/null
+++ b/usr/src/libF77/d_mod.c
@@ -0,0 +1,5 @@
+double d_mod(x,y)
+double *x, *y;
+{
+return(*x - (*y) * ( (long int) (*x / *y)) );
+}

diff --git a/usr/src/libF77/d_nint.c b/usr/src/libF77/d_nint.c
new file mode 100644 (file)
index 0000000..ecb039b
--- /dev/null
+++ b/usr/src/libF77/d_nint.c
@@ -0,0 +1,6 @@
+double d_nint(x)
+double *x;
+{
+return( (*x)>=0 ?
+       (long int) (*x + .5) : (long int) (*x - .5) );
+}

diff --git a/usr/src/libF77/d_prod.c b/usr/src/libF77/d_prod.c
new file mode 100644 (file)
index 0000000..7cf462d
--- /dev/null
+++ b/usr/src/libF77/d_prod.c
@@ -0,0 +1,5 @@
+double d_prod(x,y)
+float *x, *y;
+{
+return( (*x) * (*y) );
+}

diff --git a/usr/src/libF77/d_sign.c b/usr/src/libF77/d_sign.c
new file mode 100644 (file)
index 0000000..a254e33
--- /dev/null
+++ b/usr/src/libF77/d_sign.c
@@ -0,0 +1,7 @@
+double d_sign(a,b)
+double *a, *b;
+{
+double x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}

diff --git a/usr/src/libF77/d_sin.c b/usr/src/libF77/d_sin.c
new file mode 100644 (file)
index 0000000..63ffbbe
--- /dev/null
+++ b/usr/src/libF77/d_sin.c
@@ -0,0 +1,6 @@
+double d_sin(x)
+double *x;
+{
+double sin();
+return( sin(*x) );
+}

diff --git a/usr/src/libF77/d_sinh.c b/usr/src/libF77/d_sinh.c
new file mode 100644 (file)
index 0000000..a6fe34f
--- /dev/null
+++ b/usr/src/libF77/d_sinh.c
@@ -0,0 +1,6 @@
+double d_sinh(x)
+double *x;
+{
+double sinh();
+return( sinh(*x) );
+}

diff --git a/usr/src/libF77/d_sqrt.c b/usr/src/libF77/d_sqrt.c
new file mode 100644 (file)
index 0000000..a6ac8b8
--- /dev/null
+++ b/usr/src/libF77/d_sqrt.c
@@ -0,0 +1,6 @@
+double d_sqrt(x)
+double *x;
+{
+double sqrt();
+return( sqrt(*x) );
+}

diff --git a/usr/src/libF77/d_tan.c b/usr/src/libF77/d_tan.c
new file mode 100644 (file)
index 0000000..362b955
--- /dev/null
+++ b/usr/src/libF77/d_tan.c
@@ -0,0 +1,6 @@
+double d_tan(x)
+double *x;
+{
+double tan();
+return( tan(*x) );
+}

diff --git a/usr/src/libF77/d_tanh.c b/usr/src/libF77/d_tanh.c
new file mode 100644 (file)
index 0000000..d2e12e6
--- /dev/null
+++ b/usr/src/libF77/d_tanh.c
@@ -0,0 +1,6 @@
+double d_tanh(x)
+double *x;
+{
+double tanh();
+return( tanh(*x) );
+}

diff --git a/usr/src/libF77/h_abs.c b/usr/src/libF77/h_abs.c
new file mode 100644 (file)
index 0000000..b77cf88
--- /dev/null
+++ b/usr/src/libF77/h_abs.c
@@ -0,0 +1,7 @@
+short h_abs(x)
+short *x;
+{
+if(*x >= 0)
+       return(*x);
+return(- *x);
+}

diff --git a/usr/src/libF77/h_dim.c b/usr/src/libF77/h_dim.c
new file mode 100644 (file)
index 0000000..015127b
--- /dev/null
+++ b/usr/src/libF77/h_dim.c
@@ -0,0 +1,5 @@
+short h_dim(a,b)
+short *a, *b;
+{
+return( *a > *b ? *a - *b : 0);
+}

diff --git a/usr/src/libF77/h_dnnt.c b/usr/src/libF77/h_dnnt.c
new file mode 100644 (file)
index 0000000..c7ea792
--- /dev/null
+++ b/usr/src/libF77/h_dnnt.c
@@ -0,0 +1,6 @@
+short h_dnnt(x)
+double *x;
+{
+return( (*x)>=0 ?
+       (short) (*x + .5) : (short) (*x - .5) );
+}

diff --git a/usr/src/libF77/h_indx.c b/usr/src/libF77/h_indx.c
new file mode 100644 (file)
index 0000000..9d4db1d
--- /dev/null
+++ b/usr/src/libF77/h_indx.c
@@ -0,0 +1,22 @@
+short h_indx(a, b, la, lb)
+char *a, *b;
+long int la, lb;
+{
+int i, n;
+char *s, *t, *bend;
+
+n = la - lb + 1;
+bend = b + lb;
+
+for(i = 0 ; i < n ; ++i)
+       {
+       s = a + i;
+       t = b;
+       while(t < bend)
+               if(*s++ != *t++)
+                       goto no;
+       return(i+1);
+       no: ;
+       }
+return(0);
+}

diff --git a/usr/src/libF77/h_len.c b/usr/src/libF77/h_len.c
new file mode 100644 (file)
index 0000000..719090b
--- /dev/null
+++ b/usr/src/libF77/h_len.c
@@ -0,0 +1,6 @@
+short h_len(s, n)
+char *s;
+long int n;
+{
+return(n);
+}

diff --git a/usr/src/libF77/h_mod.c b/usr/src/libF77/h_mod.c
new file mode 100644 (file)
index 0000000..c30ab21
--- /dev/null
+++ b/usr/src/libF77/h_mod.c
@@ -0,0 +1,5 @@
+short h_mod(a,b)
+short *a, *b;
+{
+return( *a % *b);
+}

diff --git a/usr/src/libF77/h_nint.c b/usr/src/libF77/h_nint.c
new file mode 100644 (file)
index 0000000..520fbca
--- /dev/null
+++ b/usr/src/libF77/h_nint.c
@@ -0,0 +1,6 @@
+short h_nint(x)
+float *x;
+{
+return( (*x)>=0 ?
+       (short) (*x + .5) : (short) (*x - .5) );
+}

diff --git a/usr/src/libF77/h_sign.c b/usr/src/libF77/h_sign.c
new file mode 100644 (file)
index 0000000..d5924ea
--- /dev/null
+++ b/usr/src/libF77/h_sign.c
@@ -0,0 +1,7 @@
+short h_sign(a,b)
+short *a, *b;
+{
+short x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}

diff --git a/usr/src/libF77/i_abs.c b/usr/src/libF77/i_abs.c
new file mode 100644 (file)
index 0000000..6f1572e
--- /dev/null
+++ b/usr/src/libF77/i_abs.c
@@ -0,0 +1,7 @@
+long int i_abs(x)
+long int *x;
+{
+if(*x >= 0)
+       return(*x);
+return(- *x);
+}

diff --git a/usr/src/libF77/i_dim.c b/usr/src/libF77/i_dim.c
new file mode 100644 (file)
index 0000000..a9162d1
--- /dev/null
+++ b/usr/src/libF77/i_dim.c
@@ -0,0 +1,5 @@
+long int i_dim(a,b)
+long int *a, *b;
+{
+return( *a > *b ? *a - *b : 0);
+}

diff --git a/usr/src/libF77/i_dnnt.c b/usr/src/libF77/i_dnnt.c
new file mode 100644 (file)
index 0000000..c1deb52
--- /dev/null
+++ b/usr/src/libF77/i_dnnt.c
@@ -0,0 +1,6 @@
+long int i_dnnt(x)
+double *x;
+{
+return( (*x)>=0 ?
+       (long int) (*x + .5) : (long int) (*x - .5) );
+}

diff --git a/usr/src/libF77/i_indx.c b/usr/src/libF77/i_indx.c
new file mode 100644 (file)
index 0000000..f5eed7b
--- /dev/null
+++ b/usr/src/libF77/i_indx.c
@@ -0,0 +1,22 @@
+long int i_indx(a, b, la, lb)
+char *a, *b;
+long int la, lb;
+{
+long int i, n;
+char *s, *t, *bend;
+
+n = la - lb + 1;
+bend = b + lb;
+
+for(i = 0 ; i < n ; ++i)
+       {
+       s = a + i;
+       t = b;
+       while(t < bend)
+               if(*s++ != *t++)
+                       goto no;
+       return(i+1);
+       no: ;
+       }
+return(0);
+}

diff --git a/usr/src/libF77/i_len.c b/usr/src/libF77/i_len.c
new file mode 100644 (file)
index 0000000..96a480f
--- /dev/null
+++ b/usr/src/libF77/i_len.c
@@ -0,0 +1,6 @@
+long int i_len(s, n)
+char *s;
+long int n;
+{
+return(n);
+}

diff --git a/usr/src/libF77/i_mod.c b/usr/src/libF77/i_mod.c
new file mode 100644 (file)
index 0000000..28e81c2
--- /dev/null
+++ b/usr/src/libF77/i_mod.c
@@ -0,0 +1,5 @@
+long int i_mod(a,b)
+long int *a, *b;
+{
+return( *a % *b);
+}

diff --git a/usr/src/libF77/i_nint.c b/usr/src/libF77/i_nint.c
new file mode 100644 (file)
index 0000000..d06ba8e
--- /dev/null
+++ b/usr/src/libF77/i_nint.c
@@ -0,0 +1,6 @@
+long int i_nint(x)
+float *x;
+{
+return( (*x)>=0 ?
+       (long int) (*x + .5) : (long int) (*x - .5) );
+}

diff --git a/usr/src/libF77/i_sign.c b/usr/src/libF77/i_sign.c
new file mode 100644 (file)
index 0000000..428f564
--- /dev/null
+++ b/usr/src/libF77/i_sign.c
@@ -0,0 +1,7 @@
+long int i_sign(a,b)
+long int *a, *b;
+{
+long int x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}

diff --git a/usr/src/libF77/iargc_.c b/usr/src/libF77/iargc_.c
new file mode 100644 (file)
index 0000000..4d9621a
--- /dev/null
+++ b/usr/src/libF77/iargc_.c
@@ -0,0 +1,5 @@
+long int iargc_()
+{
+extern int xargc;
+return ( xargc - 1 );
+}

diff --git a/usr/src/libF77/l_ge.c b/usr/src/libF77/l_ge.c
new file mode 100644 (file)
index 0000000..7bdcad4
--- /dev/null
+++ b/usr/src/libF77/l_ge.c
@@ -0,0 +1,6 @@
+long int l_ge(a,b,la,lb)
+char *a, *b;
+long int la, lb;
+{
+return(s_cmp(a,b,la,lb) >= 0);
+}

diff --git a/usr/src/libF77/l_gt.c b/usr/src/libF77/l_gt.c
new file mode 100644 (file)
index 0000000..3983c2c
--- /dev/null
+++ b/usr/src/libF77/l_gt.c
@@ -0,0 +1,6 @@
+long int l_gt(a,b,la,lb)
+char *a, *b;
+long int la, lb;
+{
+return(s_cmp(a,b,la,lb) > 0);
+}

diff --git a/usr/src/libF77/l_le.c b/usr/src/libF77/l_le.c
new file mode 100644 (file)
index 0000000..caa4528
--- /dev/null
+++ b/usr/src/libF77/l_le.c
@@ -0,0 +1,6 @@
+long int l_le(a,b,la,lb)
+char *a, *b;
+long int la, lb;
+{
+return(s_cmp(a,b,la,lb) <= 0);
+}

diff --git a/usr/src/libF77/l_lt.c b/usr/src/libF77/l_lt.c
new file mode 100644 (file)
index 0000000..f69ba70
--- /dev/null
+++ b/usr/src/libF77/l_lt.c
@@ -0,0 +1,6 @@
+long int l_lt(a,b,la,lb)
+char *a, *b;
+long int la, lb;
+{
+return(s_cmp(a,b,la,lb) < 0);
+}

diff --git a/usr/src/libF77/main.c b/usr/src/libF77/main.c
new file mode 100644 (file)
index 0000000..2127235
--- /dev/null
+++ b/usr/src/libF77/main.c
@@ -0,0 +1,51 @@
+/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
+
+#include <stdio.h>
+#include <signal.h>
+
+int xargc;
+char **xargv;
+
+main(argc, argv, arge)
+int argc;
+char **argv;
+char **arge;
+{
+int sigfdie(), sigidie();
+
+xargc = argc;
+xargv = argv;
+signal(SIGFPE, sigfdie);       /* ignore underflow, enable overflow */
+signal(SIGIOT, sigidie);
+MAIN__();
+f_exit();
+}
+
+
+static sigfdie()
+{
+sigdie("Floating Exception");
+}
+
+
+
+static sigidie()
+{
+sigdie("IOT Trap");
+}
+
+
+
+static sigdie(s)
+register char *s;
+{
+/* print error message, then clear buffers */
+fflush(stderr);
+fprintf(stderr, "%s\n", s);
+f_exit();
+fflush(stderr);
+
+/* now get a core */
+signal(SIGIOT, 0);
+abort();
+}

diff --git a/usr/src/libF77/pow_ci.c b/usr/src/libF77/pow_ci.c
new file mode 100644 (file)
index 0000000..f59fcf3
--- /dev/null
+++ b/usr/src/libF77/pow_ci.c
@@ -0,0 +1,16 @@
+#include "complex"
+
+pow_ci(p, a, b)        /* p = a**b  */
+complex *p, *a;
+long int *b;
+{
+dcomplex p1, a1;
+
+a1.dreal = a->real;
+a1.dimag = a->imag;
+
+pow_zi(&p1, &a1, b);
+
+p->real = p1.dreal;
+p->imag = p1.dimag;
+}

diff --git a/usr/src/libF77/pow_dd.c b/usr/src/libF77/pow_dd.c
new file mode 100644 (file)
index 0000000..103f473
--- /dev/null
+++ b/usr/src/libF77/pow_dd.c
@@ -0,0 +1,7 @@
+double pow_dd(ap, bp)
+double *ap, *bp;
+{
+double pow();
+
+return(pow(*ap, *bp) );
+}

diff --git a/usr/src/libF77/pow_di.c b/usr/src/libF77/pow_di.c
new file mode 100644 (file)
index 0000000..c4a4628
--- /dev/null
+++ b/usr/src/libF77/pow_di.c
@@ -0,0 +1,34 @@
+double pow_di(ap, bp)
+double *ap;
+long int *bp;
+{
+double pow, x;
+long int n;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+       {
+       if(n < 0)
+               {
+               if(x == 0)
+                       {
+                       return(pow);
+                       }
+               n = -n;
+               x = 1/x;
+               }
+       for( ; ; )
+               {
+               if(n & 01)
+                       pow *= x;
+               if(n >>= 1)
+                       x *= x;
+               else
+                       break;
+               }
+       }
+return(pow);
+}

diff --git a/usr/src/libF77/pow_hh.c b/usr/src/libF77/pow_hh.c
new file mode 100644 (file)
index 0000000..ff77ab6
--- /dev/null
+++ b/usr/src/libF77/pow_hh.c
@@ -0,0 +1,23 @@
+short pow_hh(ap, bp)
+short *ap, *bp;
+{
+short pow, x, n;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n < 0)
+       { }
+else if(n > 0)
+       for( ; ; )
+               {
+               if(n & 01)
+                       pow *= x;
+               if(n >>= 1)
+                       x *= x;
+               else
+                       break;
+               }
+return(pow);
+}

diff --git a/usr/src/libF77/pow_ii.c b/usr/src/libF77/pow_ii.c
new file mode 100644 (file)
index 0000000..138040b
--- /dev/null
+++ b/usr/src/libF77/pow_ii.c
@@ -0,0 +1,23 @@
+long int pow_ii(ap, bp)
+long int *ap, *bp;
+{
+long int pow, x, n;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n < 0)
+       { }
+else if(n > 0)
+       for( ; ; )
+               {
+               if(n & 01)
+                       pow *= x;
+               if(n >>= 1)
+                       x *= x;
+               else
+                       break;
+               }
+return(pow);
+}

diff --git a/usr/src/libF77/pow_ri.c b/usr/src/libF77/pow_ri.c
new file mode 100644 (file)
index 0000000..492e573
--- /dev/null
+++ b/usr/src/libF77/pow_ri.c
@@ -0,0 +1,34 @@
+float pow_ri(ap, bp)
+float *ap;
+long int *bp;
+{
+double pow, x;
+long int n;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+       {
+       if(n < 0)
+               {
+               if(x == 0)
+                       {
+                       return(pow);
+                       }
+               n = -n;
+               x = 1/x;
+               }
+       for( ; ; )
+               {
+               if(n & 01)
+                       pow *= x;
+               if(n >>= 1)
+                       x *= x;
+               else
+                       break;
+               }
+       }
+return(pow);
+}

diff --git a/usr/src/libF77/pow_zi.c b/usr/src/libF77/pow_zi.c
new file mode 100644 (file)
index 0000000..cd9362e
--- /dev/null
+++ b/usr/src/libF77/pow_zi.c
@@ -0,0 +1,45 @@
+#include "complex"
+
+pow_zi(p, a, b)        /* p = a**b  */
+dcomplex *p, *a;
+long int *b;
+{
+long int n;
+double t;
+dcomplex x;
+
+n = *b;
+p->dreal = 1;
+p->dimag = 0;
+
+if(n == 0)
+       return;
+if(n < 0)
+       {
+       n = -n;
+       z_div(&x, a);
+       }
+else
+       {
+       x.dreal = a->dreal;
+       x.dimag = a->dimag;
+       }
+
+for( ; ; )
+       {
+       if(n & 01)
+               {
+               t = p->dreal * x.dreal - p->dimag * x.dimag;
+               p->dimag = p->dreal * x.dimag + p->dimag * x.dreal;
+               p->dreal = t;
+               }
+       if(n >>= 1)
+               {
+               t = x.dreal * x.dreal - x.dimag * x.dimag;
+               x.dimag = 2 * x.dreal * x.dimag;
+               x.dreal = t;
+               }
+       else
+               break;
+       }
+}

diff --git a/usr/src/libF77/pow_zz.c b/usr/src/libF77/pow_zz.c
new file mode 100644 (file)
index 0000000..d36e6bf
--- /dev/null
+++ b/usr/src/libF77/pow_zz.c
@@ -0,0 +1,17 @@
+#include "complex"
+
+pow_zz(r,a,b)
+dcomplex *r, *a, *b;
+{
+double logr, logi, x, y;
+double log(), exp(), cos(), sin(), atan2(), cabs();
+
+logr = log( cabs(a->dreal, a->dimag) );
+logi = atan2(a->dimag, a->dreal);
+
+x = exp( logr * b->dreal - logi * b->dimag );
+y = logr * b->dimag + logi * b->dreal;
+
+r->dreal = x * cos(y);
+r->dimag = x * sin(y);
+}

diff --git a/usr/src/libF77/r_abs.c b/usr/src/libF77/r_abs.c
new file mode 100644 (file)
index 0000000..ca207bf
--- /dev/null
+++ b/usr/src/libF77/r_abs.c
@@ -0,0 +1,7 @@
+double r_abs(x)
+float *x;
+{
+if(*x >= 0)
+       return(*x);
+return(- *x);
+}

diff --git a/usr/src/libF77/r_acos.c b/usr/src/libF77/r_acos.c
new file mode 100644 (file)
index 0000000..3e73a52
--- /dev/null
+++ b/usr/src/libF77/r_acos.c
@@ -0,0 +1,6 @@
+double r_acos(x)
+float *x;
+{
+double acos();
+return( acos(*x) );
+}

diff --git a/usr/src/libF77/r_asin.c b/usr/src/libF77/r_asin.c
new file mode 100644 (file)
index 0000000..4f72a8f
--- /dev/null
+++ b/usr/src/libF77/r_asin.c
@@ -0,0 +1,6 @@
+double r_asin(x)
+float *x;
+{
+double asin();
+return( asin(*x) );
+}

diff --git a/usr/src/libF77/r_atan.c b/usr/src/libF77/r_atan.c
new file mode 100644 (file)
index 0000000..63a2792
--- /dev/null
+++ b/usr/src/libF77/r_atan.c
@@ -0,0 +1,6 @@
+double r_atan(x)
+float *x;
+{
+double atan();
+return( atan(*x) );
+}

diff --git a/usr/src/libF77/r_atn2.c b/usr/src/libF77/r_atn2.c
new file mode 100644 (file)
index 0000000..2429cbe
--- /dev/null
+++ b/usr/src/libF77/r_atn2.c
@@ -0,0 +1,6 @@
+double r_atn2(x,y)
+float *x, *y;
+{
+double atan2();
+return( atan2(*x,*y) );
+}

diff --git a/usr/src/libF77/r_cnjg.c b/usr/src/libF77/r_cnjg.c
new file mode 100644 (file)
index 0000000..dcd4a93
--- /dev/null
+++ b/usr/src/libF77/r_cnjg.c
@@ -0,0 +1,8 @@
+#include "complex"
+
+r_cnjg(r, z)
+complex *r, *z;
+{
+r->real = z->real;
+r->imag = - z->imag;
+}

diff --git a/usr/src/libF77/r_cos.c b/usr/src/libF77/r_cos.c
new file mode 100644 (file)
index 0000000..3fdd786
--- /dev/null
+++ b/usr/src/libF77/r_cos.c
@@ -0,0 +1,6 @@
+double r_cos(x)
+float *x;
+{
+double cos();
+return( cos(*x) );
+}

diff --git a/usr/src/libF77/r_cosh.c b/usr/src/libF77/r_cosh.c
new file mode 100644 (file)
index 0000000..b062534
--- /dev/null
+++ b/usr/src/libF77/r_cosh.c
@@ -0,0 +1,6 @@
+double r_cosh(x)
+float *x;
+{
+double cosh();
+return( cosh(*x) );
+}

diff --git a/usr/src/libF77/r_dim.c b/usr/src/libF77/r_dim.c
new file mode 100644 (file)
index 0000000..f622b2f
--- /dev/null
+++ b/usr/src/libF77/r_dim.c
@@ -0,0 +1,5 @@
+double r_dim(a,b)
+float *a, *b;
+{
+return( *a > *b ? *a - *b : 0);
+}

diff --git a/usr/src/libF77/r_exp.c b/usr/src/libF77/r_exp.c
new file mode 100644 (file)
index 0000000..9fc354a
--- /dev/null
+++ b/usr/src/libF77/r_exp.c
@@ -0,0 +1,6 @@
+double r_exp(x)
+float *x;
+{
+double exp();
+return( exp(*x) );
+}

diff --git a/usr/src/libF77/r_imag.c b/usr/src/libF77/r_imag.c
new file mode 100644 (file)
index 0000000..02f63be
--- /dev/null
+++ b/usr/src/libF77/r_imag.c
@@ -0,0 +1,7 @@
+#include "complex"
+
+double r_imag(z)
+complex *z;
+{
+return(z->imag);
+}

diff --git a/usr/src/libF77/r_int.c b/usr/src/libF77/r_int.c
new file mode 100644 (file)
index 0000000..43d9dad
--- /dev/null
+++ b/usr/src/libF77/r_int.c
@@ -0,0 +1,5 @@
+double r_int(x)
+float *x;
+{
+return( (long int) (*x) );
+}

diff --git a/usr/src/libF77/r_lg10.c b/usr/src/libF77/r_lg10.c
new file mode 100644 (file)
index 0000000..4b657ee
--- /dev/null
+++ b/usr/src/libF77/r_lg10.c
@@ -0,0 +1,9 @@
+#define log10e 0.43429448190325182765
+
+double r_lg10(x)
+float *x;
+{
+double log();
+
+return( log10e * log(*x) );
+}

diff --git a/usr/src/libF77/r_log.c b/usr/src/libF77/r_log.c
new file mode 100644 (file)
index 0000000..4241eae
--- /dev/null
+++ b/usr/src/libF77/r_log.c
@@ -0,0 +1,6 @@
+double r_log(x)
+float *x;
+{
+double log();
+return( log(*x) );
+}

diff --git a/usr/src/libF77/r_mod.c b/usr/src/libF77/r_mod.c
new file mode 100644 (file)
index 0000000..047420e
--- /dev/null
+++ b/usr/src/libF77/r_mod.c
@@ -0,0 +1,5 @@
+double r_mod(x,y)
+float *x, *y;
+{
+return(*x - (*y) * ( (long int) (*x / *y)) );
+}

diff --git a/usr/src/libF77/r_nint.c b/usr/src/libF77/r_nint.c
new file mode 100644 (file)
index 0000000..317f01b
--- /dev/null
+++ b/usr/src/libF77/r_nint.c
@@ -0,0 +1,6 @@
+double r_nint(x)
+float *x;
+{
+return( (*x)>=0 ?
+       (long int) (*x + .5) : (long int) (*x - .5) );
+}

diff --git a/usr/src/libF77/r_sign.c b/usr/src/libF77/r_sign.c
new file mode 100644 (file)
index 0000000..901c9a2
--- /dev/null
+++ b/usr/src/libF77/r_sign.c
@@ -0,0 +1,7 @@
+double r_sign(a,b)
+float *a, *b;
+{
+float x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}

diff --git a/usr/src/libF77/r_sin.c b/usr/src/libF77/r_sin.c
new file mode 100644 (file)
index 0000000..0ab7aec
--- /dev/null
+++ b/usr/src/libF77/r_sin.c
@@ -0,0 +1,6 @@
+double r_sin(x)
+float *x;
+{
+double sin();
+return( sin(*x) );
+}

diff --git a/usr/src/libF77/r_sinh.c b/usr/src/libF77/r_sinh.c
new file mode 100644 (file)
index 0000000..7ab5b2a
--- /dev/null
+++ b/usr/src/libF77/r_sinh.c
@@ -0,0 +1,6 @@
+double r_sinh(x)
+float *x;
+{
+double sinh();
+return( sinh(*x) );
+}

diff --git a/usr/src/libF77/r_sqrt.c b/usr/src/libF77/r_sqrt.c
new file mode 100644 (file)
index 0000000..3f84293
--- /dev/null
+++ b/usr/src/libF77/r_sqrt.c
@@ -0,0 +1,6 @@
+double r_sqrt(x)
+float *x;
+{
+double sqrt();
+return( sqrt(*x) );
+}

diff --git a/usr/src/libF77/r_tan.c b/usr/src/libF77/r_tan.c
new file mode 100644 (file)
index 0000000..831b169
--- /dev/null
+++ b/usr/src/libF77/r_tan.c
@@ -0,0 +1,6 @@
+double r_tan(x)
+float *x;
+{
+double tan();
+return( tan(*x) );
+}

diff --git a/usr/src/libF77/r_tanh.c b/usr/src/libF77/r_tanh.c
new file mode 100644 (file)
index 0000000..cc25a8d
--- /dev/null
+++ b/usr/src/libF77/r_tanh.c
@@ -0,0 +1,6 @@
+double r_tanh(x)
+float *x;
+{
+double tanh();
+return( tanh(*x) );
+}

diff --git a/usr/src/libF77/s_cat.c b/usr/src/libF77/s_cat.c
new file mode 100644 (file)
index 0000000..0914a26
--- /dev/null
+++ b/usr/src/libF77/s_cat.c
@@ -0,0 +1,21 @@
+s_cat(lp, rpp, rnp, np, ll)
+char *lp, *rpp[];
+long int rnp[], *np, ll;
+{
+int i, n, nc;
+char *rp;
+
+n = *np;
+for(i = 0 ; i < n ; ++i)
+       {
+       nc = ll;
+       if(rnp[i] < nc)
+               nc = rnp[i];
+       ll -= nc;
+       rp = rpp[i];
+       while(--nc >= 0)
+               *lp++ = *rp++;
+       }
+while(--ll >= 0)
+       *lp++ = ' ';
+}

diff --git a/usr/src/libF77/s_cmp.c b/usr/src/libF77/s_cmp.c
new file mode 100644 (file)
index 0000000..5110524
--- /dev/null
+++ b/usr/src/libF77/s_cmp.c
@@ -0,0 +1,32 @@
+int s_cmp(a, b, la, lb)        /* compare two strings */
+char *a, *b;
+long int la, lb;
+{
+char *aend, *bend;
+aend = a + la;
+
+if(la <= lb)
+       {
+       while(a < aend)
+               if(*a != *b)
+                       return( *a - *b );
+               else
+                       { ++a; ++b; }
+
+       }
+
+else
+       {
+       bend = b + lb;
+       while(b < bend)
+               if(*a == *b)
+                       { ++a; ++b; }
+               else
+                       return( *a - *b );
+       while(a < aend)
+               if(*a != ' ')
+                       return(*a - ' ');
+               else    ++a;
+       }
+return(0);
+}

diff --git a/usr/src/libF77/s_copy.c b/usr/src/libF77/s_copy.c
new file mode 100644 (file)
index 0000000..e36485c
--- /dev/null
+++ b/usr/src/libF77/s_copy.c
@@ -0,0 +1,21 @@
+s_copy(a, b, la, lb)   /* assign strings:  a = b */
+char *a, *b;
+long int la, lb;
+{
+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++ = ' ';
+       }
+}

diff --git a/usr/src/libF77/s_stop.c b/usr/src/libF77/s_stop.c
new file mode 100644 (file)
index 0000000..cd88ea2
--- /dev/null
+++ b/usr/src/libF77/s_stop.c
@@ -0,0 +1,18 @@
+#include <stdio.h>
+
+s_stop(s, n)
+char *s;
+long int n;
+{
+int i;
+
+if(n > 0)
+       {
+       fprintf(stderr, "STOP ");
+       for(i = 0; i<n ; ++i)
+               putc(*s++, stderr);
+       fprintf(stderr, " statement executed\n");
+       }
+f_exit();
+exit(0);
+}

diff --git a/usr/src/libF77/signal_.c b/usr/src/libF77/signal_.c
new file mode 100644 (file)
index 0000000..422e019
--- /dev/null
+++ b/usr/src/libF77/signal_.c
@@ -0,0 +1,9 @@
+signal_(sigp, procp)
+int *sigp, (**procp)();
+{
+int sig, proc;
+sig = *sigp;
+proc = *procp;
+
+return( signal(sig, proc) );
+}

diff --git a/usr/src/libF77/sinh.c b/usr/src/libF77/sinh.c
new file mode 100644 (file)
index 0000000..878a760
--- /dev/null
+++ b/usr/src/libF77/sinh.c
@@ -0,0 +1,71 @@
+/*
+       sinh(arg) returns the hyperbolic sign of its floating-
+       point argument.
+
+       The exponential function is called for arguments
+       greater in magnitude than 0.5.
+       The result overflows and 'huge' is returned for
+       arguments greater than somewhat.
+
+       A series is used for arguments smaller in magnitude than 0.5.
+       The coeffieients are #2029 from Hart & Cheney. (20.36D)
+
+       cosh(arg) is computed from the exponential function for
+       all arguments.
+*/
+
+double exp();
+
+static double p0 -0.6307673640497716991184787251e+6;
+static double p1 -0.8991272022039509355398013511e+5;
+static double p2 -0.2894211355989563807284660366e+4;
+static double p3 -0.2630563213397497062819489e+2;
+static double q0 -0.6307673640497716991212077277e+6;
+static double q1  0.1521517378790019070696485176e+5;
+static double q2 -0.173678953558233699533450911e+3;
+static double q3  1.0;
+
+double
+sinh(arg) double arg; {
+
+       double sign, temp, argsq;
+
+       sign = 1;
+       if(arg < 0){
+               arg = - arg;
+               sign = -1;
+       }
+
+       if(arg > 21.){
+               temp = exp(arg)/2;
+               return(sign*temp);
+       }
+
+       if(arg > 0.5) {
+               temp = (exp(arg) - exp(-arg))/2;
+               return(sign*temp);
+       }
+
+       argsq = arg*arg;
+       temp = (((p3*argsq+p2)*argsq+p1)*argsq+p0)*arg;
+       temp = temp/(((q3*argsq+q2)*argsq+q1)*argsq+q0);
+       return(sign*temp);
+
+}
+
+double
+cosh(arg) double arg; {
+
+       double temp;
+
+       if(arg < 0)
+               arg = - arg;
+
+       if(arg > 21.){
+               temp = exp(arg)/2;
+               return(temp);
+       }
+
+       temp = (exp(arg) + exp(-arg))/2;
+       return(temp);
+}

diff --git a/usr/src/libF77/tanh.c b/usr/src/libF77/tanh.c
new file mode 100644 (file)
index 0000000..9a9ac93
--- /dev/null
+++ b/usr/src/libF77/tanh.c
@@ -0,0 +1,27 @@
+/*
+       tanh(arg) computes the hyperbolic tangent of its floating
+       point argument.
+
+       sinh and cosh are called except for large arguments, which
+       would cause overflow improperly.
+*/
+
+double sinh(), cosh();
+
+double
+tanh(arg) double arg; {
+
+       double sign;
+
+       sign = 1.;
+       if(arg < 0.){
+               arg = -arg;
+               sign = -1.;
+       }
+
+       if(arg > 21.){
+               return(sign);
+       }
+
+       return(sign*sinh(arg)/cosh(arg));
+}

diff --git a/usr/src/libF77/z_abs.c b/usr/src/libF77/z_abs.c
new file mode 100644 (file)
index 0000000..09a7955
--- /dev/null
+++ b/usr/src/libF77/z_abs.c
@@ -0,0 +1,9 @@
+#include "complex"
+
+double z_abs(z)
+dcomplex *z;
+{
+double cabs();
+
+return( cabs( z->dreal, z->dimag ) );
+}

diff --git a/usr/src/libF77/z_cos.c b/usr/src/libF77/z_cos.c
new file mode 100644 (file)
index 0000000..51b9c7a
--- /dev/null
+++ b/usr/src/libF77/z_cos.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+z_cos(r, z)
+dcomplex *r, *z;
+{
+double sin(), cos(), sinh(), cosh();
+
+r->dreal = cos(z->dreal) * cosh(z->dimag);
+r->dimag = - sin(z->dreal) * sinh(z->dimag);
+}

diff --git a/usr/src/libF77/z_div.c b/usr/src/libF77/z_div.c
new file mode 100644 (file)
index 0000000..5028f8c
--- /dev/null
+++ b/usr/src/libF77/z_div.c
@@ -0,0 +1,31 @@
+struct dcomplex { double dreal, dimag; };
+
+z_div(c, a, b)
+struct dcomplex *a, *b, *c;
+{
+double ratio, den;
+double abr, abi;
+
+if( (abr = b->dreal) < 0.)
+       abr = - abr;
+if( (abi = b->dimag) < 0.)
+       abi = - abi;
+if( abr <= abi )
+       {
+       if(abi == 0)
+               abort(); /* fatal("complex division by zero"); */
+       ratio = b->dreal / b->dimag ;
+       den = b->dimag * (1 + ratio*ratio);
+       c->dreal = (a->dreal*ratio + a->dimag) / den;
+       c->dimag = (a->dimag*ratio - a->dreal) / den;
+       }
+
+else
+       {
+       ratio = b->dimag / b->dreal ;
+       den = b->dreal * (1 + ratio*ratio);
+       c->dreal = (a->dreal + a->dimag*ratio) / den;
+       c->dimag = (a->dimag - a->dreal*ratio) / den;
+       }
+
+}

diff --git a/usr/src/libF77/z_exp.c b/usr/src/libF77/z_exp.c
new file mode 100644 (file)
index 0000000..beaec1d
--- /dev/null
+++ b/usr/src/libF77/z_exp.c
@@ -0,0 +1,12 @@
+#include "complex"
+
+z_exp(r, z)
+dcomplex *r, *z;
+{
+double expx;
+double exp(), cos(), sin();
+
+expx = exp(z->dreal);
+r->dreal = expx * cos(z->dimag);
+r->dimag = expx * sin(z->dimag);
+}

diff --git a/usr/src/libF77/z_log.c b/usr/src/libF77/z_log.c
new file mode 100644 (file)
index 0000000..1d80359
--- /dev/null
+++ b/usr/src/libF77/z_log.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+z_log(r, z)
+dcomplex *r, *z;
+{
+double log(), cabs(), atan2();
+
+r->dimag = atan2(z->dimag, z->dreal);
+r->dreal = log( cabs( z->dreal, z->dimag ) );
+}

diff --git a/usr/src/libF77/z_sin.c b/usr/src/libF77/z_sin.c
new file mode 100644 (file)
index 0000000..4aa89c9
--- /dev/null
+++ b/usr/src/libF77/z_sin.c
@@ -0,0 +1,10 @@
+#include "complex"
+
+z_sin(r, z)
+dcomplex *r, *z;
+{
+double sin(), cos(), sinh(), cosh();
+
+r->dreal = sin(z->dreal) * cosh(z->dimag);
+r->dimag = cos(z->dreal) * sinh(z->dimag);
+}

diff --git a/usr/src/libF77/z_sqrt.c b/usr/src/libF77/z_sqrt.c
new file mode 100644 (file)
index 0000000..2a18933
--- /dev/null
+++ b/usr/src/libF77/z_sqrt.c
@@ -0,0 +1,22 @@
+#include "complex"
+
+z_sqrt(r, z)
+dcomplex *r, *z;
+{
+double mag, sqrt(), cabs();
+
+if( (mag = cabs(z->dreal, z->dimag)) == 0.)
+       r->dreal = r->dimag = 0.;
+else if(z->dreal > 0)
+       {
+       r->dreal = sqrt(0.5 * (mag + z->dreal) );
+       r->dimag = z->dimag / r->dreal / 2;
+       }
+else
+       {
+       r->dimag = sqrt(0.5 * (mag - z->dreal) );
+       if(z->dimag < 0)
+               z->dimag = - z->dimag;
+       r->dreal = z->dimag / r->dimag / 2;
+       }
+}