amos/i1mach.f

   1       INTEGER FUNCTION I1MACH(I)
   2       INTEGER I
   3 C
   4 C    I1MACH( 1) = THE STANDARD INPUT UNIT.
   5 C    I1MACH( 2) = THE STANDARD OUTPUT UNIT.
   6 C    I1MACH( 3) = THE STANDARD PUNCH UNIT.
   7 C    I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT.
   8 C    I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT.
   9 C    I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT.
  10 C    INTEGERS HAVE FORM SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
  11 C    I1MACH( 7) = A, THE BASE.
  12 C    I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS.
  13 C    I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE.
  14 C    FLOATS HAVE FORM  SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
  15 C               WHERE  EMIN .LE. E .LE. EMAX.
  16 C    I1MACH(10) = B, THE BASE.
  17 C  SINGLE-PRECISION
  18 C    I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS.
  19 C    I1MACH(12) = EMIN, THE SMALLEST EXPONENT E.
  20 C    I1MACH(13) = EMAX, THE LARGEST EXPONENT E.
  21 C  DOUBLE-PRECISION
  22 C    I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS.
  23 C    I1MACH(15) = EMIN, THE SMALLEST EXPONENT E.
  24 C    I1MACH(16) = EMAX, THE LARGEST EXPONENT E.
  25 C
  26       INTEGER IMACH(16), OUTPUT, SC, SMALL(2)
  27       SAVE IMACH, SC
  28       REAL RMACH
  29       EQUIVALENCE (IMACH(4),OUTPUT), (RMACH,SMALL(1))
  30       INTEGER I3, J, K, T3E(3)
  31       DATA T3E(1) / 9777664 /
  32       DATA T3E(2) / 5323660 /
  33       DATA T3E(3) / 46980 /
  34 C  THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES,
  35 C  INCLUDING AUTO-DOUBLE COMPILERS.
  36 C  TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
  37 C  ON THE NEXT LINE
  38       DATA SC/0/
  39 C  AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
  40 C  CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
  41 C          mail netlib@research.bell-labs.com
  42 C          send old1mach from blas
  43 C  PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
  44 C
  45 C     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
  46 C
  47 C      DATA IMACH( 1) /    5 /
  48 C      DATA IMACH( 2) /    6 /
  49 C      DATA IMACH( 3) /   43 /
  50 C      DATA IMACH( 4) /    6 /
  51 C      DATA IMACH( 5) /   36 /
  52 C      DATA IMACH( 6) /    4 /
  53 C      DATA IMACH( 7) /    2 /
  54 C      DATA IMACH( 8) /   35 /
  55 C      DATA IMACH( 9) / O377777777777 /
  56 C      DATA IMACH(10) /    2 /
  57 C      DATA IMACH(11) /   27 /
  58 C      DATA IMACH(12) / -127 /
  59 C      DATA IMACH(13) /  127 /
  60 C      DATA IMACH(14) /   63 /
  61 C      DATA IMACH(15) / -127 /
  62 C      DATA IMACH(16) /  127 /, SC/987/
  63 C
  64 C     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
  65 C     32-BIT INTEGER ARITHMETIC.
  66 C
  67 C      DATA IMACH( 1) /    5 /
  68 C      DATA IMACH( 2) /    6 /
  69 C      DATA IMACH( 3) /    7 /
  70 C      DATA IMACH( 4) /    6 /
  71 C      DATA IMACH( 5) /   32 /
  72 C      DATA IMACH( 6) /    4 /
  73 C      DATA IMACH( 7) /    2 /
  74 C      DATA IMACH( 8) /   31 /
  75 C      DATA IMACH( 9) / 2147483647 /
  76 C      DATA IMACH(10) /    2 /
  77 C      DATA IMACH(11) /   24 /
  78 C      DATA IMACH(12) / -127 /
  79 C      DATA IMACH(13) /  127 /
  80 C      DATA IMACH(14) /   56 /
  81 C      DATA IMACH(15) / -127 /
  82 C      DATA IMACH(16) /  127 /, SC/987/
  83 C
  84 C     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
  85 C
  86 C     NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7
  87 C     WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM.
  88 C     IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1.
  89 C
  90 C      DATA IMACH( 1) /    5 /
  91 C      DATA IMACH( 2) /    6 /
  92 C      DATA IMACH( 3) /    7 /
  93 C      DATA IMACH( 4) /    6 /
  94 C      DATA IMACH( 5) /   36 /
  95 C      DATA IMACH( 6) /    6 /
  96 C      DATA IMACH( 7) /    2 /
  97 C      DATA IMACH( 8) /   35 /
  98 C      DATA IMACH( 9) / O377777777777 /
  99 C      DATA IMACH(10) /    2 /
 100 C      DATA IMACH(11) /   27 /
 101 C      DATA IMACH(12) / -128 /
 102 C      DATA IMACH(13) /  127 /
 103 C      DATA IMACH(14) /   60 /
 104 C      DATA IMACH(15) /-1024 /
 105 C      DATA IMACH(16) / 1023 /, SC/987/
 106 C
 107       IF (SC .NE. 987) THEN
 108 *        *** CHECK FOR AUTODOUBLE ***
 109          SMALL(2) = 0
 110          RMACH = 1E13
 111          IF (SMALL(2) .NE. 0) THEN
 112 *           *** AUTODOUBLED ***
 113             IF (      (SMALL(1) .EQ. 1117925532
 114      *           .AND. SMALL(2) .EQ. -448790528)
 115      *       .OR.     (SMALL(2) .EQ. 1117925532
 116      *           .AND. SMALL(1) .EQ. -448790528)) THEN
 117 *               *** IEEE ***
 118                IMACH(10) = 2
 119                IMACH(14) = 53
 120                IMACH(15) = -1021
 121                IMACH(16) = 1024
 122             ELSE IF ( SMALL(1) .EQ. -2065213935
 123      *          .AND. SMALL(2) .EQ. 10752) THEN
 124 *               *** VAX WITH D_FLOATING ***
 125                IMACH(10) = 2
 126                IMACH(14) = 56
 127                IMACH(15) = -127
 128                IMACH(16) = 127
 129             ELSE IF ( SMALL(1) .EQ. 1267827943
 130      *          .AND. SMALL(2) .EQ. 704643072) THEN
 131 *               *** IBM MAINFRAME ***
 132                IMACH(10) = 16
 133                IMACH(14) = 14
 134                IMACH(15) = -64
 135                IMACH(16) = 63
 136             ELSE
 137                WRITE(*,9010)
 138                STOP 777
 139                END IF
 140             IMACH(11) = IMACH(14)
 141             IMACH(12) = IMACH(15)
 142             IMACH(13) = IMACH(16)
 143          ELSE
 144             RMACH = 1234567.
 145             IF (SMALL(1) .EQ. 1234613304) THEN
 146 *               *** IEEE ***
 147                IMACH(10) = 2
 148                IMACH(11) = 24
 149                IMACH(12) = -125
 150                IMACH(13) = 128
 151                IMACH(14) = 53
 152                IMACH(15) = -1021
 153                IMACH(16) = 1024
 154                SC = 987
 155             ELSE IF (SMALL(1) .EQ. -1271379306) THEN
 156 *               *** VAX ***
 157                IMACH(10) = 2
 158                IMACH(11) = 24
 159                IMACH(12) = -127
 160                IMACH(13) = 127
 161                IMACH(14) = 56
 162                IMACH(15) = -127
 163                IMACH(16) = 127
 164                SC = 987
 165             ELSE IF (SMALL(1) .EQ. 1175639687) THEN
 166 *               *** IBM MAINFRAME ***
 167                IMACH(10) = 16
 168                IMACH(11) = 6
 169                IMACH(12) = -64
 170                IMACH(13) = 63
 171                IMACH(14) = 14
 172                IMACH(15) = -64
 173                IMACH(16) = 63
 174                SC = 987
 175             ELSE IF (SMALL(1) .EQ. 1251390520) THEN
 176 *              *** CONVEX C-1 ***
 177                IMACH(10) = 2
 178                IMACH(11) = 24
 179                IMACH(12) = -128
 180                IMACH(13) = 127
 181                IMACH(14) = 53
 182                IMACH(15) = -1024
 183                IMACH(16) = 1023
 184             ELSE
 185                DO 10 I3 = 1, 3
 186                   J = SMALL(1) / 10000000
 187                   K = SMALL(1) - 10000000*J
 188                   IF (K .NE. T3E(I3)) GO TO 20
 189                   SMALL(1) = J
 190  10               CONTINUE
 191 *              *** CRAY T3E ***
 192                IMACH( 1) = 5
 193                IMACH( 2) = 6
 194                IMACH( 3) = 0
 195                IMACH( 4) = 0
 196                IMACH( 5) = 64
 197                IMACH( 6) = 8
 198                IMACH( 7) = 2
 199                IMACH( 8) = 63
 200                CALL I1MCR1(IMACH(9), K, 32767, 16777215, 16777215)
 201                IMACH(10) = 2
 202                IMACH(11) = 53
 203                IMACH(12) = -1021
 204                IMACH(13) = 1024
 205                IMACH(14) = 53
 206                IMACH(15) = -1021
 207                IMACH(16) = 1024
 208                GO TO 35
 209  20            CALL I1MCR1(J, K, 16405, 9876536, 0)
 210                IF (SMALL(1) .NE. J) THEN
 211                   WRITE(*,9020)
 212                   STOP 777
 213                   END IF
 214 *              *** CRAY 1, XMP, 2, AND 3 ***
 215                IMACH(1) = 5
 216                IMACH(2) = 6
 217                IMACH(3) = 102
 218                IMACH(4) = 6
 219                IMACH(5) = 46
 220                IMACH(6) = 8
 221                IMACH(7) = 2
 222                IMACH(8) = 45
 223                CALL I1MCR1(IMACH(9), K, 0, 4194303, 16777215)
 224                IMACH(10) = 2
 225                IMACH(11) = 47
 226                IMACH(12) = -8188
 227                IMACH(13) = 8189
 228                IMACH(14) = 94
 229                IMACH(15) = -8141
 230                IMACH(16) = 8189
 231                GO TO 35
 232                END IF
 233             END IF
 234          IMACH( 1) = 5
 235          IMACH( 2) = 6
 236          IMACH( 3) = 7
 237          IMACH( 4) = 6
 238          IMACH( 5) = 32
 239          IMACH( 6) = 4
 240          IMACH( 7) = 2
 241          IMACH( 8) = 31
 242          IMACH( 9) = 2147483647
 243  35      SC = 987
 244          END IF
 245  9010 FORMAT(/' Adjust autodoubled I1MACH by uncommenting data'/
 246      * ' statements appropriate for your machine and setting'/
 247      * ' IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.')
 248  9020 FORMAT(/' Adjust I1MACH by uncommenting data statements'/
 249      * ' appropriate for your machine.')
 250       IF (I .LT. 1  .OR.  I .GT. 16) GO TO 40
 251       I1MACH = IMACH(I)
 252       RETURN
 253  40   WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.'
 254       STOP
 255 * /* C source for I1MACH -- remove the * in column 1 */
 256 * /* Note that some values may need changing. */
 257 *#include <stdio.h>
 258 *#include <float.h>
 259 *#include <limits.h>
 260 *#include <math.h>
 261 *
 262 *long i1mach_(long *i)
 263 *{
 264 *       switch(*i){
 265 *         case 1:  return 5;    /* standard input */
 266 *         case 2:  return 6;    /* standard output */
 267 *         case 3:  return 7;    /* standard punch */
 268 *         case 4:  return 0;    /* standard error */
 269 *         case 5:  return 32;   /* bits per integer */
 270 *         case 6:  return sizeof(int);
 271 *         case 7:  return 2;    /* base for integers */
 272 *         case 8:  return 31;   /* digits of integer base */
 273 *         case 9:  return LONG_MAX;
 274 *         case 10: return FLT_RADIX;
 275 *         case 11: return FLT_MANT_DIG;
 276 *         case 12: return FLT_MIN_EXP;
 277 *         case 13: return FLT_MAX_EXP;
 278 *         case 14: return DBL_MANT_DIG;
 279 *         case 15: return DBL_MIN_EXP;
 280 *         case 16: return DBL_MAX_EXP;
 281 *         }
 282 *       fprintf(stderr, "invalid argument: i1mach(%ld)\n", *i);
 283 *       exit(1);return 0; /* some compilers demand return values */
 284 *}
 285       END
 286       SUBROUTINE I1MCR1(A, A1, B, C, D)
 287 **** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
 288       INTEGER A, A1, B, C, D
 289       A1 = 16777216*B + C
 290       A = 16777216*A1 + D
 291       END