1! Program to test SELECTED_REAL_KIND intrinsic function.
2Program test_sr_kind
3  integer res, i4, i8, t
4  real*4 r4
5  real*8 r8
6
7  i4 = int (log10 (huge (r4)))
8  t = - int (log10 (tiny (r4)))
9  if (i4 .gt. t) i4 = t
10
11  i8 = int (log10 (huge (r8)))
12  t = - int (log10 (tiny (r8)))
13  if (i8 .gt. t) i8 = t
14
15  res = selected_real_kind (r = i4)
16  if (res .ne. 4) STOP 1
17
18  res = selected_real_kind (r = i8)
19  if (res .ne. 8) STOP 2
20
21! We can in fact have kinds wider than r8.  How do we want to check?
22! res = selected_real_kind (r = (i8 + 1))
23! if (res .ne. -2) STOP 3
24
25  res = selected_real_kind (p = precision (r4))
26  if (res .ne. 4) STOP 4
27
28  res = selected_real_kind (p = precision (r4), r = i4)
29  if (res .ne. 4) STOP 5
30
31  res = selected_real_kind (p = precision (r4), r = i8)
32  if (res .ne. 8) STOP 6
33
34! res = selected_real_kind (p = precision (r4), r = i8 + 1)
35! if (res .ne. -2) STOP 7
36
37  res = selected_real_kind (p = precision (r8))
38  if (res .ne. 8) STOP 8
39
40  res = selected_real_kind (p = precision (r8), r = i4)
41  if (res .ne. 8) STOP 9
42
43  res = selected_real_kind (p = precision (r8), r = i8)
44  if (res .ne. 8) STOP 10
45
46! res = selected_real_kind (p = precision (r8), r = i8 + 1)
47! if (res .ne. -2) STOP 11
48
49! res = selected_real_kind (p = (precision (r8) + 1))
50! if (res .ne. -1) STOP 12
51
52! res = selected_real_kind (p = (precision (r8) + 1), r = i4)
53! if (res .ne. -1) STOP 13
54
55! res = selected_real_kind (p = (precision (r8) + 1), r = i8)
56! if (res .ne. -1) STOP 14
57
58! res = selected_real_kind (p = (precision (r8) + 1), r = i8 + 1)
59! if (res .ne. -3) STOP 15
60
61end
62
63