dc_string::roundnum Interface Reference

Private Member Functions

character(string) function roundnum (num)
 

Detailed Description

Definition at line 86 of file dc_string.f90.

Constructor & Destructor Documentation

◆ roundnum()

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

Definition at line 1408 of file dc_string.f90.

1408  !
1409  ! '0.30000001' や '12.999998' などの丸め誤差によって端数が残って
1410  ! しまっている数値表記を '0.3' や '13.' などに整形して返します.
1411  !
1412  character(*), intent(in):: num
1413  character(STRING):: nrv, enrv
1414  integer:: i, moving_up, nrvi, dig, zero_stream
1415  continue
1416  !
1417  ! 実数でないものについてはそのまま返す.
1418  !
1419  if ( scan('.', trim(num) ) == 0 ) then
1420  result = num
1421  return
1422  end if
1423  nrv = num
1424 
1425  !
1426  ! 指数部を避けておく.
1427  !
1428  enrv = ''
1429  i = scan(nrv, "eE", back=.true.)
1430  if ( i > 1 ) then
1431  enrv = nrv(i:)
1432  nrv(i:) = " "
1433  elseif ( i == 1 ) then
1434  result = nrv
1435  return
1436  end if
1437 
1438  !
1439  ! 0.30000001 などの末尾の 1 のような, ゴミの桁の数値を掃除し,
1440  ! 0.3000000 などに整形.
1441  !
1442  if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1443  do while ( index('567890.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1444  if ( len_trim(nrv) < 2 ) exit
1445  nrv = nrv(1:len_trim(nrv)-1)
1446  end do
1447  end if
1448 
1449  !
1450  ! 0.30000001986 などの末尾の 1 以降のゴミの桁の数値を掃除し,
1451  ! 0.3000000 などに整形.
1452  !
1453  if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1454  dig = index( trim( nrv ), '.') + 1
1455  zero_stream = 0
1456  do while ( dig < len_trim( nrv ) )
1457  if ( nrv(dig:dig) == "0" ) then
1458  zero_stream = zero_stream + 1
1459  else
1460  zero_stream = 0
1461  end if
1462  if ( zero_stream > 7 ) then
1463  nrv(dig:len_trim(nrv)) = '0'
1464  exit
1465  end if
1466  dig = dig + 1
1467  end do
1468  end if
1469 
1470  !
1471  ! 0.3000000 などの末尾の 0 を掃除し,
1472  ! 0.3 などに整形.
1473  !
1474  if ( index( trim( nrv ), '.') /= 0 ) then
1475  do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1476  if ( len_trim(nrv) < 2 ) exit
1477  nrv = nrv(1:len_trim(nrv)-1)
1478  end do
1479  end if
1480 
1481  !
1482  ! 0.89999998 などの末尾の 8 のような, ゴミの桁の数値を掃除し,
1483  ! 0.8999999 などに整形.
1484  !
1485  moving_up = 0
1486  if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
1487  do while ( index('12345690.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1488  if ( len_trim(nrv) < 2 ) exit
1489  nrv = nrv(1:len_trim(nrv)-1)
1490  end do
1491  moving_up = 1
1492  end if
1493 
1494  !
1495  ! 0.8999999 などの末尾の 9 を掃除し, 繰り上げて
1496  ! 0.9 などに整形.
1497  !
1498  if ( moving_up > 0 ) then
1499  do while ( index('012345678.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1500  if ( len_trim(nrv) < 2 ) exit
1501  nrv = nrv(1:len_trim(nrv)-1)
1502  end do
1503  end if
1504 
1505  i = len_trim(nrv)
1506  do while ( moving_up > 0 .and. i > 0 )
1507  if ( index('.', nrv(i:i)) /= 0 ) then
1508  i = i - 1
1509  cycle
1510  end if
1511  nrvi = stoi( nrv(i:i) ) + moving_up
1512 
1513  if ( nrvi < 10 ) then
1514  nrv(i:i) = trim( tochar( nrvi ) )
1515  exit
1516  else
1517  nrv(i:i) = '0'
1518  if ( i < 2 ) then
1519  nrv = '10'
1520  exit
1521  else
1522  i = i - 1
1523  cycle
1524  end if
1525  end if
1526  if ( len_trim(nrv) < 2 ) exit
1527  nrv = nrv(1:len_trim(nrv)-1)
1528  end do
1529 
1530  !
1531  ! 0.3000000 などの末尾の 0 を掃除し,
1532  ! 0.3 などに整形.
1533  !
1534  if ( index( trim( nrv ), '.') /= 0 ) then
1535  do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
1536  if ( len_trim(nrv) < 2 ) exit
1537  nrv = nrv(1:len_trim(nrv)-1)
1538  end do
1539  end if
1540 
1541  !
1542  ! 指数部を復帰する
1543  !
1544  if ( len_trim(enrv) > 0 ) then
1545  nrv = trim(nrv) // enrv
1546  end if
1547 
1548  result = nrv

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