Formats numeric strings like '0.30000001' or '12.999998' that have rounding errors to cleaner representations like '0.3' or '13.'.
1832 character(*), intent(in):: num
1833 character(STRING):: nrv, enrv
1834 integer:: i, moving_up, nrvi, dig, zero_stream
1835 continue
1836
1837
1838
1839 if ( scan('.', trim(num) ) == 0 ) then
1840 result = num
1841 return
1842 end if
1843 nrv = num
1844
1845
1846
1847 enrv = ''
1848 i = scan(nrv, "eE", back=.true.)
1849 if ( i > 1 ) then
1850 enrv = nrv(i:)
1851 nrv(i:) = " "
1852 elseif ( i == 1 ) then
1853 result = nrv
1854 return
1855 end if
1856
1857
1858
1859
1860 if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1861 do while ( index('567890.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1862 if ( len_trim(nrv) < 2 ) exit
1863 nrv = nrv(1:len_trim(nrv)-1)
1864 end do
1865 end if
1866
1867
1868
1869
1870 if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1871 dig = index( trim( nrv ), '.') + 1
1872 zero_stream = 0
1873 do while ( dig < len_trim( nrv ) )
1874 if ( nrv(dig:dig) == "0" ) then
1875 zero_stream = zero_stream + 1
1876 else
1877 zero_stream = 0
1878 end if
1879 if ( zero_stream > 7 ) then
1880 nrv(dig:len_trim(nrv)) = '0'
1881 exit
1882 end if
1883 dig = dig + 1
1884 end do
1885 end if
1886
1887
1888
1889
1890 if ( index( trim( nrv ), '.') /= 0 ) then
1891 do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1892 if ( len_trim(nrv) < 2 ) exit
1893 nrv = nrv(1:len_trim(nrv)-1)
1894 end do
1895 end if
1896
1897
1898
1899
1900 moving_up = 0
1901 if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1902 do while ( index('12345690.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1903 if ( len_trim(nrv) < 2 ) exit
1904 nrv = nrv(1:len_trim(nrv)-1)
1905 end do
1906 moving_up = 1
1907 end if
1908
1909
1910
1911
1912 if ( moving_up > 0 ) then
1913 do while ( index('012345678.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1914 if ( len_trim(nrv) < 2 ) exit
1915 nrv = nrv(1:len_trim(nrv)-1)
1916 end do
1917 end if
1918 i = len_trim(nrv)
1919 do while ( moving_up > 0 .and. i > 0 )
1920 if ( index('.', nrv(i:i)) /= 0 ) then
1921 i = i - 1
1922 cycle
1923 end if
1924 nrvi = stoi( nrv(i:i) ) + moving_up
1925 if ( nrvi < 10 ) then
1926 nrv(i:i) = trim( tochar( nrvi ) )
1927 exit
1928 else
1929 nrv(i:i) = '0'
1930 if ( i < 2 ) then
1931 nrv = '10'
1932 exit
1933 else
1934 i = i - 1
1935 cycle
1936 end if
1937 end if
1938 if ( len_trim(nrv) < 2 ) exit
1939 nrv = nrv(1:len_trim(nrv)-1)
1940 end do
1941
1942
1943
1944
1945 if ( index( trim( nrv ), '.') /= 0 ) then
1946 do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1947 if ( len_trim(nrv) < 2 ) exit
1948 nrv = nrv(1:len_trim(nrv)-1)
1949 end do
1950 end if
1951
1952
1953
1954 if ( len_trim(enrv) > 0 ) then
1955 nrv = trim(nrv) // enrv
1956 end if
1957 result = nrv