1module test_default_format
2  interface test
3    module procedure test_r4
4    module procedure test_r8
5  end interface test
6
7  integer, parameter :: count = 200
8
9contains
10  function test_r4 (start, towards) result (res)
11    integer, parameter :: k = 4
12    integer, intent(in) :: towards
13    real(k), intent(in) :: start
14
15    integer :: res, i
16    real(k) :: x, y
17    character(len=100) :: s
18
19    res = 0
20
21    if (towards >= 0) then
22      x = start
23      do i = 0, count
24        write (s,*) x
25        read (s,*) y
26        if (y /= x) res = res + 1
27        x = nearest(x,huge(x))
28      end do
29    end if
30
31    if (towards <= 0) then
32      x = start
33      do i = 0, count
34        write (s,*) x
35        read (s,*) y
36        if (y /= x) res = res + 1
37        x = nearest(x,-huge(x))
38      end do
39    end if
40  end function test_r4
41
42  function test_r8 (start, towards) result (res)
43    integer, parameter :: k = 8
44    integer, intent(in) :: towards
45    real(k), intent(in) :: start
46
47    integer :: res, i
48    real(k) :: x, y
49    character(len=100) :: s
50
51    res = 0
52
53    if (towards >= 0) then
54      x = start
55      do i = 0, count
56        write (s,*) x
57        read (s,*) y
58        if (y /= x) res = res + 1
59        x = nearest(x,huge(x))
60      end do
61    end if
62
63    if (towards <= 0) then
64      x = start
65      do i = 0, count
66        write (s,*) x
67        read (s,*) y
68        if (y /= x) res = res + 1
69        x = nearest(x,-huge(x))
70      end do
71    end if
72  end function test_r8
73
74end module test_default_format
75