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