d1mach.f 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506
  1. *DECK D1MACH
  2. DOUBLE PRECISION FUNCTION D1MACH (I)
  3. C***BEGIN PROLOGUE D1MACH
  4. C***PURPOSE Return floating point machine dependent constants.
  5. C***LIBRARY SLATEC
  6. C***CATEGORY R1
  7. C***TYPE DOUBLE PRECISION (R1MACH-S, D1MACH-D)
  8. C***KEYWORDS MACHINE CONSTANTS
  9. C***AUTHOR Fox, P. A., (Bell Labs)
  10. C Hall, A. D., (Bell Labs)
  11. C Schryer, N. L., (Bell Labs)
  12. C***DESCRIPTION
  13. C
  14. C D1MACH can be used to obtain machine-dependent parameters for the
  15. C local machine environment. It is a function subprogram with one
  16. C (input) argument, and can be referenced as follows:
  17. C
  18. C D = D1MACH(I)
  19. C
  20. C where I=1,...,5. The (output) value of D above is determined by
  21. C the (input) value of I. The results for various values of I are
  22. C discussed below.
  23. C
  24. C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude.
  25. C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
  26. C D1MACH( 3) = B**(-T), the smallest relative spacing.
  27. C D1MACH( 4) = B**(1-T), the largest relative spacing.
  28. C D1MACH( 5) = LOG10(B)
  29. C
  30. C Assume double precision numbers are represented in the T-digit,
  31. C base-B form
  32. C
  33. C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
  34. C
  35. C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
  36. C EMIN .LE. E .LE. EMAX.
  37. C
  38. C The values of B, T, EMIN and EMAX are provided in I1MACH as
  39. C follows:
  40. C I1MACH(10) = B, the base.
  41. C I1MACH(14) = T, the number of base-B digits.
  42. C I1MACH(15) = EMIN, the smallest exponent E.
  43. C I1MACH(16) = EMAX, the largest exponent E.
  44. C
  45. C To alter this function for a particular environment, the desired
  46. C set of DATA statements should be activated by removing the C from
  47. C column 1. Also, the values of D1MACH(1) - D1MACH(4) should be
  48. C checked for consistency with the local operating system.
  49. C
  50. C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
  51. C a portable library, ACM Transactions on Mathematical
  52. C Software 4, 2 (June 1978), pp. 177-188.
  53. C***ROUTINES CALLED XERMSG
  54. C***REVISION HISTORY (YYMMDD)
  55. C 750101 DATE WRITTEN
  56. C 890213 REVISION DATE from Version 3.2
  57. C 891214 Prologue converted to Version 4.0 format. (BAB)
  58. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  59. C 900618 Added DEC RISC constants. (WRB)
  60. C 900723 Added IBM RS 6000 constants. (WRB)
  61. C 900911 Added SUN 386i constants. (WRB)
  62. C 910710 Added HP 730 constants. (SMR)
  63. C 911114 Added Convex IEEE constants. (WRB)
  64. C 920121 Added SUN -r8 compiler option constants. (WRB)
  65. C 920229 Added Touchstone Delta i860 constants. (WRB)
  66. C 920501 Reformatted the REFERENCES section. (WRB)
  67. C 920625 Added CONVEX -p8 and -pd8 compiler option constants.
  68. C (BKS, WRB)
  69. C 930201 Added DEC Alpha and SGI constants. (RWC and WRB)
  70. C***END PROLOGUE D1MACH
  71. C
  72. C
  73. external dlamch
  74. DOUBLE PRECISION DMACH(5),dlamch
  75. integer iflag
  76. SAVE DMACH,iflag
  77. data iflag/0/
  78. C
  79. C
  80. C MACHINE CONSTANTS FOR THE AMIGA
  81. C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION
  82. C
  83. C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
  84. C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
  85. C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
  86. C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
  87. C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
  88. C
  89. C MACHINE CONSTANTS FOR THE AMIGA
  90. C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT
  91. C
  92. C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
  93. C DATA LARGE(1), LARGE(2) / Z'7FDFFFFF', Z'FFFFFFFF' /
  94. C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
  95. C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
  96. C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
  97. C
  98. C MACHINE CONSTANTS FOR THE APOLLO
  99. C
  100. C DATA SMALL(1), SMALL(2) / 16#00100000, 16#00000000 /
  101. C DATA LARGE(1), LARGE(2) / 16#7FFFFFFF, 16#FFFFFFFF /
  102. C DATA RIGHT(1), RIGHT(2) / 16#3CA00000, 16#00000000 /
  103. C DATA DIVER(1), DIVER(2) / 16#3CB00000, 16#00000000 /
  104. C DATA LOG10(1), LOG10(2) / 16#3FD34413, 16#509F79FF /
  105. C
  106. C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM
  107. C
  108. C DATA SMALL(1) / ZC00800000 /
  109. C DATA SMALL(2) / Z000000000 /
  110. C DATA LARGE(1) / ZDFFFFFFFF /
  111. C DATA LARGE(2) / ZFFFFFFFFF /
  112. C DATA RIGHT(1) / ZCC5800000 /
  113. C DATA RIGHT(2) / Z000000000 /
  114. C DATA DIVER(1) / ZCC6800000 /
  115. C DATA DIVER(2) / Z000000000 /
  116. C DATA LOG10(1) / ZD00E730E7 /
  117. C DATA LOG10(2) / ZC77800DC0 /
  118. C
  119. C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM
  120. C
  121. C DATA SMALL(1) / O1771000000000000 /
  122. C DATA SMALL(2) / O0000000000000000 /
  123. C DATA LARGE(1) / O0777777777777777 /
  124. C DATA LARGE(2) / O0007777777777777 /
  125. C DATA RIGHT(1) / O1461000000000000 /
  126. C DATA RIGHT(2) / O0000000000000000 /
  127. C DATA DIVER(1) / O1451000000000000 /
  128. C DATA DIVER(2) / O0000000000000000 /
  129. C DATA LOG10(1) / O1157163034761674 /
  130. C DATA LOG10(2) / O0006677466732724 /
  131. C
  132. C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS
  133. C
  134. C DATA SMALL(1) / O1771000000000000 /
  135. C DATA SMALL(2) / O7770000000000000 /
  136. C DATA LARGE(1) / O0777777777777777 /
  137. C DATA LARGE(2) / O7777777777777777 /
  138. C DATA RIGHT(1) / O1461000000000000 /
  139. C DATA RIGHT(2) / O0000000000000000 /
  140. C DATA DIVER(1) / O1451000000000000 /
  141. C DATA DIVER(2) / O0000000000000000 /
  142. C DATA LOG10(1) / O1157163034761674 /
  143. C DATA LOG10(2) / O0006677466732724 /
  144. C
  145. C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE
  146. C
  147. C DATA SMALL(1) / Z"3001800000000000" /
  148. C DATA SMALL(2) / Z"3001000000000000" /
  149. C DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" /
  150. C DATA LARGE(2) / Z"4FFE000000000000" /
  151. C DATA RIGHT(1) / Z"3FD2800000000000" /
  152. C DATA RIGHT(2) / Z"3FD2000000000000" /
  153. C DATA DIVER(1) / Z"3FD3800000000000" /
  154. C DATA DIVER(2) / Z"3FD3000000000000" /
  155. C DATA LOG10(1) / Z"3FFF9A209A84FBCF" /
  156. C DATA LOG10(2) / Z"3FFFF7988F8959AC" /
  157. C
  158. C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
  159. C
  160. C DATA SMALL(1) / 00564000000000000000B /
  161. C DATA SMALL(2) / 00000000000000000000B /
  162. C DATA LARGE(1) / 37757777777777777777B /
  163. C DATA LARGE(2) / 37157777777777777777B /
  164. C DATA RIGHT(1) / 15624000000000000000B /
  165. C DATA RIGHT(2) / 00000000000000000000B /
  166. C DATA DIVER(1) / 15634000000000000000B /
  167. C DATA DIVER(2) / 00000000000000000000B /
  168. C DATA LOG10(1) / 17164642023241175717B /
  169. C DATA LOG10(2) / 16367571421742254654B /
  170. C
  171. C MACHINE CONSTANTS FOR THE CELERITY C1260
  172. C
  173. C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
  174. C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
  175. C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
  176. C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
  177. C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
  178. C
  179. C MACHINE CONSTANTS FOR THE CONVEX
  180. C USING THE -fn OR -pd8 COMPILER OPTION
  181. C
  182. C DATA DMACH(1) / Z'0010000000000000' /
  183. C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFF' /
  184. C DATA DMACH(3) / Z'3CC0000000000000' /
  185. C DATA DMACH(4) / Z'3CD0000000000000' /
  186. C DATA DMACH(5) / Z'3FF34413509F79FF' /
  187. C
  188. C MACHINE CONSTANTS FOR THE CONVEX
  189. C USING THE -fi COMPILER OPTION
  190. C
  191. C DATA DMACH(1) / Z'0010000000000000' /
  192. C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
  193. C DATA DMACH(3) / Z'3CA0000000000000' /
  194. C DATA DMACH(4) / Z'3CB0000000000000' /
  195. C DATA DMACH(5) / Z'3FD34413509F79FF' /
  196. C
  197. C MACHINE CONSTANTS FOR THE CONVEX
  198. C USING THE -p8 COMPILER OPTION
  199. C
  200. C DATA DMACH(1) / Z'00010000000000000000000000000000' /
  201. C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' /
  202. C DATA DMACH(3) / Z'3F900000000000000000000000000000' /
  203. C DATA DMACH(4) / Z'3F910000000000000000000000000000' /
  204. C DATA DMACH(5) / Z'3FFF34413509F79FEF311F12B35816F9' /
  205. C
  206. C MACHINE CONSTANTS FOR THE CRAY
  207. C
  208. C DATA SMALL(1) / 201354000000000000000B /
  209. C DATA SMALL(2) / 000000000000000000000B /
  210. C DATA LARGE(1) / 577767777777777777777B /
  211. C DATA LARGE(2) / 000007777777777777774B /
  212. C DATA RIGHT(1) / 376434000000000000000B /
  213. C DATA RIGHT(2) / 000000000000000000000B /
  214. C DATA DIVER(1) / 376444000000000000000B /
  215. C DATA DIVER(2) / 000000000000000000000B /
  216. C DATA LOG10(1) / 377774642023241175717B /
  217. C DATA LOG10(2) / 000007571421742254654B /
  218. C
  219. C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
  220. C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD -
  221. C STATIC DMACH(5)
  222. C
  223. C DATA SMALL / 20K, 3*0 /
  224. C DATA LARGE / 77777K, 3*177777K /
  225. C DATA RIGHT / 31420K, 3*0 /
  226. C DATA DIVER / 32020K, 3*0 /
  227. C DATA LOG10 / 40423K, 42023K, 50237K, 74776K /
  228. C
  229. C MACHINE CONSTANTS FOR THE DEC ALPHA
  230. C USING G_FLOAT
  231. C
  232. C DATA DMACH(1) / '0000000000000010'X /
  233. C DATA DMACH(2) / 'FFFFFFFFFFFF7FFF'X /
  234. C DATA DMACH(3) / '0000000000003CC0'X /
  235. C DATA DMACH(4) / '0000000000003CD0'X /
  236. C DATA DMACH(5) / '79FF509F44133FF3'X /
  237. C
  238. C MACHINE CONSTANTS FOR THE DEC ALPHA
  239. C USING IEEE_FORMAT
  240. C
  241. C DATA DMACH(1) / '0010000000000000'X /
  242. C DATA DMACH(2) / '7FEFFFFFFFFFFFFF'X /
  243. C DATA DMACH(3) / '3CA0000000000000'X /
  244. C DATA DMACH(4) / '3CB0000000000000'X /
  245. C DATA DMACH(5) / '3FD34413509F79FF'X /
  246. C
  247. C MACHINE CONSTANTS FOR THE DEC RISC
  248. C
  249. C DATA SMALL(1), SMALL(2) / Z'00000000', Z'00100000'/
  250. C DATA LARGE(1), LARGE(2) / Z'FFFFFFFF', Z'7FEFFFFF'/
  251. C DATA RIGHT(1), RIGHT(2) / Z'00000000', Z'3CA00000'/
  252. C DATA DIVER(1), DIVER(2) / Z'00000000', Z'3CB00000'/
  253. C DATA LOG10(1), LOG10(2) / Z'509F79FF', Z'3FD34413'/
  254. C
  255. C MACHINE CONSTANTS FOR THE DEC VAX
  256. C USING D_FLOATING
  257. C (EXPRESSED IN INTEGER AND HEXADECIMAL)
  258. C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS
  259. C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS
  260. C
  261. C DATA SMALL(1), SMALL(2) / 128, 0 /
  262. C DATA LARGE(1), LARGE(2) / -32769, -1 /
  263. C DATA RIGHT(1), RIGHT(2) / 9344, 0 /
  264. C DATA DIVER(1), DIVER(2) / 9472, 0 /
  265. C DATA LOG10(1), LOG10(2) / 546979738, -805796613 /
  266. C
  267. C DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 /
  268. C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
  269. C DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 /
  270. C DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 /
  271. C DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB /
  272. C
  273. C MACHINE CONSTANTS FOR THE DEC VAX
  274. C USING G_FLOATING
  275. C (EXPRESSED IN INTEGER AND HEXADECIMAL)
  276. C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS
  277. C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS
  278. C
  279. C DATA SMALL(1), SMALL(2) / 16, 0 /
  280. C DATA LARGE(1), LARGE(2) / -32769, -1 /
  281. C DATA RIGHT(1), RIGHT(2) / 15552, 0 /
  282. C DATA DIVER(1), DIVER(2) / 15568, 0 /
  283. C DATA LOG10(1), LOG10(2) / 1142112243, 2046775455 /
  284. C
  285. C DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 /
  286. C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
  287. C DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 /
  288. C DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 /
  289. C DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F /
  290. C
  291. C MACHINE CONSTANTS FOR THE ELXSI 6400
  292. C (ASSUMING REAL*8 IS THE DEFAULT DOUBLE PRECISION)
  293. C
  294. C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X /
  295. C DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X /
  296. C DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X /
  297. C DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X /
  298. C DATA LOG10(1), LOG10(2) / '3FD34413'X,'509F79FF'X /
  299. C
  300. C MACHINE CONSTANTS FOR THE HARRIS 220
  301. C
  302. C DATA SMALL(1), SMALL(2) / '20000000, '00000201 /
  303. C DATA LARGE(1), LARGE(2) / '37777777, '37777577 /
  304. C DATA RIGHT(1), RIGHT(2) / '20000000, '00000333 /
  305. C DATA DIVER(1), DIVER(2) / '20000000, '00000334 /
  306. C DATA LOG10(1), LOG10(2) / '23210115, '10237777 /
  307. C
  308. C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES
  309. C
  310. C DATA SMALL(1), SMALL(2) / O402400000000, O000000000000 /
  311. C DATA LARGE(1), LARGE(2) / O376777777777, O777777777777 /
  312. C DATA RIGHT(1), RIGHT(2) / O604400000000, O000000000000 /
  313. C DATA DIVER(1), DIVER(2) / O606400000000, O000000000000 /
  314. C DATA LOG10(1), LOG10(2) / O776464202324, O117571775714 /
  315. C
  316. C MACHINE CONSTANTS FOR THE HP 730
  317. C
  318. C DATA DMACH(1) / Z'0010000000000000' /
  319. C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
  320. C DATA DMACH(3) / Z'3CA0000000000000' /
  321. C DATA DMACH(4) / Z'3CB0000000000000' /
  322. C DATA DMACH(5) / Z'3FD34413509F79FF' /
  323. C
  324. C MACHINE CONSTANTS FOR THE HP 2100
  325. C THREE WORD DOUBLE PRECISION OPTION WITH FTN4
  326. C
  327. C DATA SMALL(1), SMALL(2), SMALL(3) / 40000B, 0, 1 /
  328. C DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B /
  329. C DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B, 0, 265B /
  330. C DATA DIVER(1), DIVER(2), DIVER(3) / 40000B, 0, 276B /
  331. C DATA LOG10(1), LOG10(2), LOG10(3) / 46420B, 46502B, 77777B /
  332. C
  333. C MACHINE CONSTANTS FOR THE HP 2100
  334. C FOUR WORD DOUBLE PRECISION OPTION WITH FTN4
  335. C
  336. C DATA SMALL(1), SMALL(2) / 40000B, 0 /
  337. C DATA SMALL(3), SMALL(4) / 0, 1 /
  338. C DATA LARGE(1), LARGE(2) / 77777B, 177777B /
  339. C DATA LARGE(3), LARGE(4) / 177777B, 177776B /
  340. C DATA RIGHT(1), RIGHT(2) / 40000B, 0 /
  341. C DATA RIGHT(3), RIGHT(4) / 0, 225B /
  342. C DATA DIVER(1), DIVER(2) / 40000B, 0 /
  343. C DATA DIVER(3), DIVER(4) / 0, 227B /
  344. C DATA LOG10(1), LOG10(2) / 46420B, 46502B /
  345. C DATA LOG10(3), LOG10(4) / 76747B, 176377B /
  346. C
  347. C MACHINE CONSTANTS FOR THE HP 9000
  348. C
  349. C DATA SMALL(1), SMALL(2) / 00040000000B, 00000000000B /
  350. C DATA LARGE(1), LARGE(2) / 17737777777B, 37777777777B /
  351. C DATA RIGHT(1), RIGHT(2) / 07454000000B, 00000000000B /
  352. C DATA DIVER(1), DIVER(2) / 07460000000B, 00000000000B /
  353. C DATA LOG10(1), LOG10(2) / 07764642023B, 12047674777B /
  354. C
  355. C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
  356. C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND
  357. C THE PERKIN ELMER (INTERDATA) 7/32.
  358. C
  359. C DATA SMALL(1), SMALL(2) / Z00100000, Z00000000 /
  360. C DATA LARGE(1), LARGE(2) / Z7FFFFFFF, ZFFFFFFFF /
  361. C DATA RIGHT(1), RIGHT(2) / Z33100000, Z00000000 /
  362. C DATA DIVER(1), DIVER(2) / Z34100000, Z00000000 /
  363. C DATA LOG10(1), LOG10(2) / Z41134413, Z509F79FF /
  364. C
  365. C MACHINE CONSTANTS FOR THE IBM PC
  366. C ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION
  367. C ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087.
  368. C
  369. C DATA SMALL(1) / 2.23D-308 /
  370. C DATA LARGE(1) / 1.79D+308 /
  371. C DATA RIGHT(1) / 1.11D-16 /
  372. C DATA DIVER(1) / 2.22D-16 /
  373. C DATA LOG10(1) / 0.301029995663981195D0 /
  374. C
  375. C MACHINE CONSTANTS FOR THE IBM RS 6000
  376. C
  377. C DATA DMACH(1) / Z'0010000000000000' /
  378. C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
  379. C DATA DMACH(3) / Z'3CA0000000000000' /
  380. C DATA DMACH(4) / Z'3CB0000000000000' /
  381. C DATA DMACH(5) / Z'3FD34413509F79FF' /
  382. C
  383. C MACHINE CONSTANTS FOR THE INTEL i860
  384. C
  385. C DATA DMACH(1) / Z'0010000000000000' /
  386. C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
  387. C DATA DMACH(3) / Z'3CA0000000000000' /
  388. C DATA DMACH(4) / Z'3CB0000000000000' /
  389. C DATA DMACH(5) / Z'3FD34413509F79FF' /
  390. C
  391. C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR)
  392. C
  393. C DATA SMALL(1), SMALL(2) / "033400000000, "000000000000 /
  394. C DATA LARGE(1), LARGE(2) / "377777777777, "344777777777 /
  395. C DATA RIGHT(1), RIGHT(2) / "113400000000, "000000000000 /
  396. C DATA DIVER(1), DIVER(2) / "114400000000, "000000000000 /
  397. C DATA LOG10(1), LOG10(2) / "177464202324, "144117571776 /
  398. C
  399. C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR)
  400. C
  401. C DATA SMALL(1), SMALL(2) / "000400000000, "000000000000 /
  402. C DATA LARGE(1), LARGE(2) / "377777777777, "377777777777 /
  403. C DATA RIGHT(1), RIGHT(2) / "103400000000, "000000000000 /
  404. C DATA DIVER(1), DIVER(2) / "104400000000, "000000000000 /
  405. C DATA LOG10(1), LOG10(2) / "177464202324, "476747767461 /
  406. C
  407. C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
  408. C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
  409. C
  410. C DATA SMALL(1), SMALL(2) / 8388608, 0 /
  411. C DATA LARGE(1), LARGE(2) / 2147483647, -1 /
  412. C DATA RIGHT(1), RIGHT(2) / 612368384, 0 /
  413. C DATA DIVER(1), DIVER(2) / 620756992, 0 /
  414. C DATA LOG10(1), LOG10(2) / 1067065498, -2063872008 /
  415. C
  416. C DATA SMALL(1), SMALL(2) / O00040000000, O00000000000 /
  417. C DATA LARGE(1), LARGE(2) / O17777777777, O37777777777 /
  418. C DATA RIGHT(1), RIGHT(2) / O04440000000, O00000000000 /
  419. C DATA DIVER(1), DIVER(2) / O04500000000, O00000000000 /
  420. C DATA LOG10(1), LOG10(2) / O07746420232, O20476747770 /
  421. C
  422. C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
  423. C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
  424. C
  425. C DATA SMALL(1), SMALL(2) / 128, 0 /
  426. C DATA SMALL(3), SMALL(4) / 0, 0 /
  427. C DATA LARGE(1), LARGE(2) / 32767, -1 /
  428. C DATA LARGE(3), LARGE(4) / -1, -1 /
  429. C DATA RIGHT(1), RIGHT(2) / 9344, 0 /
  430. C DATA RIGHT(3), RIGHT(4) / 0, 0 /
  431. C DATA DIVER(1), DIVER(2) / 9472, 0 /
  432. C DATA DIVER(3), DIVER(4) / 0, 0 /
  433. C DATA LOG10(1), LOG10(2) / 16282, 8346 /
  434. C DATA LOG10(3), LOG10(4) / -31493, -12296 /
  435. C
  436. C DATA SMALL(1), SMALL(2) / O000200, O000000 /
  437. C DATA SMALL(3), SMALL(4) / O000000, O000000 /
  438. C DATA LARGE(1), LARGE(2) / O077777, O177777 /
  439. C DATA LARGE(3), LARGE(4) / O177777, O177777 /
  440. C DATA RIGHT(1), RIGHT(2) / O022200, O000000 /
  441. C DATA RIGHT(3), RIGHT(4) / O000000, O000000 /
  442. C DATA DIVER(1), DIVER(2) / O022400, O000000 /
  443. C DATA DIVER(3), DIVER(4) / O000000, O000000 /
  444. C DATA LOG10(1), LOG10(2) / O037632, O020232 /
  445. C DATA LOG10(3), LOG10(4) / O102373, O147770 /
  446. C
  447. C MACHINE CONSTANTS FOR THE SILICON GRAPHICS
  448. C
  449. C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
  450. C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
  451. C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
  452. C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
  453. C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
  454. C
  455. C MACHINE CONSTANTS FOR THE SUN
  456. C
  457. C DATA DMACH(1) / Z'0010000000000000' /
  458. C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
  459. C DATA DMACH(3) / Z'3CA0000000000000' /
  460. C DATA DMACH(4) / Z'3CB0000000000000' /
  461. C DATA DMACH(5) / Z'3FD34413509F79FF' /
  462. C
  463. C MACHINE CONSTANTS FOR THE SUN
  464. C USING THE -r8 COMPILER OPTION
  465. C
  466. C DATA DMACH(1) / Z'00010000000000000000000000000000' /
  467. C DATA DMACH(2) / Z'7FFEFFFFFFFFFFFFFFFFFFFFFFFFFFFF' /
  468. C DATA DMACH(3) / Z'3F8E0000000000000000000000000000' /
  469. C DATA DMACH(4) / Z'3F8F0000000000000000000000000000' /
  470. C DATA DMACH(5) / Z'3FFD34413509F79FEF311F12B35816F9' /
  471. C
  472. C MACHINE CONSTANTS FOR THE SUN 386i
  473. C
  474. C DATA SMALL(1), SMALL(2) / Z'FFFFFFFD', Z'000FFFFF' /
  475. C DATA LARGE(1), LARGE(2) / Z'FFFFFFB0', Z'7FEFFFFF' /
  476. C DATA RIGHT(1), RIGHT(2) / Z'000000B0', Z'3CA00000' /
  477. C DATA DIVER(1), DIVER(2) / Z'FFFFFFCB', Z'3CAFFFFF'
  478. C DATA LOG10(1), LOG10(2) / Z'509F79E9', Z'3FD34413' /
  479. C
  480. C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER
  481. C
  482. C DATA SMALL(1), SMALL(2) / O000040000000, O000000000000 /
  483. C DATA LARGE(1), LARGE(2) / O377777777777, O777777777777 /
  484. C DATA RIGHT(1), RIGHT(2) / O170540000000, O000000000000 /
  485. C DATA DIVER(1), DIVER(2) / O170640000000, O000000000000 /
  486. C DATA LOG10(1), LOG10(2) / O177746420232, O411757177572 /
  487. C
  488. C***FIRST EXECUTABLE STATEMENT D1MACH
  489. IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'D1MACH',
  490. + 'I OUT OF BOUNDS', 1, 2)
  491. C
  492. if (iflag.eq.0) then
  493. iflag=1
  494. dmach(1)=dlamch('u')
  495. dmach(2)=dlamch('o')
  496. dmach(3)=dlamch('e')
  497. dmach(4)=dlamch('p')
  498. dmach(5)=dlamch('b')
  499. dmach(5)=log10(dmach(5))
  500. endif
  501. D1MACH = DMACH(I)
  502. RETURN
  503. C
  504. END