r1mach.f90
2.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
!DECK R1MACH
REAL FUNCTION R1MACH (I)
IMPLICIT NONE
INTEGER :: I
REAL :: B, X
!***BEGIN PROLOGUE R1MACH
!***PURPOSE Return floating point machine dependent constants.
!***LIBRARY SLATEC
!***CATEGORY R1
!***TYPE SINGLE PRECISION (R1MACH-S, D1MACH-D)
!***KEYWORDS MACHINE CONSTANTS
!***AUTHOR Fox, P. A., (Bell Labs)
! Hall, A. D., (Bell Labs)
! Schryer, N. L., (Bell Labs)
!***DESCRIPTION
!
! R1MACH can be used to obtain machine-dependent parameters for the
! local machine environment. It is a function subprogram with one
! (input) argument, and can be referenced as follows:
!
! A = R1MACH(I)
!
! where I=1,...,5. The (output) value of A above is determined by
! the (input) value of I. The results for various values of I are
! discussed below.
!
! R1MACH(1) = B**(EMIN-1), the smallest positive magnitude.
! R1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
! R1MACH(3) = B**(-T), the smallest relative spacing.
! R1MACH(4) = B**(1-T), the largest relative spacing.
! R1MACH(5) = LOG10(B)
!
! Assume single precision numbers are represented in the T-digit,
! base-B form
!
! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
!
! where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
! EMIN .LE. E .LE. EMAX.
!
! The values of B, T, EMIN and EMAX are provided in I1MACH as
! follows:
! I1MACH(10) = B, the base.
! I1MACH(11) = T, the number of base-B digits.
! I1MACH(12) = EMIN, the smallest exponent E.
! I1MACH(13) = EMAX, the largest exponent E.
!
!
!***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
! a portable library, ACM Transactions on Mathematical
! Software 4, 2 (June 1978), pp. 177-188.
!***ROUTINES CALLED XERMSG
!***REVISION HISTORY (YYMMDD)
! 790101 DATE WRITTEN
! 960329 Modified for Fortran 90 (BE after suggestions by EG)
!***END PROLOGUE R1MACH
!
X = 1.0
B = RADIX(X)
SELECT CASE (I)
CASE (1)
R1MACH = B**(MINEXPONENT(X)-1) ! the smallest positive magnitude.
CASE (2)
R1MACH = HUGE(X) ! the largest magnitude.
CASE (3)
R1MACH = B**(-DIGITS(X)) ! the smallest relative spacing.
CASE (4)
R1MACH = B**(1-DIGITS(X)) ! the largest relative spacing.
CASE (5)
R1MACH = LOG10(B)
CASE DEFAULT
WRITE (*, FMT = 9000)
9000 FORMAT ('1ERROR 1 IN R1MACH - I OUT OF BOUNDS')
STOP
END SELECT
RETURN
END