Skip to content

Commit 34f1cdb

Browse files
committed
Merge pull request #61 from jacobwilliams/string-tests
Updates to new real number formatting feature
2 parents c80f573 + ea4e9aa commit 34f1cdb

File tree

1 file changed

+80
-52
lines changed

1 file changed

+80
-52
lines changed

src/json_module.f90

Lines changed: 80 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -542,7 +542,11 @@ end subroutine array_callback_func
542542
! Note: the following global variables make this module non thread safe.
543543
!
544544

545-
character(kind=CK,len=:),allocatable :: real_fmt
545+
!real string printing:
546+
character(kind=CK,len=:),allocatable :: real_fmt !the format string to use for real numbers
547+
! [set in json_initialize]
548+
logical(LK) :: compact_real = .true. !to use the "compact" form of real numbers for output
549+
546550
!exception handling [private variables]
547551
logical(LK) :: is_verbose = .false. !if true, all exceptions are immediately printed to console
548552
logical(LK) :: exception_thrown = .false. !the error flag
@@ -1250,23 +1254,35 @@ end subroutine json_file_get_string_vec
12501254
!
12511255
! SOURCE
12521256

1253-
subroutine json_initialize(verbose)
1257+
subroutine json_initialize(verbose,compact_reals)
12541258

12551259
implicit none
12561260

12571261
logical(LK),intent(in),optional :: verbose !mainly useful for debugging (default is false)
1262+
logical(LK),intent(in),optional :: compact_reals !to compact the real number strings for output
1263+
12581264
character(kind=CK,len=10) :: w,d,e
1259-
!optional input (if not present, value remains unchanged):
1260-
if (present(verbose)) is_verbose = verbose
1265+
integer(IK) :: istat
12611266

12621267
!clear any errors from previous runs:
12631268
call json_clear_exceptions()
12641269

1265-
! set the output/input format for reals:
1266-
write(w,'(I0)') max_numeric_str_len
1267-
write(d,'(I0)') real_precision
1268-
write(e,'(I0)') real_exponent_digits
1269-
real_fmt = '(e' // trim(w) // '.' // trim(d) // 'e' // trim(e) // ')'
1270+
!optional inputs (if not present, values remains unchanged):
1271+
if (present(verbose)) is_verbose = verbose
1272+
if (present(compact_reals)) compact_real = compact_reals !may be a bug here in Gfortran 5.0.0... check this...
1273+
1274+
! set the default output/input format for reals:
1275+
! [this only needs to be done once, since it can't change]
1276+
if (.not. allocated(real_fmt)) then
1277+
write(w,'(I0)',iostat=istat) max_numeric_str_len
1278+
if (istat==0) write(d,'(I0)',iostat=istat) real_precision
1279+
if (istat==0) write(e,'(I0)',iostat=istat) real_exponent_digits
1280+
if (istat==0) then
1281+
real_fmt = '(E' // trim(w) // '.' // trim(d) // 'E' // trim(e) // ')'
1282+
else
1283+
real_fmt = '(E30.16E3)' !just use this one (should never happen)
1284+
end if
1285+
end if
12701286

12711287
!Just in case, clear these global variables also:
12721288
pushed_index = 0
@@ -5375,55 +5391,67 @@ subroutine real_to_string(rval,str)
53755391
character(kind=CK,len=2) :: separator
53765392
integer(IK) :: istat, exp_start, decimal_pos, sig_trim, exp_trim, i
53775393

5394+
!default format:
53785395
write(str,fmt=real_fmt,iostat=istat) rval
53795396

53805397
if (istat==0) then
5381-
str = adjustl(str)
5382-
exp_start = scan(str,CK_'eEdD')
5383-
if (exp_start == 0) exp_start = scan(str,CK_'-+',back=.true.)
5384-
decimal_pos = scan(str,CK_'.')
5385-
if (exp_start /= 0) separator = str(exp_start:exp_start)
5386-
if (exp_start > 0 .and. exp_start < decimal_pos) then !signed, exponent-less float
5387-
significand = str
5388-
sig_trim = len(trim(significand))
5389-
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5390-
!but save one after the decimal place
5391-
if (significand(i:i) == CK_'0') then
5392-
sig_trim = i-1
5393-
else
5394-
exit
5395-
end if
5396-
end do
5397-
str = trim(significand(1:sig_trim))
5398-
else if (exp_start > decimal_pos) then !float has exponent
5399-
significand = str(1:exp_start-1)
5400-
sig_trim = len(trim(significand))
5401-
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5402-
if (significand(i:i) == CK_'0') then
5403-
sig_trim = i-1
5404-
else
5405-
exit
5406-
end if
5407-
end do
5408-
expnt = adjustl(str(exp_start+1:))
5409-
if (expnt(1:1) == CK_'+' .or. expnt(1:1) == CK_'-') then
5410-
separator = trim(adjustl(separator))//expnt(1:1)
5411-
exp_start = exp_start + 1
5398+
5399+
!in this case, the default string will be compacted,
5400+
! so that the same value is displayed with fewer characters.
5401+
if (compact_real) then
5402+
5403+
str = adjustl(str)
5404+
exp_start = scan(str,CK_'eEdD')
5405+
if (exp_start == 0) exp_start = scan(str,CK_'-+',back=.true.)
5406+
decimal_pos = scan(str,CK_'.')
5407+
if (exp_start /= 0) separator = str(exp_start:exp_start)
5408+
5409+
if (exp_start > 0 .and. exp_start < decimal_pos) then !signed, exponent-less float
5410+
5411+
significand = str
5412+
sig_trim = len(trim(significand))
5413+
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5414+
!but save one after the decimal place
5415+
if (significand(i:i) == CK_'0') then
5416+
sig_trim = i-1
5417+
else
5418+
exit
5419+
end if
5420+
end do
5421+
str = trim(significand(1:sig_trim))
5422+
5423+
else if (exp_start > decimal_pos) then !float has exponent
5424+
5425+
significand = str(1:exp_start-1)
5426+
sig_trim = len(trim(significand))
5427+
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5428+
if (significand(i:i) == CK_'0') then
5429+
sig_trim = i-1
5430+
else
5431+
exit
5432+
end if
5433+
end do
54125434
expnt = adjustl(str(exp_start+1:))
5413-
end if
5414-
exp_trim = 1
5415-
do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last
5416-
if (expnt(i:i) == CK_'0') then
5417-
exp_trim = i+1
5418-
else
5419-
exit
5435+
if (expnt(1:1) == CK_'+' .or. expnt(1:1) == CK_'-') then
5436+
separator = trim(adjustl(separator))//expnt(1:1)
5437+
exp_start = exp_start + 1
5438+
expnt = adjustl(str(exp_start+1:))
54205439
end if
5421-
end do
5422-
str = trim(adjustl(significand(1:sig_trim)))// &
5423-
trim(adjustl(separator))// &
5424-
trim(adjustl(expnt(exp_trim:)))
5440+
exp_trim = 1
5441+
do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last
5442+
if (expnt(i:i) == CK_'0') then
5443+
exp_trim = i+1
5444+
else
5445+
exit
5446+
end if
5447+
end do
5448+
str = trim(adjustl(significand(1:sig_trim)))// &
5449+
trim(adjustl(separator))// &
5450+
trim(adjustl(expnt(exp_trim:)))
54255451

5426-
!else ! mal-formed real, BUT this code should be unreachable
5452+
!else ! mal-formed real, BUT this code should be unreachable
5453+
5454+
end if
54275455

54285456
end if
54295457

0 commit comments

Comments
 (0)