gtool5 Fortran 90/95 ライブラリ 1.0.0-rc5
English
Loading...
Searching...
No Matches
dc_string::roundnum Interface Reference

Public Member Functions

character(string) function roundnum (num)

Detailed Description

Definition at line 142 of file dc_string.f90.

Constructor & Destructor Documentation

◆ roundnum()

character(string) function dc_string::roundnum::roundnum ( character(*), intent(in) num)

数値文字列の端数を除去

'0.30000001' や '12.999998' などの丸め誤差によって端数が残っている 数値表記を '0.3' や '13.' などに整形して返します。

Parameters
[in]num端数を除去する数値文字列
Returns
整形された数値文字列

Definition at line 1831 of file dc_string.f90.

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 ! 0.30000001 などの末尾の 1 のような, ゴミの桁の数値を掃除し,
1858 ! 0.3000000 などに整形.
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 ! 0.30000001986 などの末尾の 1 以降のゴミの桁の数値を掃除し,
1868 ! 0.3000000 などに整形.
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 ! 0.3000000 などの末尾の 0 を掃除し,
1888 ! 0.3 などに整形.
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 ! 0.89999998 などの末尾の 8 のような, ゴミの桁の数値を掃除し,
1898 ! 0.8999999 などに整形.
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 ! 0.8999999 などの末尾の 9 を掃除し, 繰り上げて
1910 ! 0.9 などに整形.
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 ! 0.3000000 などの末尾の 0 を掃除し,
1943 ! 0.3 などに整形.
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

The documentation for this interface was generated from the following file: