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