From eafd1609a552f3e31c179b7c8401984280dc1d2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marek=20Ne=C4=8Dada?= Date: Wed, 20 Mar 2019 20:52:10 +0200 Subject: [PATCH] Using d1mach.f, i1mach.f copied from scipy/scipy/special/mach/. The complex Bessel functions are finally working. Former-commit-id: 6a1b896fc2cef938cb88bf8dbc6170f501ccf119 --- amos/d1mach.f | 612 +++++++++++---------------------- amos/i1mach.f | 932 +++++++++++++++----------------------------------- 2 files changed, 472 insertions(+), 1072 deletions(-) diff --git a/amos/d1mach.f b/amos/d1mach.f index 86f81d7..bda4529 100644 --- a/amos/d1mach.f +++ b/amos/d1mach.f @@ -1,427 +1,209 @@ -*DECK D1MACH DOUBLE PRECISION FUNCTION D1MACH(I) -C***BEGIN PROLOGUE D1MACH -C***DATE WRITTEN 750101 (YYMMDD) -C***REVISION DATE 890213 (YYMMDD) -C***CATEGORY NO. R1 -C***KEYWORDS LIBRARY=SLATEC,TYPE=DOUBLE PRECISION(R1MACH-S D1MACH-D), -C MACHINE CONSTANTS -C***AUTHOR FOX, P. A., (BELL LABS) -C HALL, A. D., (BELL LABS) -C SCHRYER, N. L., (BELL LABS) -C***PURPOSE Returns double precision machine dependent constants -C***DESCRIPTION + INTEGER I C -C D1MACH can be used to obtain machine-dependent parameters -C for the local machine environment. It is a function -C subprogram with one (input) argument, and can be called -C as follows, for example -C -C D = D1MACH(I) -C -C where I=1,...,5. The (output) value of D above is -C determined by the (input) value of I. The results for -C various values of I are discussed below. -C -C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude. -C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude. -C D1MACH( 3) = B**(-T), the smallest relative spacing. -C D1MACH( 4) = B**(1-T), the largest relative spacing. -C D1MACH( 5) = LOG10(B) -C -C Assume double precision 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, 0 .LT. X(1), and -C EMIN .LE. E .LE. EMAX. -C -C The values of B, T, EMIN and EMAX are provided in I1MACH as -C follows: -C I1MACH(10) = B, the base. -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 -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 D1MACH(1) - D1MACH(4) should be checked for consistency -C with the local operating system. -C -C***REFERENCES FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A -C PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL -C SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188. -C***ROUTINES CALLED XERROR -C***END PROLOGUE D1MACH -C - INTEGER SMALL(4) - INTEGER LARGE(4) - INTEGER RIGHT(4) - INTEGER DIVER(4) - INTEGER LOG10(4) +C DOUBLE-PRECISION MACHINE CONSTANTS +C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. +C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. +C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. +C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. +C D1MACH( 5) = LOG10(B) C + INTEGER SMALL(2) + INTEGER LARGE(2) + INTEGER RIGHT(2) + INTEGER DIVER(2) + INTEGER LOG10(2) + INTEGER SC, CRAY1(38), J + COMMON /D9MACH/ CRAY1 + SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC DOUBLE PRECISION DMACH(5) - SAVE DMACH -C EQUIVALENCE (DMACH(1),SMALL(1)) EQUIVALENCE (DMACH(2),LARGE(1)) EQUIVALENCE (DMACH(3),RIGHT(1)) EQUIVALENCE (DMACH(4),DIVER(1)) EQUIVALENCE (DMACH(5),LOG10(1)) -C -C MACHINE CONSTANTS FOR THE AMIGA -C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION -C -C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / -C -C MACHINE CONSTANTS FOR THE AMIGA -C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT -C -C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FDFFFFF', Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / -C -C MACHINE CONSTANTS FOR THE APOLLO -C -C DATA SMALL(1), SMALL(2) / 16#00100000, 16#00000000 / -C DATA LARGE(1), LARGE(2) / 16#7FFFFFFF, 16#FFFFFFFF / -C DATA RIGHT(1), RIGHT(2) / 16#3CA00000, 16#00000000 / -C DATA DIVER(1), DIVER(2) / 16#3CB00000, 16#00000000 / -C DATA LOG10(1), LOG10(2) / 16#3FD34413, 16#509F79FF / -C -C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM -C -C DATA SMALL(1) / ZC00800000 / -C DATA SMALL(2) / Z000000000 / -C DATA LARGE(1) / ZDFFFFFFFF / -C DATA LARGE(2) / ZFFFFFFFFF / -C DATA RIGHT(1) / ZCC5800000 / -C DATA RIGHT(2) / Z000000000 / -C DATA DIVER(1) / ZCC6800000 / -C DATA DIVER(2) / Z000000000 / -C DATA LOG10(1) / ZD00E730E7 / -C DATA LOG10(2) / ZC77800DC0 / -C -C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM -C -C DATA SMALL(1) / O1771000000000000 / -C DATA SMALL(2) / O0000000000000000 / -C DATA LARGE(1) / O0777777777777777 / -C DATA LARGE(2) / O0007777777777777 / -C DATA RIGHT(1) / O1461000000000000 / -C DATA RIGHT(2) / O0000000000000000 / -C DATA DIVER(1) / O1451000000000000 / -C DATA DIVER(2) / O0000000000000000 / -C DATA LOG10(1) / O1157163034761674 / -C DATA LOG10(2) / O0006677466732724 / -C -C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS -C -C DATA SMALL(1) / O1771000000000000 / -C DATA SMALL(2) / O7770000000000000 / -C DATA LARGE(1) / O0777777777777777 / -C DATA LARGE(2) / O7777777777777777 / -C DATA RIGHT(1) / O1461000000000000 / -C DATA RIGHT(2) / O0000000000000000 / -C DATA DIVER(1) / O1451000000000000 / -C DATA DIVER(2) / O0000000000000000 / -C DATA LOG10(1) / O1157163034761674 / -C DATA LOG10(2) / O0006677466732724 / -C -C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE -C -C DATA SMALL(1) / Z"3001800000000000" / -C DATA SMALL(2) / Z"3001000000000000" / -C DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" / -C DATA LARGE(2) / Z"4FFE000000000000" / -C DATA RIGHT(1) / Z"3FD2800000000000" / -C DATA RIGHT(2) / Z"3FD2000000000000" / -C DATA DIVER(1) / Z"3FD3800000000000" / -C DATA DIVER(2) / Z"3FD3000000000000" / -C DATA LOG10(1) / Z"3FFF9A209A84FBCF" / -C DATA LOG10(2) / Z"3FFFF7988F8959AC" / -C -C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES -C -C DATA SMALL(1) / 00564000000000000000B / -C DATA SMALL(2) / 00000000000000000000B / -C DATA LARGE(1) / 37757777777777777777B / -C DATA LARGE(2) / 37157777777777777777B / -C DATA RIGHT(1) / 15624000000000000000B / -C DATA RIGHT(2) / 00000000000000000000B / -C DATA DIVER(1) / 15634000000000000000B / -C DATA DIVER(2) / 00000000000000000000B / -C DATA LOG10(1) / 17164642023241175717B / -C DATA LOG10(2) / 16367571421742254654B / -C -C MACHINE CONSTANTS FOR THE CELERITY C1260 -C -C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / -C -C MACHINE CONSTANTS FOR THE CONVEX C-1 -C -C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X / -C DATA LARGE(1), LARGE(2) / '7FFFFFFF'X,'FFFFFFFF'X / -C DATA RIGHT(1), RIGHT(2) / '3CC00000'X,'00000000'X / -C DATA DIVER(1), DIVER(2) / '3CD00000'X,'00000000'X / -C DATA LOG10(1), LOG10(2) / '3FF34413'X,'509F79FF'X / -C -C MACHINE CONSTANTS FOR THE CRAY-1 -C -C DATA SMALL(1) / 201354000000000000000B / -C DATA SMALL(2) / 000000000000000000000B / -C DATA LARGE(1) / 577767777777777777777B / -C DATA LARGE(2) / 000007777777777777774B / -C DATA RIGHT(1) / 376434000000000000000B / -C DATA RIGHT(2) / 000000000000000000000B / -C DATA DIVER(1) / 376444000000000000000B / -C DATA DIVER(2) / 000000000000000000000B / -C DATA LOG10(1) / 377774642023241175717B / -C DATA LOG10(2) / 000007571421742254654B / -C -C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 -C -C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - -C STATIC DMACH(5) -C -C DATA SMALL / 20K, 3*0 / -C DATA LARGE / 77777K, 3*177777K / -C DATA RIGHT / 31420K, 3*0 / -C DATA DIVER / 32020K, 3*0 / -C DATA LOG10 / 40423K, 42023K, 50237K, 74776K / -C -C MACHINE CONSTANTS FOR THE ELXSI 6400 -C (ASSUMING REAL*8 IS THE DEFAULT DOUBLE PRECISION) -C -C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X / -C DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X / -C DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X / -C DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X / -C DATA LOG10(1), LOG10(2) / '3FD34413'X,'509F79FF'X / -C -C MACHINE CONSTANTS FOR THE HARRIS 220 -C -C DATA SMALL(1), SMALL(2) / '20000000, '00000201 / -C DATA LARGE(1), LARGE(2) / '37777777, '37777577 / -C DATA RIGHT(1), RIGHT(2) / '20000000, '00000333 / -C DATA DIVER(1), DIVER(2) / '20000000, '00000334 / -C DATA LOG10(1), LOG10(2) / '23210115, '10237777 / -C -C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES -C -C DATA SMALL(1), SMALL(2) / O402400000000, O000000000000 / -C DATA LARGE(1), LARGE(2) / O376777777777, O777777777777 / -C DATA RIGHT(1), RIGHT(2) / O604400000000, O000000000000 / -C DATA DIVER(1), DIVER(2) / O606400000000, O000000000000 / -C DATA LOG10(1), LOG10(2) / O776464202324, O117571775714 / -C -C MACHINE CONSTANTS FOR THE HP 2100 -C THREE WORD DOUBLE PRECISION OPTION WITH FTN4 -C -C DATA SMALL(1), SMALL(2), SMALL(3) / 40000B, 0, 1 / -C DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B / -C DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B, 0, 265B / -C DATA DIVER(1), DIVER(2), DIVER(3) / 40000B, 0, 276B / -C DATA LOG10(1), LOG10(2), LOG10(3) / 46420B, 46502B, 77777B / -C -C MACHINE CONSTANTS FOR THE HP 2100 -C FOUR WORD DOUBLE PRECISION OPTION WITH FTN4 -C -C DATA SMALL(1), SMALL(2) / 40000B, 0 / -C DATA SMALL(3), SMALL(4) / 0, 1 / -C DATA LARGE(1), LARGE(2) / 77777B, 177777B / -C DATA LARGE(3), LARGE(4) / 177777B, 177776B / -C DATA RIGHT(1), RIGHT(2) / 40000B, 0 / -C DATA RIGHT(3), RIGHT(4) / 0, 225B / -C DATA DIVER(1), DIVER(2) / 40000B, 0 / -C DATA DIVER(3), DIVER(4) / 0, 227B / -C DATA LOG10(1), LOG10(2) / 46420B, 46502B / -C DATA LOG10(3), LOG10(4) / 76747B, 176377B / -C -C MACHINE CONSTANTS FOR THE HP 9000 -C -C DATA SMALL(1), SMALL(2) / 00040000000B, 00000000000B / -C DATA LARGE(1), LARGE(2) / 17737777777B, 37777777777B / -C DATA RIGHT(1), RIGHT(2) / 07454000000B, 00000000000B / -C DATA DIVER(1), DIVER(2) / 07460000000B, 00000000000B / -C DATA LOG10(1), LOG10(2) / 07764642023B, 12047674777B / -C -C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, -C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND -C THE PERKIN ELMER (INTERDATA) 7/32. -C -C DATA SMALL(1), SMALL(2) / Z00100000, Z00000000 / -C DATA LARGE(1), LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / -C DATA RIGHT(1), RIGHT(2) / Z33100000, Z00000000 / -C DATA DIVER(1), DIVER(2) / Z34100000, Z00000000 / -C DATA LOG10(1), LOG10(2) / Z41134413, Z509F79FF / -C -C MACHINE CONSTANTS FOR THE IBM PC -C ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION -C ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087. -C -C DATA SMALL(1),SMALL(2) / 2002288515, 1050897 / -C DATA LARGE(1),LARGE(2) / 1487780761, 2146426097 / -C DATA RIGHT(1),RIGHT(2) / -1209488034, 1017118298 / -C DATA DIVER(1),DIVER(2) / -1209488034, 1018166874 / -C DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 / -C -C MACHINE CONSTANTS FOR THE IBM RS 6000 -C -C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / -C -C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) -C -C DATA SMALL(1), SMALL(2) / "033400000000, "000000000000 / -C DATA LARGE(1), LARGE(2) / "377777777777, "344777777777 / -C DATA RIGHT(1), RIGHT(2) / "113400000000, "000000000000 / -C DATA DIVER(1), DIVER(2) / "114400000000, "000000000000 / -C DATA LOG10(1), LOG10(2) / "177464202324, "144117571776 / -C -C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) -C -C DATA SMALL(1), SMALL(2) / "000400000000, "000000000000 / -C DATA LARGE(1), LARGE(2) / "377777777777, "377777777777 / -C DATA RIGHT(1), RIGHT(2) / "103400000000, "000000000000 / -C DATA DIVER(1), DIVER(2) / "104400000000, "000000000000 / -C DATA LOG10(1), LOG10(2) / "177464202324, "476747767461 / -C -C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING -C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). -C -C DATA SMALL(1), SMALL(2) / 8388608, 0 / -C DATA LARGE(1), LARGE(2) / 2147483647, -1 / -C DATA RIGHT(1), RIGHT(2) / 612368384, 0 / -C DATA DIVER(1), DIVER(2) / 620756992, 0 / -C DATA LOG10(1), LOG10(2) / 1067065498, -2063872008 / -C -C DATA SMALL(1), SMALL(2) / O00040000000, O00000000000 / -C DATA LARGE(1), LARGE(2) / O17777777777, O37777777777 / -C DATA RIGHT(1), RIGHT(2) / O04440000000, O00000000000 / -C DATA DIVER(1), DIVER(2) / O04500000000, O00000000000 / -C DATA LOG10(1), LOG10(2) / O07746420232, O20476747770 / -C -C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING -C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). -C -C DATA SMALL(1), SMALL(2) / 128, 0 / -C DATA SMALL(3), SMALL(4) / 0, 0 / -C DATA LARGE(1), LARGE(2) / 32767, -1 / -C DATA LARGE(3), LARGE(4) / -1, -1 / -C DATA RIGHT(1), RIGHT(2) / 9344, 0 / -C DATA RIGHT(3), RIGHT(4) / 0, 0 / -C DATA DIVER(1), DIVER(2) / 9472, 0 / -C DATA DIVER(3), DIVER(4) / 0, 0 / -C DATA LOG10(1), LOG10(2) / 16282, 8346 / -C DATA LOG10(3), LOG10(4) / -31493, -12296 / -C -C DATA SMALL(1), SMALL(2) / O000200, O000000 / -C DATA SMALL(3), SMALL(4) / O000000, O000000 / -C DATA LARGE(1), LARGE(2) / O077777, O177777 / -C DATA LARGE(3), LARGE(4) / O177777, O177777 / -C DATA RIGHT(1), RIGHT(2) / O022200, O000000 / -C DATA RIGHT(3), RIGHT(4) / O000000, O000000 / -C DATA DIVER(1), DIVER(2) / O022400, O000000 / -C DATA DIVER(3), DIVER(4) / O000000, O000000 / -C DATA LOG10(1), LOG10(2) / O037632, O020232 / -C DATA LOG10(3), LOG10(4) / O102373, O147770 / -C -C MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS -C -c data dmach(1) / 2.22507 38585 072012 d-308 / -c data dmach(2) / 1.79769 31348 623158 d+308 / -c data dmach(3) / 2.22044 60492 503131 d-16 / -c data dmach(4) / 4.44089 20985 006262 d-16 / -c data dmach(5) / 0.30102 99956 639812 / -C -C DATA SMALL(1), SMALL(2) / Z'00100000',Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF',Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CB00000',Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CC00000',Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413',Z'509F79FF' / -C -C MACHINE CONSTANTS FOR THE SUN -C -C from SLATEC CML committee - work for Sun3, Sun4, and Sparc -C -C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / -C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / -C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / -C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / -C -C from Sun Microsystems - work for Sun 386i -C -C DATA SMALL(1), SMALL(2) / Z'00000000', Z'00100000' / -C DATA LARGE(1), LARGE(2) / Z'FFFFFFFF', Z'7FEFFFFF' / -C DATA RIGHT(1), RIGHT(2) / Z'00000000', Z'3CA00000' / -C DATA DIVER(1), DIVER(2) / Z'00000000', Z'3CB00000' / -C DATA LOG10(1), LOG10(2) / Z'509F79FF', Z'3FD34413' / -C -C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER -C -C DATA SMALL(1), SMALL(2) / O000040000000, O000000000000 / -C DATA LARGE(1), LARGE(2) / O377777777777, O777777777777 / -C DATA RIGHT(1), RIGHT(2) / O170540000000, O000000000000 / -C DATA DIVER(1), DIVER(2) / O170640000000, O000000000000 / -C DATA LOG10(1), LOG10(2) / O177746420232, O411757177572 / -C -C MACHINE CONSTANTS FOR VAX 11/780 -C (EXPRESSED IN INTEGER AND HEXADECIMAL) -C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSYEMS -C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS -C -C DATA SMALL(1), SMALL(2) / 128, 0 / -C DATA LARGE(1), LARGE(2) / -32769, -1 / -C DATA RIGHT(1), RIGHT(2) / 9344, 0 / -C DATA DIVER(1), DIVER(2) / 9472, 0 / -C DATA LOG10(1), LOG10(2) / 546979738, -805796613 / -C -C DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 / -C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / -C DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 / -C DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 / -C DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB / -C -C MACHINE CONSTANTS FOR VAX 11/780 (G-FLOATING) -C (EXPRESSED IN INTEGER AND HEXADECIMAL) -C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSYEMS -C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS -C -C DATA SMALL(1), SMALL(2) / 16, 0 / -C DATA LARGE(1), LARGE(2) / -32769, -1 / -C DATA RIGHT(1), RIGHT(2) / 15552, 0 / -C DATA DIVER(1), DIVER(2) / 15568, 0 / -C DATA LOG10(1), LOG10(2) / 1142112243, 2046775455 / -C -C DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 / -C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / -C DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 / -C DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 / -C DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F / -C -C -C***FIRST EXECUTABLE STATEMENT D1MACH - IF (I .LT. 1 .OR. I .GT. 5) - 1 CALL XERROR ('D1MACH -- I OUT OF BOUNDS', 25, 1, 2) -C +C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES. +C R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF +C D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR +C MANY MACHINES YET. +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 DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/ +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGERS. +C DATA SMALL(1),SMALL(2) / 8388608, 0 / +C DATA LARGE(1),LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / +C DATA DIVER(1),DIVER(2) / 620756992, 0 / +C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/ +C +C ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES. + IF (SC .NE. 987) THEN + DMACH(1) = 1.D13 + IF ( SMALL(1) .EQ. 1117925532 + * .AND. SMALL(2) .EQ. -448790528) THEN +* *** IEEE BIG ENDIAN *** + SMALL(1) = 1048576 + SMALL(2) = 0 + LARGE(1) = 2146435071 + LARGE(2) = -1 + RIGHT(1) = 1017118720 + RIGHT(2) = 0 + DIVER(1) = 1018167296 + DIVER(2) = 0 + LOG10(1) = 1070810131 + LOG10(2) = 1352628735 + ELSE IF ( SMALL(2) .EQ. 1117925532 + * .AND. SMALL(1) .EQ. -448790528) THEN +* *** IEEE LITTLE ENDIAN *** + SMALL(2) = 1048576 + SMALL(1) = 0 + LARGE(2) = 2146435071 + LARGE(1) = -1 + RIGHT(2) = 1017118720 + RIGHT(1) = 0 + DIVER(2) = 1018167296 + DIVER(1) = 0 + LOG10(2) = 1070810131 + LOG10(1) = 1352628735 + ELSE IF ( SMALL(1) .EQ. -2065213935 + * .AND. SMALL(2) .EQ. 10752) THEN +* *** VAX WITH D_FLOATING *** + SMALL(1) = 128 + SMALL(2) = 0 + LARGE(1) = -32769 + LARGE(2) = -1 + RIGHT(1) = 9344 + RIGHT(2) = 0 + DIVER(1) = 9472 + DIVER(2) = 0 + LOG10(1) = 546979738 + LOG10(2) = -805796613 + ELSE IF ( SMALL(1) .EQ. 1267827943 + * .AND. SMALL(2) .EQ. 704643072) THEN +* *** IBM MAINFRAME *** + SMALL(1) = 1048576 + SMALL(2) = 0 + LARGE(1) = 2147483647 + LARGE(2) = -1 + RIGHT(1) = 856686592 + RIGHT(2) = 0 + DIVER(1) = 873463808 + DIVER(2) = 0 + LOG10(1) = 1091781651 + LOG10(2) = 1352628735 + ELSE IF ( SMALL(1) .EQ. 1120022684 + * .AND. SMALL(2) .EQ. -448790528) THEN +* *** CONVEX C-1 *** + SMALL(1) = 1048576 + SMALL(2) = 0 + LARGE(1) = 2147483647 + LARGE(2) = -1 + RIGHT(1) = 1019215872 + RIGHT(2) = 0 + DIVER(1) = 1020264448 + DIVER(2) = 0 + LOG10(1) = 1072907283 + LOG10(2) = 1352628735 + ELSE IF ( SMALL(1) .EQ. 815547074 + * .AND. SMALL(2) .EQ. 58688) THEN +* *** VAX G-FLOATING *** + SMALL(1) = 16 + SMALL(2) = 0 + LARGE(1) = -32769 + LARGE(2) = -1 + RIGHT(1) = 15552 + RIGHT(2) = 0 + DIVER(1) = 15568 + DIVER(2) = 0 + LOG10(1) = 1142112243 + LOG10(2) = 2046775455 + ELSE + DMACH(2) = 1.D27 + 1 + DMACH(3) = 1.D27 + LARGE(2) = LARGE(2) - RIGHT(2) + IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN + CRAY1(1) = 67291416 + DO 10 J = 1, 20 + CRAY1(J+1) = CRAY1(J) + CRAY1(J) + 10 CONTINUE + CRAY1(22) = CRAY1(21) + 321322 + DO 20 J = 22, 37 + CRAY1(J+1) = CRAY1(J) + CRAY1(J) + 20 CONTINUE + IF (CRAY1(38) .EQ. SMALL(1)) THEN +* *** CRAY *** + CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0) + SMALL(2) = 0 + CALL I1MCRY(LARGE(1), J, 24574, 16777215, 16777215) + CALL I1MCRY(LARGE(2), J, 0, 16777215, 16777214) + CALL I1MCRY(RIGHT(1), J, 16291, 8388608, 0) + RIGHT(2) = 0 + CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0) + DIVER(2) = 0 + CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215) + CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388) + ELSE + WRITE(*,9000) + STOP 779 + END IF + ELSE + WRITE(*,9000) + STOP 779 + END IF + END IF + SC = 987 + END IF +* SANITY CHECK + IF (DMACH(4) .GE. 1.0D0) STOP 778 + IF (I .LT. 1 .OR. I .GT. 5) THEN + WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.' + STOP + END IF D1MACH = DMACH(I) RETURN -C + 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/ + *' appropriate for your machine.') +* /* Standard C source for D1MACH -- remove the * in column 1 */ +*#include +*#include +*#include +*double d1mach_(long *i) +*{ +* switch(*i){ +* case 1: return DBL_MIN; +* case 2: return DBL_MAX; +* case 3: return DBL_EPSILON/FLT_RADIX; +* case 4: return DBL_EPSILON; +* case 5: return log10(FLT_RADIX); +* } +* fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i); +* exit(1); return 0; /* some compilers demand return values */ +*} + END + SUBROUTINE I1MCRY(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 END diff --git a/amos/i1mach.f b/amos/i1mach.f index 70d8cc8..1d6f7fc 100644 --- a/amos/i1mach.f +++ b/amos/i1mach.f @@ -1,673 +1,291 @@ -*DECK I1MACH INTEGER FUNCTION I1MACH(I) -C***BEGIN PROLOGUE I1MACH -C***DATE WRITTEN 750101 (YYMMDD) -C***REVISION DATE 890213 (YYMMDD) -C***CATEGORY NO. R1 -C***KEYWORDS LIBRARY=SLATEC,TYPE=INTEGER(I1MACH-I),MACHINE CONSTANTS -C***AUTHOR FOX, P. A., (BELL LABS) -C HALL, A. D., (BELL LABS) -C SCHRYER, N. L., (BELL LABS) -C***PURPOSE Returns integer machine dependent constants -C***DESCRIPTION + INTEGER I C -C I1MACH can be used to obtain machine-dependent parameters -C for the local machine environment. It is a function -C subroutine with one (input) argument, and can be called -C as follows, for example +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 -C K = I1MACH(I) + 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 where I=1,...,16. The (output) value of K above is -C determined by the (input) value of I. The results for -C various values of I are discussed below. +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C -C I/O unit numbers. -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 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 Words. -C I1MACH( 5) = the number of bits per integer storage unit. -C I1MACH( 6) = the number of characters per integer storage unit. -C -C Integers. -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 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 -C Floating-Point Numbers. -C Assume floating-point numbers are represented in the T-digit, -C base-B form -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 I1MACH(10) = B, the base. -C -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 -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 -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. -C -C***REFERENCES FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A -C PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL -C SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188. -C***ROUTINES CALLED (NONE) -C***END PROLOGUE I1MACH -C - INTEGER IMACH(16),OUTPUT - SAVE IMACH - EQUIVALENCE (IMACH(4),OUTPUT) -C -C MACHINE CONSTANTS FOR THE AMIGA -C ABSOFT COMPILER -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 5 / -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)/ -126 / -C DATA IMACH(13)/ 127 / -C DATA IMACH(14)/ 53 / -C DATA IMACH(15)/ -1022 / -C DATA IMACH(16)/ 1023 / -C -C MACHINE CONSTANTS FOR THE APOLLO -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) / 2147483647 / -C DATA IMACH(10)/ 2 / -C DATA IMACH(11)/ 24 / -C DATA IMACH(12)/ -125 / -C DATA IMACH(13)/ 129 / -C DATA IMACH(14)/ 53 / -C DATA IMACH(15)/ -1021 / -C DATA IMACH(16)/ 1025 / -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 / -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 / -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 / -C -C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE -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) / 64 / -C DATA IMACH( 6) / 8 / -C DATA IMACH( 7) / 2 / -C DATA IMACH( 8) / 63 / -C DATA IMACH( 9) / 9223372036854775807 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 47 / -C DATA IMACH(12) / -4095 / -C DATA IMACH(13) / 4094 / -C DATA IMACH(14) / 94 / -C DATA IMACH(15) / -4095 / -C DATA IMACH(16) / 4094 / -C -C MACHINE CONSTANTS FOR 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) /6LOUTPUT/ -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 / -C -C MACHINE CONSTANTS FOR THE CELERITY C1260 -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 6 / -C DATA IMACH(4) / 0 / -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)/ 2 / -C DATA IMACH(11)/ 24 / -C DATA IMACH(12)/ -126 / -C DATA IMACH(13)/ 127 / -C DATA IMACH(14)/ 53 / -C DATA IMACH(15)/ -1022 / -C DATA IMACH(16)/ 1023 / -C -C MACHINE CONSTANTS FOR THE 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/ -C -C MACHINE CONSTANTS FOR THE CRAY-1 -C -C DATA IMACH( 1) / 100 / -C DATA IMACH( 2) / 101 / -C DATA IMACH( 3) / 102 / -C DATA IMACH( 4) / 101 / -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 / -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 / -C -C MACHINE CONSTANTS FOR THE ELXSI 6400 -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) / 32/ -C DATA IMACH( 9) /2147483647/ -C DATA IMACH(10) / 2/ -C DATA IMACH(11) / 24/ -C DATA IMACH(12) / -126/ -C DATA IMACH(13) / 127/ -C DATA IMACH(14) / 53/ -C DATA IMACH(15) / -1022/ -C DATA IMACH(16) / 1023/ -C -C MACHINE CONSTANTS FOR THE HARRIS 220 -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 / -C -C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 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) / 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) / -127 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 63 / -C DATA IMACH(15) / -127 / -C DATA IMACH(16) / 127 / -C -C MACHINE CONSTANTS FOR THE HP 2100 -C 3 WORD DOUBLE PRECISION OPTION WITH FTN4 -C -C DATA IMACH(1) / 5/ -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 4 / -C DATA IMACH(4) / 1 / -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)/ 23 / -C DATA IMACH(12)/ -128 / -C DATA IMACH(13)/ 127 / -C DATA IMACH(14)/ 39 / -C DATA IMACH(15)/ -128 / -C DATA IMACH(16)/ 127 / -C -C MACHINE CONSTANTS FOR THE HP 2100 -C 4 WORD DOUBLE PRECISION OPTION WITH FTN4 -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 4 / -C DATA IMACH(4) / 1 / -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)/ 23 / -C DATA IMACH(12)/ -128 / -C DATA IMACH(13)/ 127 / -C DATA IMACH(14)/ 55 / -C DATA IMACH(15)/ -128 / -C DATA IMACH(16)/ 127 / -C -C MACHINE CONSTANTS FOR THE HP 9000 -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 6 / -C DATA IMACH(3) / 7 / -C DATA IMACH(5) / 32 / -C DATA IMACH(6) / 4 / -C DATA IMACH(7) / 2 / -C DATA IMACH(8) / 32 / -C DATA IMACH(9) /2147483647 / -C DATA IMACH(10) / 2 / -C DATA IMACH(11) / 24 / -C DATA IMACH(12) / -126 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 53 / -C DATA IMACH(15) /-1015 / -C DATA IMACH(16) / 1017 / -C -C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, -C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND -C THE PERKIN ELMER (INTERDATA) 7/32. -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) / 16 / -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 / -C -C MACHINE CONSTANTS FOR THE IBM PC -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 0 / -C DATA IMACH( 4) / 0 / -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) / 127 / -C DATA IMACH(14) / 53 / -C DATA IMACH(15) / -1021 / -C DATA IMACH(16) / 1023 / -C -C MACHINE CONSTANTS FOR THE IBM RS 6000 -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 6 / -C DATA IMACH( 4) / 0 / -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 / -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) / 5 / -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 / -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) / 5 / -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 / -C -C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +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) / 5 / -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 / +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 PDP-11 FORTRAN SUPPORTING -C 16-BIT INTEGER ARITHMETIC. +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 5 / -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 / +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 MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 6 / -C DATA IMACH( 4) / 0 / -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) / 23 / -C DATA IMACH(12) / -126 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 52 / -C DATA IMACH(15) / -1022 / -C DATA IMACH(16) / 1023 / -C -C MACHINE CONSTANTS FOR THE SUN -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) /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 / -C -C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER -C -C -C DATA IMACH( 1) / 5 / -C DATA IMACH( 2) / 6 / -C DATA IMACH( 3) / 1 / -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) / -128 / -C DATA IMACH(13) / 127 / -C DATA IMACH(14) / 60 / -C DATA IMACH(15) /-1024 / -C DATA IMACH(16) / 1023 / -C -C MACHINE CONSTANTS FOR THE VAX 11/780 -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 5 / -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 / -C -C MACHINE CONSTANTS FOR THE VAX 11/780, G-FLOAT OPTION -C -C DATA IMACH(1) / 5 / -C DATA IMACH(2) / 6 / -C DATA IMACH(3) / 5 / -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)/ 53 / -C DATA IMACH(15)/ -1022 / -C DATA IMACH(16)/ 1023 / -C -C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR -C -C DATA IMACH( 1) / 1/ -C DATA IMACH( 2) / 1/ -C DATA IMACH( 3) / 0/ -C DATA IMACH( 4) / 1/ -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/ -C -C -C***FIRST EXECUTABLE STATEMENT I1MACH - IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 +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 I1MACH = IMACH(I) RETURN -C - 10 CONTINUE - WRITE (UNIT = OUTPUT, FMT = 9000) - 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS') -C -C CALL FDUMP -C -C + 40 WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.' STOP +* /* C source for I1MACH -- remove the * in column 1 */ +* /* Note that some values may need changing. */ +*#include +*#include +*#include +*#include +* +*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 END