diff options
Diffstat (limited to 'unix/portkit/d1mach.f.ieee')
| -rw-r--r-- | unix/portkit/d1mach.f.ieee | 273 |
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 |