Initial commit

1 files changed, 273 insertions, 0 deletions

diff --git a/unix/portkit/d1mach.f.ieee b/unix/portkit/d1mach.f.ieee
new file mode 100644
index 00000000..22bc2512
--- /dev/null
+++ b/unix/portkit/d1mach.f.ieee
@@ -0,0 +1,273 @@
+c
+c----------------------------------------------------------------------
+c  function:  d1mach
+c  this routine is from the port mathematical subroutine library
+c  it is described in the bell laboratories computing science
+c  technical report #47 by p.a. fox, a.d. hall and n.l. schryer
+c  a modification to the "i out of bounds" error message
+c  has been made by c. a. mcgonegal - april, 1978
+c----------------------------------------------------------------------
+c
+      double precision function d1mach(i)
+c
+c  double-precision machine constants
+c
+c  d1mach( 1) = b**(emin-1), the smallest positive magnitude.
+c
+c  d1mach( 2) = b**emax*(1 - b**(-t)), the largest magnitude.
+c
+c  d1mach( 3) = b**(-t), the smallest relative spacing.
+c
+c  d1mach( 4) = b**(1-t), the largest relative spacing.
+c
+c  d1mach( 5) = log10(b)
+c
+c  to alter this function for a particular environment,
+c  the desired set of data statements should be activated by
+c  removing the c from column 1.
+c
+c  where possible, octal or hexadecimal constants have been used
+c  to specify the constants exactly which has in some cases
+c  required the use of equivalent integer arrays.
+c
+      integer small(4)
+      integer large(4)
+      integer right(4)
+      integer diver(4)
+      integer log10(4)
+c
+      double precision dmach(5)
+c
+      equivalence (dmach(1),small(1))
+      equivalence (dmach(2),large(1))
+      equivalence (dmach(3),right(1))
+      equivalence (dmach(4),diver(1))
+      equivalence (dmach(5),log10(1))
+c
+c     machine constants for the burroughs 1700 system.
+c
+c     data small(1) / zc00800000 /
+c     data small(2) / z000000000 /
+c
+c     data large(1) / zdffffffff /
+c     data large(2) / zfffffffff /
+c
+c     data right(1) / zcc5800000 /
+c     data right(2) / z000000000 /
+c
+c     data diver(1) / zcc6800000 /
+c     data diver(2) / z000000000 /
+c
+c     data log10(1) / zd00e730e7 /
+c     data log10(2) / zc77800dc0 /
+c
+c     machine constants for the burroughs 5700 system.
+c
+c     data small(1) / o1771000000000000 /
+c     data small(2) / o0000000000000000 /
+c
+c     data large(1) / o0777777777777777 /
+c     data large(2) / o0007777777777777 /
+c
+c     data right(1) / o1461000000000000 /
+c     data right(2) / o0000000000000000 /
+c
+c     data diver(1) / o1451000000000000 /
+c     data diver(2) / o0000000000000000 /
+c
+c     data log10(1) / o1157163034761674 /
+c     data log10(2) / o0006677466732724 /
+c
+c     machine constants for the burroughs 6700/7700 systems.
+c
+c     data small(1) / o1771000000000000 /
+c     data small(2) / o7770000000000000 /
+c
+c     data large(1) / o0777777777777777 /
+c     data large(2) / o7777777777777777 /
+c
+c     data right(1) / o1461000000000000 /
+c     data right(2) / o0000000000000000 /
+c
+c     data diver(1) / o1451000000000000 /
+c     data diver(2) / o0000000000000000 /
+c
+c     data log10(1) / o1157163034761674 /
+c     data log10(2) / o0006677466732724 /
+c
+c     machine constants for the cdc 6000/7000 series.
+c
+c     data small(1) / 00604000000000000000b /
+c     data small(2) / 00000000000000000000b /
+c
+c     data large(1) / 37767777777777777777b /
+c     data large(2) / 37167777777777777777b /
+c
+c     data right(1) / 15604000000000000000b /
+c     data right(2) / 15000000000000000000b /
+c
+c     data diver(1) / 15614000000000000000b /
+c     data diver(2) / 15010000000000000000b /
+c
+c     data log10(1) / 17164642023241175717b /
+c     data log10(2) / 16367571421742254654b /
+c
+c     machine constants for the cray 1
+c
+c     data small(1) / 200004000000000000000b /
+c     data small(2) / 000000000000000000000b /
+c
+c     data large(1) / 577767777777777777777b /
+c     data large(2) / 000007777777777777776b /
+c
+c     data right(1) / 376424000000000000000b /
+c     data right(2) / 000000000000000000000b /
+c
+c     data diver(1) / 376434000000000000000b /
+c     data diver(2) / 000000000000000000000b /
+c
+c     data log10(1) / 377774642023241175717b /
+c     data log10(2) / 000007571421742254654b /
+c
+c     machine constants for the data general eclipse s/200
+c
+c     note - it may be appropriate to include the following card -
+c     static dmach(5)
+c
+c     data small/20k,3*0/,large/77777k,3*177777k/
+c     data right/31420k,3*0/,diver/32020k,3*0/
+c     data log10/40423k,42023k,50237k,74776k/
+c
+c     machine constants for the harris slash 6 and slash 7
+c
+c     data small(1),small(2) / '20000000, '00000201 /
+c     data large(1),large(2) / '37777777, '37777577 /
+c     data right(1),right(2) / '20000000, '00000333 /
+c     data diver(1),diver(2) / '20000000, '00000334 /
+c     data log10(1),log10(2) / '23210115, '10237777 /
+c
+c     machine constants for the honeywell 600/6000 series.
+c
+c     data small(1),small(2) / o402400000000, o000000000000 /
+c     data large(1),large(2) / o376777777777, o777777777777 /
+c     data right(1),right(2) / o604400000000, o000000000000 /
+c     data diver(1),diver(2) / o606400000000, o000000000000 /
+c     data log10(1),log10(2) / o776464202324, o117571775714 /
+c
+c     machine constants for the ibm 360/370 series,
+c     the xerox sigma 5/7/9 and the sel systems 85/86.
+c
+c     data small(1),small(2) / z00100000, z00000000 /
+c     data large(1),large(2) / z7fffffff, zffffffff /
+c     data right(1),right(2) / z33100000, z00000000 /
+c     data diver(1),diver(2) / z34100000, z00000000 /
+c     data log10(1),log10(2) / z41134413, z509f79ff /
+c
+c     machine constants for the pdp-10 (ka processor).
+c
+c     data small(1),small(2) / "033400000000, "000000000000 /
+c     data large(1),large(2) / "377777777777, "344777777777 /
+c     data right(1),right(2) / "113400000000, "000000000000 /
+c     data diver(1),diver(2) / "114400000000, "000000000000 /
+c     data log10(1),log10(2) / "177464202324, "144117571776 /
+c
+c     machine constants for the pdp-10 (ki processor).
+c
+c     data small(1),small(2) / "000400000000, "000000000000 /
+c     data large(1),large(2) / "377777777777, "377777777777 /
+c     data right(1),right(2) / "103400000000, "000000000000 /
+c     data diver(1),diver(2) / "104400000000, "000000000000 /
+c     data log10(1),log10(2) / "177464202324, "476747767461 /
+c
+c     machine constants for pdp-11 fortran's supporting
+c     32-bit integers (expressed in integer and octal).
+c
+      data small(1),small(2) /    8388608,           0 /
+      data large(1),large(2) / 2147483647,          -1 /
+      data right(1),right(2) /  612368384,           0 /
+      data diver(1),diver(2) /  620756992,           0 /
+      data log10(1),log10(2) / 1067065498, -2063872008 /
+c
+c     data small(1),small(2) / o00040000000, o00000000000 /
+c     data large(1),large(2) / o17777777777, o37777777777 /
+c     data right(1),right(2) / o04440000000, o00000000000 /
+c     data diver(1),diver(2) / o04500000000, o00000000000 /
+c     data log10(1),log10(2) / o07746420232, o20476747770 /
+c
+c     machine constants for pdp-11 fortran's supporting
+c     16-bit integers (expressed in integer and octal).
+c
+c     data small(1),small(2) /    128,      0 /
+c     data small(3),small(4) /      0,      0 /
+c
+c     data large(1),large(2) /  32767,     -1 /
+c     data large(3),large(4) /     -1,     -1 /
+c
+c     data right(1),right(2) /   9344,      0 /
+c     data right(3),right(4) /      0,      0 /
+c
+c     data diver(1),diver(2) /   9472,      0 /
+c     data diver(3),diver(4) /      0,      0 /
+c
+c     data log10(1),log10(2) /  16282,   8346 /
+c     data log10(3),log10(4) / -31493, -12296 /
+c
+c     data small(1),small(2) / o000200, o000000 /
+c     data small(3),small(4) / o000000, o000000 /
+c
+c     data large(1),large(2) / o077777, o177777 /
+c     data large(3),large(4) / o177777, o177777 /
+c
+c     data right(1),right(2) / o022200, o000000 /
+c     data right(3),right(4) / o000000, o000000 /
+c
+c     data diver(1),diver(2) / o022400, o000000 /
+c     data diver(3),diver(4) / o000000, o000000 /
+c
+c     data log10(1),log10(2) / o037632, o020232 /
+c     data log10(3),log10(4) / o102373, o147770 /
+c
+c     machine constants for the univac 1100 series.
+c
+c     data small(1),small(2) / o000040000000, o000000000000 /
+c     data large(1),large(2) / o377777777777, o777777777777 /
+c     data right(1),right(2) / o170540000000, o000000000000 /
+c     data diver(1),diver(2) / o170640000000, o000000000000 /
+c     data log10(1),log10(2) / o177746420232, o411757177572 /
+c
+c     machine constants for the vax-11 with
+c     fortran iv-plus compiler
+c
+c     data small(1),small(2) / z00000080, z00000000 /
+c     data large(1),large(2) / zffff7fff, zffffffff /
+c     data right(1),right(2) / z00002480, z00000000 /
+c     data diver(1),diver(2) / z00002500, z00000000 /
+c     data log10(1),log10(2) / z209a3f9a, zcffa84fb /
+c
+c     machine constants for IEEE floating point standard on 68000.  First
+c     expressed as hex constants, then as two word integer.
+c
+c     data small(1), small(2)	/ x'00080000', x'00000000' /
+c     data large(1), large(2)	/ x'7FDFFFFF', x'FFFFFFFF' /
+c     data right(1), right(2)  	/ x'3CA00000', x'00000000' /
+c     data diver(1), diver(2)	/ x'3CB00000', x'00000000' /
+c     data log10(1), log10(2)	/ x'3FE62E42', x'FEFA39EF' /
+c
+c     These IEEE values are written as integer constants below -
+c
+c     data small(1),small(2)	/524288,	0/
+c     data large(1),large(2)	/2145386495,   -1/
+c     data right(1),right(2)	/970,		0/
+c     data diver(1),diver(2)	/971,		0/
+c     data log10(1),log10(2)	/1072049730,	-17155601/
+c
+c     if (i .lt. 1  .or.  i .gt. 5) goto 100
+c
+      d1mach = dmach(i)
+      return
+c
+c100  iwunit = i1mach(4)
+c     write(iwunit, 99)
+c 99  format(24hd1mach - i out of bounds)
+c     stop
+      end