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
|
DOUBLE PRECISION FUNCTION spmpar(i)
C-----------------------------------------------------------------------
C
C SPMPAR PROVIDES THE SINGLE PRECISION MACHINE CONSTANTS FOR
C THE COMPUTER BEING USED. IT IS ASSUMED THAT THE ARGUMENT
C I IS AN INTEGER HAVING ONE OF THE VALUES 1, 2, OR 3. IF THE
C SINGLE PRECISION ARITHMETIC BEING USED HAS M BASE B DIGITS AND
C ITS SMALLEST AND LARGEST EXPONENTS ARE EMIN AND EMAX, THEN
C
C SPMPAR(1) = B**(1 - M), THE MACHINE PRECISION,
C
C SPMPAR(2) = B**(EMIN - 1), THE SMALLEST MAGNITUDE,
C
C SPMPAR(3) = B**EMAX*(1 - B**(-M)), THE LARGEST MAGNITUDE.
C
C-----------------------------------------------------------------------
C WRITTEN BY
C ALFRED H. MORRIS, JR.
C NAVAL SURFACE WARFARE CENTER
C DAHLGREN VIRGINIA
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C MODIFIED BY BARRY W. BROWN TO RETURN DOUBLE PRECISION MACHINE
C CONSTANTS FOR THE COMPUTER BEING USED. THIS MODIFICATION WAS
C MADE AS PART OF CONVERTING BRATIO TO DOUBLE PRECISION
C-----------------------------------------------------------------------
C .. Scalar Arguments ..
INTEGER i
C ..
C .. Local Scalars ..
DOUBLE PRECISION b,binv,bm1,one,w,z
INTEGER emax,emin,ibeta,m
C ..
C .. External Functions ..
INTEGER ipmpar
EXTERNAL ipmpar
C ..
C .. Intrinsic Functions ..
INTRINSIC dble
C ..
C .. Executable Statements ..
C
IF (i.GT.1) GO TO 10
b = ipmpar(4)
m = ipmpar(8)
spmpar = b** (1-m)
RETURN
C
10 IF (i.GT.2) GO TO 20
b = ipmpar(4)
emin = ipmpar(9)
one = dble(1)
binv = one/b
w = b** (emin+2)
spmpar = ((w*binv)*binv)*binv
RETURN
C
20 ibeta = ipmpar(4)
m = ipmpar(8)
emax = ipmpar(10)
C
b = ibeta
bm1 = ibeta - 1
one = dble(1)
z = b** (m-1)
w = ((z-one)*b+bm1)/ (b*z)
C
z = b** (emax-2)
spmpar = ((w*z)*b)*b
RETURN
END
|
