compact_real_string Subroutine

  1. json_module.F90
  2. json_module
  3. compact_real_string

private subroutine compact_real_string(str)

Arguments

Type IntentOptional AttributesName
character(kind=CK,len=*), intent(inout) :: str

string representation of a real number.

Description

Compact a string representing a real number, so that the same value is displayed with fewer characters.

See also

Called By

proc~~compact_real_string~~CalledByGraph proc~compact_real_string compact_real_string proc~real_to_string real_to_string proc~real_to_string->proc~compact_real_string proc~json_value_print json_value_print proc~json_value_print->proc~real_to_string proc~json_value_print->proc~json_value_print proc~json_value_to_string json_value_to_string proc~json_value_to_string->proc~json_value_print proc~json_file_print_1 json_file_print_1 proc~json_file_print_1->proc~json_value_print proc~json_print_1 json_print_1 proc~json_print_1->proc~json_value_print proc~json_file_print_to_console json_file_print_to_console proc~json_file_print_to_console->proc~json_value_print proc~json_file_print_to_string json_file_print_to_string proc~json_file_print_to_string->proc~json_value_to_string interface~json_print_to_string json_print_to_string interface~json_print_to_string->proc~json_value_to_string proc~test_4 test_4 proc~test_4->interface~json_print_to_string interface~json_print json_print proc~test_4->interface~json_print program~jf_test_4 jf_test_4 program~jf_test_4->proc~test_4 interface~json_print->proc~json_print_1 proc~json_print_2 json_print_2 interface~json_print->proc~json_print_2 proc~test_7 test_7 proc~test_7->interface~json_print proc~test_2 test_2 proc~test_2->interface~json_print proc~test_12 test_12 proc~test_12->interface~json_print proc~test_8 test_8 proc~test_8->interface~json_print proc~test_14 test_14 proc~test_14->interface~json_print proc~json_print_2->interface~json_print program~jf_test_7 jf_test_7 program~jf_test_7->proc~test_7 program~jf_test_2 jf_test_2 program~jf_test_2->proc~test_2 program~jf_test_12 jf_test_12 program~jf_test_12->proc~test_12 program~jf_test_8 jf_test_8 program~jf_test_8->proc~test_8 program~jf_test_14 jf_test_14 program~jf_test_14->proc~test_14
Help

Variables

TypeVisibility AttributesNameInitial
character(kind=CK,len=len(str)), public :: significand
character(kind=CK,len=len(str)), public :: expnt
character(kind=CK,len=2), public :: separator
integer(kind=IK), public :: exp_start
integer(kind=IK), public :: decimal_pos
integer(kind=IK), public :: sig_trim
integer(kind=IK), public :: exp_trim
integer(kind=IK), public :: i

Source Code

    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, expnt
    character(kind=CK,len=2) :: separator
    integer(IK) :: exp_start,decimal_pos,sig_trim,exp_trim,i

    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