2019-03-19 16:42:47 +02:00
|
|
|
INTEGER FUNCTION I1MACH(I)
|
2019-03-20 20:52:10 +02:00
|
|
|
INTEGER I
|
|
|
|
|
C
|
|
|
|
|
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 I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT.
|
|
|
|
|
C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT.
|
|
|
|
|
C INTEGERS HAVE FORM SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
|
|
|
|
|
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 FLOATS HAVE FORM SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
|
|
|
|
|
C WHERE EMIN .LE. E .LE. EMAX.
|
|
|
|
|
C I1MACH(10) = B, THE BASE.
|
|
|
|
|
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 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
|
|
|
|
|
INTEGER IMACH(16), OUTPUT, SC, SMALL(2)
|
|
|
|
|
SAVE IMACH, SC
|
|
|
|
|
REAL RMACH
|
|
|
|
|
EQUIVALENCE (IMACH(4),OUTPUT), (RMACH,SMALL(1))
|
|
|
|
|
INTEGER I3, J, K, T3E(3)
|
|
|
|
|
DATA T3E(1) / 9777664 /
|
|
|
|
|
DATA T3E(2) / 5323660 /
|
|
|
|
|
DATA T3E(3) / 46980 /
|
|
|
|
|
C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES,
|
|
|
|
|
C INCLUDING AUTO-DOUBLE COMPILERS.
|
|
|
|
|
C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
|
|
|
|
|
C ON THE NEXT LINE
|
|
|
|
|
DATA SC/0/
|
|
|
|
|
C AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
|
|
|
|
|
C CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
|
|
|
|
|
C mail netlib@research.bell-labs.com
|
|
|
|
|
C send old1mach from blas
|
|
|
|
|
C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
|
|
|
|
|
C
|
|
|
|
|
C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
|
|
|
|
|
C
|
|
|
|
|
C DATA IMACH( 1) / 5 /
|
|
|
|
|
C DATA IMACH( 2) / 6 /
|
|
|
|
|
C DATA IMACH( 3) / 43 /
|
|
|
|
|
C DATA IMACH( 4) / 6 /
|
|
|
|
|
C DATA IMACH( 5) / 36 /
|
|
|
|
|
C DATA IMACH( 6) / 4 /
|
|
|
|
|
C DATA IMACH( 7) / 2 /
|
|
|
|
|
C DATA IMACH( 8) / 35 /
|
|
|
|
|
C DATA IMACH( 9) / O377777777777 /
|
|
|
|
|
C DATA IMACH(10) / 2 /
|
|
|
|
|
C DATA IMACH(11) / 27 /
|
|
|
|
|
C DATA IMACH(12) / -127 /
|
|
|
|
|
C DATA IMACH(13) / 127 /
|
|
|
|
|
C DATA IMACH(14) / 63 /
|
|
|
|
|
C DATA IMACH(15) / -127 /
|
|
|
|
|
C DATA IMACH(16) / 127 /, SC/987/
|
|
|
|
|
C
|
|
|
|
|
C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
|
2019-03-19 16:42:47 +02:00
|
|
|
C 32-BIT INTEGER ARITHMETIC.
|
|
|
|
|
C
|
2019-03-20 20:52:10 +02:00
|
|
|
C DATA IMACH( 1) / 5 /
|
|
|
|
|
C DATA IMACH( 2) / 6 /
|
|
|
|
|
C DATA IMACH( 3) / 7 /
|
|
|
|
|
C DATA IMACH( 4) / 6 /
|
|
|
|
|
C DATA IMACH( 5) / 32 /
|
|
|
|
|
C DATA IMACH( 6) / 4 /
|
|
|
|
|
C DATA IMACH( 7) / 2 /
|
|
|
|
|
C DATA IMACH( 8) / 31 /
|
|
|
|
|
C DATA IMACH( 9) / 2147483647 /
|
|
|
|
|
C DATA IMACH(10) / 2 /
|
|
|
|
|
C DATA IMACH(11) / 24 /
|
|
|
|
|
C DATA IMACH(12) / -127 /
|
|
|
|
|
C DATA IMACH(13) / 127 /
|
|
|
|
|
C DATA IMACH(14) / 56 /
|
|
|
|
|
C DATA IMACH(15) / -127 /
|
|
|
|
|
C DATA IMACH(16) / 127 /, SC/987/
|
|
|
|
|
C
|
|
|
|
|
C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
|
|
|
|
|
C
|
|
|
|
|
C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7
|
|
|
|
|
C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM.
|
|
|
|
|
C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1.
|
|
|
|
|
C
|
|
|
|
|
C DATA IMACH( 1) / 5 /
|
|
|
|
|
C DATA IMACH( 2) / 6 /
|
|
|
|
|
C DATA IMACH( 3) / 7 /
|
|
|
|
|
C DATA IMACH( 4) / 6 /
|
|
|
|
|
C DATA IMACH( 5) / 36 /
|
|
|
|
|
C DATA IMACH( 6) / 6 /
|
|
|
|
|
C DATA IMACH( 7) / 2 /
|
|
|
|
|
C DATA IMACH( 8) / 35 /
|
|
|
|
|
C DATA IMACH( 9) / O377777777777 /
|
|
|
|
|
C DATA IMACH(10) / 2 /
|
|
|
|
|
C DATA IMACH(11) / 27 /
|
|
|
|
|
C DATA IMACH(12) / -128 /
|
|
|
|
|
C DATA IMACH(13) / 127 /
|
|
|
|
|
C DATA IMACH(14) / 60 /
|
|
|
|
|
C DATA IMACH(15) /-1024 /
|
|
|
|
|
C DATA IMACH(16) / 1023 /, SC/987/
|
|
|
|
|
C
|
|
|
|
|
IF (SC .NE. 987) THEN
|
|
|
|
|
* *** CHECK FOR AUTODOUBLE ***
|
|
|
|
|
SMALL(2) = 0
|
|
|
|
|
RMACH = 1E13
|
|
|
|
|
IF (SMALL(2) .NE. 0) THEN
|
|
|
|
|
* *** AUTODOUBLED ***
|
|
|
|
|
IF ( (SMALL(1) .EQ. 1117925532
|
|
|
|
|
* .AND. SMALL(2) .EQ. -448790528)
|
|
|
|
|
* .OR. (SMALL(2) .EQ. 1117925532
|
|
|
|
|
* .AND. SMALL(1) .EQ. -448790528)) THEN
|
|
|
|
|
* *** IEEE ***
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(14) = 53
|
|
|
|
|
IMACH(15) = -1021
|
|
|
|
|
IMACH(16) = 1024
|
|
|
|
|
ELSE IF ( SMALL(1) .EQ. -2065213935
|
|
|
|
|
* .AND. SMALL(2) .EQ. 10752) THEN
|
|
|
|
|
* *** VAX WITH D_FLOATING ***
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(14) = 56
|
|
|
|
|
IMACH(15) = -127
|
|
|
|
|
IMACH(16) = 127
|
|
|
|
|
ELSE IF ( SMALL(1) .EQ. 1267827943
|
|
|
|
|
* .AND. SMALL(2) .EQ. 704643072) THEN
|
|
|
|
|
* *** IBM MAINFRAME ***
|
|
|
|
|
IMACH(10) = 16
|
|
|
|
|
IMACH(14) = 14
|
|
|
|
|
IMACH(15) = -64
|
|
|
|
|
IMACH(16) = 63
|
|
|
|
|
ELSE
|
|
|
|
|
WRITE(*,9010)
|
|
|
|
|
STOP 777
|
|
|
|
|
END IF
|
|
|
|
|
IMACH(11) = IMACH(14)
|
|
|
|
|
IMACH(12) = IMACH(15)
|
|
|
|
|
IMACH(13) = IMACH(16)
|
|
|
|
|
ELSE
|
|
|
|
|
RMACH = 1234567.
|
|
|
|
|
IF (SMALL(1) .EQ. 1234613304) THEN
|
|
|
|
|
* *** IEEE ***
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(11) = 24
|
|
|
|
|
IMACH(12) = -125
|
|
|
|
|
IMACH(13) = 128
|
|
|
|
|
IMACH(14) = 53
|
|
|
|
|
IMACH(15) = -1021
|
|
|
|
|
IMACH(16) = 1024
|
|
|
|
|
SC = 987
|
|
|
|
|
ELSE IF (SMALL(1) .EQ. -1271379306) THEN
|
|
|
|
|
* *** VAX ***
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(11) = 24
|
|
|
|
|
IMACH(12) = -127
|
|
|
|
|
IMACH(13) = 127
|
|
|
|
|
IMACH(14) = 56
|
|
|
|
|
IMACH(15) = -127
|
|
|
|
|
IMACH(16) = 127
|
|
|
|
|
SC = 987
|
|
|
|
|
ELSE IF (SMALL(1) .EQ. 1175639687) THEN
|
|
|
|
|
* *** IBM MAINFRAME ***
|
|
|
|
|
IMACH(10) = 16
|
|
|
|
|
IMACH(11) = 6
|
|
|
|
|
IMACH(12) = -64
|
|
|
|
|
IMACH(13) = 63
|
|
|
|
|
IMACH(14) = 14
|
|
|
|
|
IMACH(15) = -64
|
|
|
|
|
IMACH(16) = 63
|
|
|
|
|
SC = 987
|
|
|
|
|
ELSE IF (SMALL(1) .EQ. 1251390520) THEN
|
|
|
|
|
* *** CONVEX C-1 ***
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(11) = 24
|
|
|
|
|
IMACH(12) = -128
|
|
|
|
|
IMACH(13) = 127
|
|
|
|
|
IMACH(14) = 53
|
|
|
|
|
IMACH(15) = -1024
|
|
|
|
|
IMACH(16) = 1023
|
|
|
|
|
ELSE
|
|
|
|
|
DO 10 I3 = 1, 3
|
|
|
|
|
J = SMALL(1) / 10000000
|
|
|
|
|
K = SMALL(1) - 10000000*J
|
|
|
|
|
IF (K .NE. T3E(I3)) GO TO 20
|
|
|
|
|
SMALL(1) = J
|
|
|
|
|
10 CONTINUE
|
|
|
|
|
* *** CRAY T3E ***
|
|
|
|
|
IMACH( 1) = 5
|
|
|
|
|
IMACH( 2) = 6
|
|
|
|
|
IMACH( 3) = 0
|
|
|
|
|
IMACH( 4) = 0
|
|
|
|
|
IMACH( 5) = 64
|
|
|
|
|
IMACH( 6) = 8
|
|
|
|
|
IMACH( 7) = 2
|
|
|
|
|
IMACH( 8) = 63
|
|
|
|
|
CALL I1MCR1(IMACH(9), K, 32767, 16777215, 16777215)
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(11) = 53
|
|
|
|
|
IMACH(12) = -1021
|
|
|
|
|
IMACH(13) = 1024
|
|
|
|
|
IMACH(14) = 53
|
|
|
|
|
IMACH(15) = -1021
|
|
|
|
|
IMACH(16) = 1024
|
|
|
|
|
GO TO 35
|
|
|
|
|
20 CALL I1MCR1(J, K, 16405, 9876536, 0)
|
|
|
|
|
IF (SMALL(1) .NE. J) THEN
|
|
|
|
|
WRITE(*,9020)
|
|
|
|
|
STOP 777
|
|
|
|
|
END IF
|
|
|
|
|
* *** CRAY 1, XMP, 2, AND 3 ***
|
|
|
|
|
IMACH(1) = 5
|
|
|
|
|
IMACH(2) = 6
|
|
|
|
|
IMACH(3) = 102
|
|
|
|
|
IMACH(4) = 6
|
|
|
|
|
IMACH(5) = 46
|
|
|
|
|
IMACH(6) = 8
|
|
|
|
|
IMACH(7) = 2
|
|
|
|
|
IMACH(8) = 45
|
|
|
|
|
CALL I1MCR1(IMACH(9), K, 0, 4194303, 16777215)
|
|
|
|
|
IMACH(10) = 2
|
|
|
|
|
IMACH(11) = 47
|
|
|
|
|
IMACH(12) = -8188
|
|
|
|
|
IMACH(13) = 8189
|
|
|
|
|
IMACH(14) = 94
|
|
|
|
|
IMACH(15) = -8141
|
|
|
|
|
IMACH(16) = 8189
|
|
|
|
|
GO TO 35
|
|
|
|
|
END IF
|
|
|
|
|
END IF
|
|
|
|
|
IMACH( 1) = 5
|
|
|
|
|
IMACH( 2) = 6
|
|
|
|
|
IMACH( 3) = 7
|
|
|
|
|
IMACH( 4) = 6
|
|
|
|
|
IMACH( 5) = 32
|
|
|
|
|
IMACH( 6) = 4
|
|
|
|
|
IMACH( 7) = 2
|
|
|
|
|
IMACH( 8) = 31
|
|
|
|
|
IMACH( 9) = 2147483647
|
|
|
|
|
35 SC = 987
|
|
|
|
|
END IF
|
|
|
|
|
9010 FORMAT(/' Adjust autodoubled I1MACH by uncommenting data'/
|
|
|
|
|
* ' statements appropriate for your machine and setting'/
|
|
|
|
|
* ' IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.')
|
|
|
|
|
9020 FORMAT(/' Adjust I1MACH by uncommenting data statements'/
|
|
|
|
|
* ' appropriate for your machine.')
|
|
|
|
|
IF (I .LT. 1 .OR. I .GT. 16) GO TO 40
|
2019-03-19 16:42:47 +02:00
|
|
|
I1MACH = IMACH(I)
|
|
|
|
|
RETURN
|
2019-03-20 20:52:10 +02:00
|
|
|
40 WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.'
|
2019-03-19 16:42:47 +02:00
|
|
|
STOP
|
2019-03-20 20:52:10 +02:00
|
|
|
* /* C source for I1MACH -- remove the * in column 1 */
|
|
|
|
|
* /* Note that some values may need changing. */
|
|
|
|
|
*#include <stdio.h>
|
|
|
|
|
*#include <float.h>
|
|
|
|
|
*#include <limits.h>
|
|
|
|
|
*#include <math.h>
|
|
|
|
|
*
|
|
|
|
|
*long i1mach_(long *i)
|
|
|
|
|
*{
|
|
|
|
|
* switch(*i){
|
|
|
|
|
* case 1: return 5; /* standard input */
|
|
|
|
|
* case 2: return 6; /* standard output */
|
|
|
|
|
* case 3: return 7; /* standard punch */
|
|
|
|
|
* case 4: return 0; /* standard error */
|
|
|
|
|
* case 5: return 32; /* bits per integer */
|
|
|
|
|
* case 6: return sizeof(int);
|
|
|
|
|
* case 7: return 2; /* base for integers */
|
|
|
|
|
* case 8: return 31; /* digits of integer base */
|
|
|
|
|
* case 9: return LONG_MAX;
|
|
|
|
|
* case 10: return FLT_RADIX;
|
|
|
|
|
* case 11: return FLT_MANT_DIG;
|
|
|
|
|
* case 12: return FLT_MIN_EXP;
|
|
|
|
|
* case 13: return FLT_MAX_EXP;
|
|
|
|
|
* case 14: return DBL_MANT_DIG;
|
|
|
|
|
* case 15: return DBL_MIN_EXP;
|
|
|
|
|
* case 16: return DBL_MAX_EXP;
|
|
|
|
|
* }
|
|
|
|
|
* fprintf(stderr, "invalid argument: i1mach(%ld)\n", *i);
|
|
|
|
|
* exit(1);return 0; /* some compilers demand return values */
|
|
|
|
|
*}
|
|
|
|
|
END
|
|
|
|
|
SUBROUTINE I1MCR1(A, A1, B, C, D)
|
|
|
|
|
**** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
|
|
|
|
|
INTEGER A, A1, B, C, D
|
|
|
|
|
A1 = 16777216*B + C
|
|
|
|
|
A = 16777216*A1 + D
|
2019-03-19 16:42:47 +02:00
|
|
|
END
|
