Mercurial > hg > octave-lyh
diff libcruft/misc/i1mach.f @ 12013:587d268cf64e release-3-2-x
implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Wed, 24 Jun 2009 08:13:16 +0200 |
| parents | db38fe433efd |
| children |
line wrap: on
line diff
--- a/libcruft/misc/i1mach.f +++ b/libcruft/misc/i1mach.f @@ -1,528 +1,27 @@ - INTEGER FUNCTION I1MACH(I) -C -C I/O UNIT NUMBERS. -C -C I1MACH( 1) = THE STANDARD INPUT UNIT. -C -C I1MACH( 2) = THE STANDARD OUTPUT UNIT. -C -C I1MACH( 3) = THE STANDARD PUNCH UNIT. -C -C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. -C -C WORDS. -C -C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. -C -C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT. -C FOR FORTRAN 77, THIS IS ALWAYS 1. FOR FORTRAN 66, -C CHARACTER STORAGE UNIT = INTEGER STORAGE UNIT. -C -C INTEGERS. -C -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 -C I1MACH( 7) = A, THE BASE. -C -C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. -C -C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. -C -C FLOATING-POINT NUMBERS. -C -C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, -C BASE-B FORM -C -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 -C I1MACH(10) = B, THE BASE. -C -C SINGLE-PRECISION -C -C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. -C -C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. -C -C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. -C -C DOUBLE-PRECISION -C -C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. -C -C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. -C -C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. -C -C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, -C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY -C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF -C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY -C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH -C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND -C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. -C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. -C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) -C -C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST -C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS -C FOR IMACH(1) - IMACH(4). -C - INTEGER IMACH(16),OUTPUT,SANITY -C - EQUIVALENCE (IMACH(4),OUTPUT) -C -C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T -C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T -C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). -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) / 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) / -125 / -C DATA IMACH(13) / 128 / -C DATA IMACH(14) / 53 / -C DATA IMACH(15) / -1021 / -C DATA IMACH(16) / 1024 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR AMDAHL MACHINES. -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) / 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) / 16 / -C DATA IMACH(11) / 6 / -C DATA IMACH(12) / -64 / -C DATA IMACH(13) / 63 / -C DATA IMACH(14) / 14 / -C DATA IMACH(15) / -64 / -C DATA IMACH(16) / 63 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. -C -C DATA IMACH( 1) / 7 / -C DATA IMACH( 2) / 2 / -C DATA IMACH( 3) / 2 / -C DATA IMACH( 4) / 2 / -C DATA IMACH( 5) / 36 / -C DATA IMACH( 6) / 4 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 33 / -C DATA IMACH( 9) / Z1FFFFFFFF / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 24 / -C DATA IMACH(12) / -256 / -C DATA IMACH(13) / 255 / -C DATA IMACH(14) / 60 / -C DATA IMACH(15) / -256 / -C DATA IMACH(16) / 255 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. -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) / 48 / -C DATA IMACH( 6) / 6 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 39 / -C DATA IMACH( 9) / O0007777777777777 / -C DATA IMACH(10) / 8 / -C DATA IMACH(11) / 13 / -C DATA IMACH(12) / -50 / -C DATA IMACH(13) / 76 / -C DATA IMACH(14) / 26 / -C DATA IMACH(15) / -50 / -C DATA IMACH(16) / 76 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. -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) / 48 / -C DATA IMACH( 6) / 6 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 39 / -C DATA IMACH( 9) / O0007777777777777 / -C DATA IMACH(10) / 8 / -C DATA IMACH(11) / 13 / -C DATA IMACH(12) / -50 / -C DATA IMACH(13) / 76 / -C DATA IMACH(14) / 26 / -C DATA IMACH(15) / -32754 / -C DATA IMACH(16) / 32780 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. -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) / 60 / -C DATA IMACH( 6) / 10 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 48 / -C DATA IMACH( 9) / 00007777777777777777B / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 47 / -C DATA IMACH(12) / -929 / -C DATA IMACH(13) / 1070 / -C DATA IMACH(14) / 94 / -C DATA IMACH(15) / -929 / -C DATA IMACH(16) / 1069 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. -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) / 60 / -C DATA IMACH( 6) / 10 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 48 / -C DATA IMACH( 9) / O"00007777777777777777" / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 47 / -C DATA IMACH(12) / -929 / -C DATA IMACH(13) / 1070 / -C DATA IMACH(14) / 94 / -C DATA IMACH(15) / -929 / -C DATA IMACH(16) / 1069 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR CONVEX C-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) / 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) / -128 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 53 / -C DATA IMACH(15) /-1024 / -C DATA IMACH(16) / 1023 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 102 / -C DATA IMACH( 4) / 6 / -C DATA IMACH( 5) / 64 / -C DATA IMACH( 6) / 8 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 63 / -C DATA IMACH( 9) / 777777777777777777777B / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 47 / -C DATA IMACH(12) / -8189 / -C DATA IMACH(13) / 8190 / -C DATA IMACH(14) / 94 / -C DATA IMACH(15) / -8099 / -C DATA IMACH(16) / 8190 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. -C -C DATA IMACH( 1) / 11 / -C DATA IMACH( 2) / 12 / -C DATA IMACH( 3) / 8 / -C DATA IMACH( 4) / 10 / -C DATA IMACH( 5) / 16 / -C DATA IMACH( 6) / 2 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 15 / -C DATA IMACH( 9) /32767 / -C DATA IMACH(10) / 16 / -C DATA IMACH(11) / 6 / -C DATA IMACH(12) / -64 / -C DATA IMACH(13) / 63 / -C DATA IMACH(14) / 14 / -C DATA IMACH(15) / -64 / -C DATA IMACH(16) / 63 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 0 / -C DATA IMACH( 4) / 6 / -C DATA IMACH( 5) / 24 / -C DATA IMACH( 6) / 3 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 23 / -C DATA IMACH( 9) / 8388607 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 23 / -C DATA IMACH(12) / -127 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 38 / -C DATA IMACH(15) / -127 / -C DATA IMACH(16) / 127 /, SANITY/987/ -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 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, -C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. -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) / 32 / -C DATA IMACH( 6) / 4 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 31 / -C DATA IMACH( 9) / Z7FFFFFFF / -C DATA IMACH(10) / 16 / -C DATA IMACH(11) / 6 / -C DATA IMACH(12) / -64 / -C DATA IMACH(13) / 63 / -C DATA IMACH(14) / 14 / -C DATA IMACH(15) / -64 / -C DATA IMACH(16) / 63 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE INTERDATA 8/32 -C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. -C -C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE -C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 6 / -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) / Z'7FFFFFFF' / -C DATA IMACH(10) / 16 / -C DATA IMACH(11) / 6 / -C DATA IMACH(12) / -64 / -C DATA IMACH(13) / 62 / -C DATA IMACH(14) / 14 / -C DATA IMACH(15) / -64 / -C DATA IMACH(16) / 62 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). -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) / 5 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 35 / -C DATA IMACH( 9) / "377777777777 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 27 / -C DATA IMACH(12) / -128 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 54 / -C DATA IMACH(15) / -101 / -C DATA IMACH(16) / 127 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). -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) / 5 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 35 / -C DATA IMACH( 9) / "377777777777 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 27 / -C DATA IMACH(12) / -128 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 62 / -C DATA IMACH(15) / -128 / -C DATA IMACH(16) / 127 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING -C 32-BIT INTEGER ARITHMETIC. -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) / 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 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING -C 16-BIT INTEGER ARITHMETIC. -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) / 16 / -C DATA IMACH( 6) / 2 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 15 / -C DATA IMACH( 9) / 32767 / -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 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS -C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, -C SUPPLIED BY IGOR BRAY. -C -C DATA IMACH( 1) / 1 / -C DATA IMACH( 2) / 1 / -C DATA IMACH( 3) / 2 / -C DATA IMACH( 4) / 1 / -C DATA IMACH( 5) / 32 / -C DATA IMACH( 6) / 4 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 31 / -C DATA IMACH( 9) / :17777777777 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 23 / -C DATA IMACH(12) / -127 / -C DATA IMACH(13) / +127 / -C DATA IMACH(14) / 47 / -C DATA IMACH(15) / -32895 / -C DATA IMACH(16) / +32637 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. -C -C DATA IMACH( 1) / 0 / -C DATA IMACH( 2) / 0 / -C DATA IMACH( 3) / 7 / -C DATA IMACH( 4) / 0 / -C DATA IMACH( 5) / 32 / -C DATA IMACH( 6) / 1 / -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) / -125 / -C DATA IMACH(13) / 128 / -C DATA IMACH(14) / 53 / -C DATA IMACH(15) / -1021 / -C DATA IMACH(16) / 1024 /, SANITY/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 /, SANITY/987/ -C -C MACHINE CONSTANTS FOR VAX. -C - DATA IMACH( 1) / 5 / - DATA IMACH( 2) / 6 / - DATA IMACH( 3) / 7 / - DATA IMACH( 4) / 6 / - 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) / -127 / - DATA IMACH(13) / 127 / - DATA IMACH(14) / 56 / - DATA IMACH(15) / -127 / - DATA IMACH(16) / 127 /, SANITY/987/ -C -C *** ISSUE STOP 777 IF ALL DATA STATEMENTS ARE COMMENTED... - IF (SANITY .NE. 987) STOP 777 - IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 -C - I1MACH = IMACH(I) -C/6S -C/7S - IF(I.EQ.6) I1MACH=1 -C/ - RETURN - 10 WRITE(OUTPUT,1999) I - 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) - CALL XSTOPX (' ') - I1MACH = 0 - END + integer function i1mach (i) + integer i, imach(16) + logical init + double precision dlamch + real slamch + external dlamch, slamch + save imach, init + data imach / 5, 6, 0, 6, 32, 4, 2, 31, 2147483647, + $ 2, 0, 0, 0, 0, 0, 0 / + data init /.false./ + if (.not. init) then + imach(11) = slamch ('n') + imach(12) = slamch ('m') + imach(13) = slamch ('l') + imach(14) = dlamch ('n') + imach(15) = dlamch ('m') + imach(16) = dlamch ('l') + init = .true. + endif + if (i .lt. 1 .or. i .gt. 16) goto 999 + i1mach = imach(i) + return + 999 write (*, 1999) i + 1999 format (' i1mach - i out of bounds', i10) + call xstopx (' ') + i1mach = 0 + end