--- /dev/null
+*DECK I1MACH
+ INTEGER FUNCTION I1MACH (I)
+c----------------------------------------------------------------------
+c
+c this is not quit the original one from slatec
+c unit numbers for input/output/error are provided by calls to routines
+c from istdio.f change them there if needed!!!
+c
+c the other constants are not currently used by TISEAN and not checked
+c for any particular platform
+c
+c----------------------------------------------------------------------
+C***BEGIN PROLOGUE I1MACH
+C***PURPOSE Return integer machine dependent constants.
+C***LIBRARY SLATEC
+C***CATEGORY R1
+C***TYPE INTEGER (I1MACH-I)
+C***KEYWORDS MACHINE CONSTANTS
+C***AUTHOR Fox, P. A., (Bell Labs)
+C Hall, A. D., (Bell Labs)
+C Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C I1MACH can be used to obtain machine-dependent parameters for the
+C local machine environment. It is a function subprogram with one
+C (input) argument and can be referenced as follows:
+C
+C K = I1MACH(I)
+C
+C where I=1,...,16. The (output) value of K above is determined by
+C the (input) value of I. The results for various values of I are
+C discussed below.
+C
+C I/O unit numbers:
+C I1MACH( 1) = the standard input unit.
+C I1MACH( 2) = the standard output unit.
+C I1MACH( 3) = the standard punch unit.
+C I1MACH( 4) = the standard error message unit.
+C
+C Words:
+C I1MACH( 5) = the number of bits per integer storage unit.
+C I1MACH( 6) = the number of characters per integer storage unit.
+C
+C Integers:
+C assume integers are represented in the S-digit, base-A form
+C
+C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
+C
+C where 0 .LE. X(I) .LT. A for I=0,...,S-1.
+C I1MACH( 7) = A, the base.
+C I1MACH( 8) = S, the number of base-A digits.
+C I1MACH( 9) = A**S - 1, the largest magnitude.
+C
+C Floating-Point Numbers:
+C Assume floating-point numbers are represented in the T-digit,
+C base-B form
+C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C where 0 .LE. X(I) .LT. B for I=1,...,T,
+C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
+C I1MACH(10) = B, the base.
+C
+C Single-Precision:
+C I1MACH(11) = T, the number of base-B digits.
+C I1MACH(12) = EMIN, the smallest exponent E.
+C I1MACH(13) = EMAX, the largest exponent E.
+C
+C Double-Precision:
+C I1MACH(14) = T, the number of base-B digits.
+C I1MACH(15) = EMIN, the smallest exponent E.
+C I1MACH(16) = EMAX, the largest exponent E.
+C
+C To alter this function for a particular environment, the desired
+C set of DATA statements should be activated by removing the C from
+C column 1. Also, the values of I1MACH(1) - I1MACH(4) should be
+C checked for consistency with the local operating system.
+C
+C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C a portable library, ACM Transactions on Mathematical
+C Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 750101 DATE WRITTEN
+C 891012 Added VAX G-floating constants. (WRB)
+C 891012 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900618 Added DEC RISC constants. (WRB)
+C 900723 Added IBM RS 6000 constants. (WRB)
+C 901009 Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16.
+C (RWC)
+C 910710 Added HP 730 constants. (SMR)
+C 911114 Added Convex IEEE constants. (WRB)
+C 920121 Added SUN -r8 compiler option constants. (WRB)
+C 920229 Added Touchstone Delta i860 constants. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920625 Added Convex -p8 and -pd8 compiler option constants.
+C (BKS, WRB)
+C 930201 Added DEC Alpha and SGI constants. (RWC and WRB)
+C 930618 Corrected I1MACH(5) for Convex -p8 and -pd8 compiler
+C options. (DWL, RWC and WRB).
+C***END PROLOGUE I1MACH
+C
+ INTEGER IMACH(16),OUTPUT
+ SAVE IMACH
+ EQUIVALENCE (IMACH(4),OUTPUT)
+
+ DATA IMACH( 1) / 5 /
+ DATA IMACH( 2) / 6 /
+ DATA IMACH( 3) / 0 /
+ DATA IMACH( 4) / 0 /
+ DATA IMACH( 5) / 32 /
+ DATA IMACH( 6) / 4 /
+ DATA IMACH( 7) / 2 /
+ DATA IMACH( 8) / 31 /
+ DATA IMACH( 9) / 2147483647 /
+ DATA IMACH(10) / 2 /
+ DATA IMACH(11) / 24 /
+ DATA IMACH(12) / -125 /
+ DATA IMACH(13) / 127 /
+ DATA IMACH(14) / 53 /
+ DATA IMACH(15) / -1021 /
+ DATA IMACH(16) / 1023 /
+
+C***FIRST EXECUTABLE STATEMENT I1MACH
+ IMACH(1)=ISTDIN()
+ IMACH(2)=ISTDOUT()
+ IMACH(3)=ISTDERR()
+ IMACH(4)=ISTDERR()
+
+ IF (I .LT. 1 .OR. I .GT. 16) GO TO 10
+C
+ I1MACH = IMACH(I)
+ RETURN
+C
+ 10 CONTINUE
+ WRITE (UNIT = OUTPUT, FMT = 9000)
+ 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS')
+C
+C CALL FDUMP
+C
+ STOP
+ END
git://source.jalview.org / jabaws.git / blobdiff