1module test_default_format 2 interface test 3 module procedure test_rl 4 end interface test 5 6 integer, parameter :: kl = selected_real_kind (precision (0.0_8) + 1) 7 integer, parameter :: count = 200 8 9contains 10 11 function test_rl (start, towards) result (res) 12 integer, parameter :: k = kl 13 integer, intent(in) :: towards 14 real(k), intent(in) :: start 15 16 integer :: res, i 17 real(k) :: x, y 18 character(len=100) :: s 19 20 res = 0 21 22 if (towards >= 0) then 23 x = start 24 do i = 0, count 25 write (s,*) x 26 read (s,*) y 27 if (y /= x) res = res + 1 28 x = nearest(x,huge(x)) 29 end do 30 end if 31 32 if (towards <= 0) then 33 x = start 34 do i = 0, count 35 write (s,*) x 36 read (s,*) y 37 if (y /= x) res = res + 1 38 x = nearest(x,-huge(x)) 39 end do 40 end if 41 end function test_rl 42 43end module test_default_format 44