Compact a string representing a real number, so that the same value is displayed with fewer characters.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(kind=CK,len=*), | intent(inout) | :: | str | string representation of a real number. |
subroutine compact_real_string(str)
implicit none
character(kind=CK,len=*),intent(inout) :: str !! string representation of a real number.
character(kind=CK,len=len(str)) :: significand
character(kind=CK,len=len(str)) :: expnt
character(kind=CK,len=2) :: separator
integer(IK) :: exp_start
integer(IK) :: decimal_pos
integer(IK) :: sig_trim
integer(IK) :: exp_trim
integer(IK) :: i !! counter
str = adjustl(str)
exp_start = scan(str,CK_'eEdD')
if (exp_start == 0) exp_start = scan(str,CK_'-+',back=.true.)
decimal_pos = scan(str,CK_'.')
if (exp_start /= 0) separator = str(exp_start:exp_start)
if ( exp_start < decimal_pos ) then !possibly signed, exponent-less float
significand = str
sig_trim = len(trim(significand))
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
!but save one after the decimal place
if (significand(i:i) == '0') then
sig_trim = i-1
else
exit
end if
end do
str = trim(significand(1:sig_trim))
else if (exp_start > decimal_pos) then !float has exponent
significand = str(1:exp_start-1)
sig_trim = len(trim(significand))
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
if (significand(i:i) == '0') then
sig_trim = i-1
else
exit
end if
end do
expnt = adjustl(str(exp_start+1:))
if (expnt(1:1) == '+' .or. expnt(1:1) == '-') then
separator = trim(adjustl(separator))//expnt(1:1)
exp_start = exp_start + 1
expnt = adjustl(str(exp_start+1:))
end if
exp_trim = 1
do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last
if (expnt(i:i) == '0') then
exp_trim = i+1
else
exit
end if
end do
str = trim(adjustl(significand(1:sig_trim)))// &
trim(adjustl(separator))// &
trim(adjustl(expnt(exp_trim:)))
!else ! mal-formed real, BUT this code should be unreachable
end if
end subroutine compact_real_string