round_decimal Subroutine

private pure subroutine round_decimal(exact, n_exact, n_keep, rounded, n_rounded, bump)

Round an exact digit string to n_keep leading digits, half to even.

bump is one when the rounding carried out of the leading digit (for example 999 becoming 1000), in which case the caller must advance the decimal point by one.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: exact
integer(kind=default_int), intent(in) :: n_exact
integer(kind=default_int), intent(in) :: n_keep
character(len=*), intent(out) :: rounded
integer(kind=default_int), intent(out) :: n_rounded
integer(kind=default_int), intent(out) :: bump

Calls

proc~~round_decimal~~CallsGraph proc~round_decimal round_decimal proc~increment_digits increment_digits proc~round_decimal->proc~increment_digits

Called by

proc~~round_decimal~~CalledByGraph proc~round_decimal round_decimal proc~to_string_fixed_dp to_string_fixed_dp proc~to_string_fixed_dp->proc~round_decimal proc~to_string_sci_dp to_string_sci_dp proc~to_string_sci_dp->proc~round_decimal interface~to_string_fixed to_string_fixed interface~to_string_fixed->proc~to_string_fixed_dp proc~to_string_fixed_sp to_string_fixed_sp interface~to_string_fixed->proc~to_string_fixed_sp interface~to_string_sci to_string_sci interface~to_string_sci->proc~to_string_sci_dp proc~to_string_sci_sp to_string_sci_sp interface~to_string_sci->proc~to_string_sci_sp proc~to_string_fixed_sp->proc~to_string_fixed_dp proc~to_string_sci_sp->proc~to_string_sci_dp

Variables

Type Visibility Attributes Name Initial
integer(kind=default_int), private :: i
logical, private :: last_odd
character(len=1), private :: next_digit
logical, private :: rest_nonzero
logical, private :: round_up

Source Code

   pure subroutine round_decimal(exact, n_exact, n_keep, rounded, n_rounded, bump)
      !! Round an exact digit string to `n_keep` leading digits, half to even.
      !!
      !! `bump` is one when the rounding carried out of the leading digit (for
      !! example `999` becoming `1000`), in which case the caller must advance
      !! the decimal point by one.
      character(len=*), intent(in) :: exact
      integer(default_int), intent(in) :: n_exact, n_keep
      character(len=*), intent(out) :: rounded
      integer(default_int), intent(out) :: n_rounded, bump
      integer(default_int) :: i
      logical :: round_up, rest_nonzero, last_odd
      character(len=1) :: next_digit

      rounded = ""
      bump = 0_default_int

      if (n_keep < 0_default_int) then
         ! Every digit lies below the rounding position, so the value is zero
         ! to the requested precision and cannot round up.
         n_rounded = 0_default_int
         return
      end if

      if (n_keep >= n_exact) then
         ! Nothing to discard; pad with the zeros that follow the expansion.
         rounded(1:n_exact) = exact(1:n_exact)
         do i = n_exact + 1_default_int, n_keep
            rounded(i:i) = "0"
         end do
         n_rounded = n_keep
         return
      end if

      if (n_keep > 0_default_int) rounded(1:n_keep) = exact(1:n_keep)
      n_rounded = n_keep

      next_digit = exact(n_keep + 1:n_keep + 1)
      rest_nonzero = .false.
      do i = n_keep + 2_default_int, n_exact
         if (exact(i:i) /= "0") then
            rest_nonzero = .true.
            exit
         end if
      end do

      if (next_digit > "5") then
         round_up = .true.
      else if (next_digit < "5") then
         round_up = .false.
      else if (rest_nonzero) then
         round_up = .true.
      else
         ! Exact tie: round to even. With no retained digit the implied value
         ! is zero, which is even.
         if (n_keep == 0_default_int) then
            last_odd = .false.
         else
            last_odd = index(ODD_DIGITS, rounded(n_keep:n_keep)) > 0
         end if
         round_up = last_odd
      end if

      if (round_up) call increment_digits(rounded, n_rounded, bump)

   end subroutine round_decimal