← Back to branch summary

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

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

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