@@ -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,37 @@ 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
+
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
1270
1288
1271
1289
! Just in case, clear these global variables also:
1272
1290
pushed_index = 0
@@ -5375,55 +5393,67 @@ subroutine real_to_string(rval,str)
5375
5393
character (kind= CK,len= 2 ) :: separator
5376
5394
integer (IK) :: istat, exp_start, decimal_pos, sig_trim, exp_trim, i
5377
5395
5396
+ ! default format:
5378
5397
write (str,fmt= real_fmt,iostat= istat) rval
5379
5398
5380
5399
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
5412
5436
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 :))
5420
5441
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:)))
5425
5453
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
5427
5457
5428
5458
end if
5429
5459
0 commit comments