Thanks for keeping an eye on this case. I can confirm that the program from the first post now runs correctly. But unfortunately, the following, slightly modified program outputs again some differences:
program test
!
use :: iso_fortran_env
!
implicit none
!
character(len=32) :: cdec, chex
real(real64) :: ddec, dhex
integer(int64) :: i, ib, ie
!
ib = shiftl(1_int64, 52) ! 4’503’599’627’370’496 (53 bits)
ie = ib + 15_int64
!
do i = ib, ie
! Add 0.5 to the integer number.
write (cdec, '(i0,a)') i, '.5'
write (chex, '(a,z0,a)') '0x', i, '.8p0'
read (cdec, *) ddec
read (chex, *) dhex
if (ddec /= dhex) then
write (*, '(/a)') '----- Difference detected -----'
write (*, '(2a,t50,es23.16,2x,z16.16)') &
'Decimal-significand : ', trim(cdec), ddec, ddec
write (*, '(2a,t50,es23.16,2x,z16.16)') &
'Hexadecimal-significand: ', trim(chex), dhex, dhex
end if
end do
!
end program test
Running the program on Windows 10 Pro, compiled with the Intel compiler ifx, version 2025.0.1, results in this output:
----- Difference detected -----
Decimal-significand : 4503599627370496.5 4.5035996273704970E+15 4330000000000001
Hexadecimal-significand: 0x10000000000000.8p0 4.5035996273704960E+15 4330000000000000
----- Difference detected -----
Decimal-significand : 4503599627370498.5 4.5035996273704990E+15 4330000000000003
Hexadecimal-significand: 0x10000000000002.8p0 4.5035996273704980E+15 4330000000000002
----- Difference detected -----
Decimal-significand : 4503599627370500.5 4.5035996273705010E+15 4330000000000005
Hexadecimal-significand: 0x10000000000004.8p0 4.5035996273705000E+15 4330000000000004
----- Difference detected -----
Decimal-significand : 4503599627370502.5 4.5035996273705030E+15 4330000000000007
Hexadecimal-significand: 0x10000000000006.8p0 4.5035996273705020E+15 4330000000000006
----- Difference detected -----
Decimal-significand : 4503599627370504.5 4.5035996273705050E+15 4330000000000009
Hexadecimal-significand: 0x10000000000008.8p0 4.5035996273705040E+15 4330000000000008
----- Difference detected -----
Decimal-significand : 4503599627370506.5 4.5035996273705070E+15 433000000000000B
Hexadecimal-significand: 0x1000000000000A.8p0 4.5035996273705060E+15 433000000000000A
----- Difference detected -----
Decimal-significand : 4503599627370508.5 4.5035996273705090E+15 433000000000000D
Hexadecimal-significand: 0x1000000000000C.8p0 4.5035996273705080E+15 433000000000000C
----- Difference detected -----
Decimal-significand : 4503599627370510.5 4.5035996273705110E+15 433000000000000F
Hexadecimal-significand: 0x1000000000000E.8p0 4.5035996273705100E+15 433000000000000E
It seems that the hexadecimal numbers are correctly rounded, but the decimal numbers are not!
Another way to test the correct reading of double precision floating point numbers is to use the data files from this Github project: https://github.com/nigeltao/parse-number-fxx-test-data/. The following program reads a test data file and verifies the conversion. The conversion can be done by the C function strtod() or by internal read:
program verify_dbl
!
use :: iso_c_binding
use :: iso_fortran_env
!
implicit none
!
interface
function strtod(string, final) bind(C, name='strtod')
use :: iso_c_binding
implicit none
real(c_double) :: strtod
character(c_char) :: string(*)
type(c_ptr), optional :: final
end function strtod
end interface
!
character(len=4096) :: buff
character(len=512) :: inp_file
character(len=10) :: cmode
real(real64) :: dval1, dval2
integer :: blen, istat, lun, n_tests, n_success, n_failed
logical :: use_strtod
!
! Get the conversion mode.
if (command_argument_count() < 1) stop 'Error: missing conversion mode.'
call get_command_argument(1, cmode)
if (cmode == 'internal') then
use_strtod = .false.
else if (cmode == 'strtod') then
use_strtod = .true.
else
stop 'Error: invalid conversion mode, use internal or strtod.'
end if
!
! Open the input file.
if (command_argument_count() < 2) stop 'Error: missing input filename.'
call get_command_argument(2, inp_file)
open (newunit = lun, &
file = trim(inp_file), &
form = 'formatted', &
status = 'old' )
!
! Perform conversion tests.
n_tests = 0; n_success = 0; n_failed = 0
do
read (lun, '(14x,z16,1x,a)', iostat=istat) dval1, buff
if (istat /= 0) exit
blen = len_trim(buff)
if (use_strtod) then
buff(blen+1:blen+1) = c_null_char
dval2 = strtod(buff)
else
read (buff(1:blen), *, iostat=istat) dval2
end if
n_tests = n_tests + 1
if (dval1 == dval2) then
n_success = n_success + 1
else
n_failed = n_failed + 1
end if
end do
close (lun)
!
write (*, '(a,1x,a)' ) 'Results for file:', trim(inp_file)
write (*, '(a,1x,a)' ) 'Compiler version:', compiler_version()
write (*, '(a,1x,a)' ) 'Compiler options:', compiler_options()
write (*, '(a,1x,a)' ) 'Conversion mode :', trim(cmode)
write (*, '(a,1x,i10)') 'Success tests :', n_success
write (*, '(a,1x,i10)') 'Failed tests :', n_failed
write (*, '(a,1x,i10)') 'Total tests :', n_tests
!
end program verify_dbl
Running this program with the conversion mode “strtod” and the data file “remyoudompheng-fptest-0.txt” outputs the following:
$ verify_dbl strtod remyoudompheng-fptest-0.txt
Results for file: .remyoudompheng-fptest-0.txt
Compiler version: Intel(R) Fortran Compiler for applications running on Intel(R) 64, Version 2025.0.1 Build 20241113
Compiler options: /warn:all /O2
Conversion mode : strtod
Success tests : 1000000
Failed tests : 0
Total tests : 1000000
As you can see, all tests passed! Running the test with conversion mode “internal”, gives the following output:
$ verify_dbl internal remyoudompheng-fptest-0.txt
Results for file: remyoudompheng-fptest-0.txt
Compiler version: Intel(R) Fortran Compiler for applications running on Intel(R) 64, Version 2025.0.1 Build 20241113
Compiler options: /warn:all /O2
Conversion mode : internal
Success tests : 502582
Failed tests : 497418
Total tests : 1000000
A lot of tests failed! I think, it shouldn’t matter if the conversion is done by the “strtod()” C function or by the internal Fortran read statement.
The test data files can be found in the “data” folder of the Github project.
It seems, Intel fixed only a part of the problem.