@@ -542,7 +542,11 @@ end subroutine array_callback_func
542
542
! Note: the following global variables make this module non thread safe.
543
543
!
544
544
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
+
546
550
! exception handling [private variables]
547
551
logical (LK) :: is_verbose = .false. ! if true, all exceptions are immediately printed to console
548
552
logical (LK) :: exception_thrown = .false. ! the error flag
@@ -1250,23 +1254,35 @@ end subroutine json_file_get_string_vec
1250
1254
!
1251
1255
! SOURCE
1252
1256
1253
- subroutine json_initialize (verbose )
1257
+ subroutine json_initialize (verbose , compact_reals )
1254
1258
1255
1259
implicit none
1256
1260
1257
1261
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
+
1258
1264
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
1261
1266
1262
1267
! clear any errors from previous runs:
1263
1268
call json_clear_exceptions()
1264
1269
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
1270
1286
1271
1287
! Just in case, clear these global variables also:
1272
1288
pushed_index = 0
@@ -5375,55 +5391,67 @@ subroutine real_to_string(rval,str)
5375
5391
character (kind= CK,len= 2 ) :: separator
5376
5392
integer (IK) :: istat, exp_start, decimal_pos, sig_trim, exp_trim, i
5377
5393
5394
+ ! default format:
5378
5395
write (str,fmt= real_fmt,iostat= istat) rval
5379
5396
5380
5397
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
5412
5434
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 :))
5420
5439
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:)))
5425
5451
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
5427
5455
5428
5456
end if
5429
5457
0 commit comments