home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / fortran / linpklib.arc / SMACH.FOR < prev    next >
Text File  |  1984-01-01  |  1KB  |  59 lines
  1.       REAL FUNCTION SMACH(JOB)
  2.       INTEGER JOB
  3. C
  4. C     SMACH COMPUTES MACHINE PARAMETERS OF FLOATING POINT
  5. C     ARITHMETIC FOR USE IN TESTING ONLY.  NOT REQUIRED BY
  6. C     LINPACK PROPER.
  7. C
  8. C     IF TROUBLE WITH AUTOMATIC COMPUTATION OF THESE QUANTITIES,
  9. C     THEY CAN BE SET BY DIRECT ASSIGNMENT STATEMENTS.
  10. C     ASSUME THE COMPUTER HAS
  11. C
  12. C        B = BASE OF ARITHMETIC
  13. C        T = NUMBER OF BASE  B  DIGITS
  14. C        L = SMALLEST POSSIBLE EXPONENT
  15. C        U = LARGEST POSSIBLE EXPONENT
  16. C
  17. C     THEN
  18. C
  19. C        EPS = B**(1-T)
  20. C        TINY = 100.0*B**(-L+T)
  21. C        HUGE = 0.01*B**(U-T)
  22. C
  23. C     SMACH SAME AS SMACH EXCEPT T, L, U APPLY TO
  24. C     REAL.
  25. C
  26. C     CMACH SAME AS SMACH EXCEPT IF COMPLEX DIVISION
  27. C     IS DONE BY
  28. C
  29. C        1/(X+I*Y) = (X-I*Y)/(X**2+Y**2)
  30. C
  31. C     THEN
  32. C
  33. C        TINY = SQRT(TINY)
  34. C        HUGE = SQRT(HUGE)
  35. C
  36. C
  37. C     JOB IS 1, 2 OR 3 FOR EPSILON, TINY AND HUGE, RESPECTIVELY.
  38. C
  39.       REAL EPS,TINY,HUGE,S
  40. C
  41.       EPS = 1.0E0
  42.    10 EPS = EPS/2.0E0
  43.       S = 1.0E0 + EPS
  44.       IF (S .GT. 1.0E0) GO TO 10
  45.       EPS = 2.0E0*EPS
  46. C
  47.       S = 1.0E0
  48.    20 TINY = S
  49.       S = S/16.0E0
  50.       IF (S*1.0 .NE. 0.0E0) GO TO 20
  51.       TINY = (TINY/EPS)*100.0
  52.       HUGE = 1.0E0/TINY
  53. C
  54.       IF (JOB .EQ. 1) SMACH = EPS
  55.       IF (JOB .EQ. 2) SMACH = TINY
  56.       IF (JOB .EQ. 3) SMACH = HUGE
  57.       RETURN
  58.       END
  59.