@@ -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