← Back to branch summary

~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to Lib/integrate/mach/i1mach.f

  • Committer: Bazaar Package Importer
  • Author(s): Daniel T. Chen (new)
  • Date: 2005-03-16 02:15:29 UTC
  • Revision ID: james.westby@ubuntu.com-20050316021529-xrjlowsejs0cijig
Tags: upstream-0.3.2
Import upstream version 0.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/integrate/mach/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