Skip to content

Commit 17ddd86

Browse files
committed
added optional flag to use the new compact real format. some additional error checks.
1 parent c80f573 commit 17ddd86

File tree

1 file changed

+82
-52
lines changed

1 file changed

+82
-52
lines changed

src/json_module.f90

Lines changed: 82 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,37 @@ 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+
1273+
!....... gfortran 5.0.0 bug???? seems to be true, even when not present !!!!!
1274+
if (present(compact_reals)) compact_real = compact_reals
1275+
1276+
! set the default output/input format for reals:
1277+
! [this only needs to be done once, since it can't change]
1278+
if (.not. allocated(real_fmt)) then
1279+
write(w,'(I0)',iostat=istat) max_numeric_str_len
1280+
if (istat==0) write(d,'(I0)',iostat=istat) real_precision
1281+
if (istat==0) write(e,'(I0)',iostat=istat) real_exponent_digits
1282+
if (istat==0) then
1283+
real_fmt = '(E' // trim(w) // '.' // trim(d) // 'E' // trim(e) // ')'
1284+
else
1285+
real_fmt = '(E30.16E3)' !just use this one (should never happen)
1286+
end if
1287+
end if
12701288

12711289
!Just in case, clear these global variables also:
12721290
pushed_index = 0
@@ -5375,55 +5393,67 @@ subroutine real_to_string(rval,str)
53755393
character(kind=CK,len=2) :: separator
53765394
integer(IK) :: istat, exp_start, decimal_pos, sig_trim, exp_trim, i
53775395

5396+
!default format:
53785397
write(str,fmt=real_fmt,iostat=istat) rval
53795398

53805399
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
5400+
5401+
!in this case, the default string will be compacted,
5402+
! so that the same value is displayed with fewer characters.
5403+
if (compact_real) then
5404+
5405+
str = adjustl(str)
5406+
exp_start = scan(str,CK_'eEdD')
5407+
if (exp_start == 0) exp_start = scan(str,CK_'-+',back=.true.)
5408+
decimal_pos = scan(str,CK_'.')
5409+
if (exp_start /= 0) separator = str(exp_start:exp_start)
5410+
5411+
if (exp_start > 0 .and. exp_start < decimal_pos) then !signed, exponent-less float
5412+
5413+
significand = str
5414+
sig_trim = len(trim(significand))
5415+
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5416+
!but save one after the decimal place
5417+
if (significand(i:i) == CK_'0') then
5418+
sig_trim = i-1
5419+
else
5420+
exit
5421+
end if
5422+
end do
5423+
str = trim(significand(1:sig_trim))
5424+
5425+
else if (exp_start > decimal_pos) then !float has exponent
5426+
5427+
significand = str(1:exp_start-1)
5428+
sig_trim = len(trim(significand))
5429+
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s
5430+
if (significand(i:i) == CK_'0') then
5431+
sig_trim = i-1
5432+
else
5433+
exit
5434+
end if
5435+
end do
54125436
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
5437+
if (expnt(1:1) == CK_'+' .or. expnt(1:1) == CK_'-') then
5438+
separator = trim(adjustl(separator))//expnt(1:1)
5439+
exp_start = exp_start + 1
5440+
expnt = adjustl(str(exp_start+1:))
54205441
end if
5421-
end do
5422-
str = trim(adjustl(significand(1:sig_trim)))// &
5423-
trim(adjustl(separator))// &
5424-
trim(adjustl(expnt(exp_trim:)))
5442+
exp_trim = 1
5443+
do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last
5444+
if (expnt(i:i) == CK_'0') then
5445+
exp_trim = i+1
5446+
else
5447+
exit
5448+
end if
5449+
end do
5450+
str = trim(adjustl(significand(1:sig_trim)))// &
5451+
trim(adjustl(separator))// &
5452+
trim(adjustl(expnt(exp_trim:)))
54255453

5426-
!else ! mal-formed real, BUT this code should be unreachable
5454+
!else ! mal-formed real, BUT this code should be unreachable
5455+
5456+
end if
54275457

54285458
end if
54295459

0 commit comments

Comments
 (0)