Skip to content

GitLab

Commit 9d17440e authored by Marco Govoni's avatar Marco Govoni
Browse files

Merge branch 'develop' of http://greatfire.uchicago.edu/west-devel/West into dfpt_band_parallel

parents 99bb2a17 6e13d0ca
Expand all Show whitespace changes
Inline Side-by-side
IO_kernel/pdep_db.f90
View file @ 9d17440e
......@@ -160,7 +160,7 @@ MODULE pdep_db
CALL json%add("dielectric_matrix.pdep",jval)
!
OPEN(NEWUNIT= iunit, FILE= summary_file )
CALL json%print_file( iunit )
CALL json%print( iunit )
CLOSE( iunit )
!
CALL json%destroy()
......@@ -173,7 +173,7 @@ MODULE pdep_db
IF ( mpime == root ) THEN
!
CALL json%initialize()
CALL json%load_file( filename = summary_file )
CALL json%load( filename = summary_file )
!
CALL json%info('dielectric_matrix.pdep',n_children=n_elements)
write_element = n_elements + 1
......@@ -193,7 +193,7 @@ MODULE pdep_db
CALL json%add('dielectric_matrix.pdep('//TRIM(ADJUSTL(label_i))//').eigenvec' , eigenpot_filename(1:n_pdep_eigen))
!
OPEN( NEWUNIT=iunit, FILE=summary_file )
CALL json%print_file( iunit )
CALL json%print( iunit )
CLOSE( iunit )
CALL json%destroy()
!
......@@ -321,7 +321,7 @@ MODULE pdep_db
IF ( mpime == root ) THEN
!
CALL json%initialize()
CALL json%load_file( filename = TRIM(ADJUSTL(wstat_save_dir)) // "/summary.json" )
CALL json%load( filename = TRIM(ADJUSTL(wstat_save_dir)) // "/summary.json" )
IF( json%failed() ) THEN
CALL errore("", "Cannot open: " // TRIM(ADJUSTL(wstat_save_dir)) // "/summary.json", 1 )
ENDIF
......
IO_kernel/wfreq_db.f90
View file @ 9d17440e
......@@ -72,7 +72,7 @@ MODULE wfreq_db
!
CALL json%initialize()
!
CALL json%load_file(filename=TRIM(logfile))
CALL json%load(filename=TRIM(logfile))
!
l_generate_plot = .FALSE.
l_optics = .FALSE.
......@@ -157,7 +157,7 @@ MODULE wfreq_db
ENDDO
!
OPEN( NEWUNIT=iunit, FILE=TRIM( logfile ) )
CALL json%print_file( iunit )
CALL json%print( iunit )
CLOSE( iunit )
CALL json%destroy()
!
......
Libraries/Json/README
View file @ 9d17440e
==========================================
Based on the library: json-fortran v 6.3.0
Based on the library: json-fortran v 8.2.1
==========================================
JSON-Fortran: A Fortran 2008 JSON API
<https://github.com/jacobwilliams/json-fortran>
Copyright (c) 2014-2018, Jacob Williams
Copyright (c) 2014-2020, Jacob Williams
All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
......
Libraries/Json/json_file_module.f90
View file @ 9d17440e
This diff is collapsed.
Libraries/Json/json_get_scalar_by_path.inc 0 → 100644
View file @ 9d17440e
type(json_value),pointer :: p
if (present(default)) then
value = default
else
value = default_if_not_specified
end if
if ( json%exception_thrown ) then
call flag_not_found(found)
return
end if
nullify(p)
call json%get(me=me, path=path, p=p)
if (.not. associated(p)) then
call json%throw_exception('Error in '//routine//':'//&
' Unable to resolve path: '// trim(path),found)
else
call json%get(p,value)
end if
if ( json%exception_thrown ) then
if ( present(found) .or. present(default)) then
call flag_not_found(found)
if (present(default)) value = default
call json%clear_exceptions()
end if
else
if ( present(found) ) found = .true.
end if
Libraries/Json/json_get_vec_by_path.inc 0 → 100644
View file @ 9d17440e
type(json_value),pointer :: p
if ( json%exception_thrown ) then
if (present(default)) vec = default
call flag_not_found(found)
return
end if
nullify(p)
call json%get(me=me, path=path, p=p)
if (.not. associated(p)) then
call json%throw_exception('Error in '//routine//':'//&
' Unable to resolve path: '// trim(path),found)
else
call json%get(p,vec)
end if
if ( json%exception_thrown ) then
if ( present(found) .or. present(default)) then
call flag_not_found(found)
if (present(default)) vec = default
call json%clear_exceptions()
end if
else
if ( present(found) ) found = .true.
end if
Libraries/Json/json_get_vec_by_path_alloc.inc 0 → 100644
View file @ 9d17440e
type(json_value),pointer :: p
if ( json%exception_thrown ) then
if (present(default)) then
vec = default
if (present(default_ilen)) then
ilen = default_ilen
else
allocate(ilen(size(default)))
ilen = len(default)
end if
end if
call flag_not_found(found)
return
end if
nullify(p)
call json%get(me=me, path=path, p=p)
if (.not. associated(p)) then
call json%throw_exception('Error in '//routine//':'//&
' Unable to resolve path: '// trim(path),found)
else
call json%get(p,vec,ilen)
end if
if ( json%exception_thrown ) then
if ( present(found) .or. present(default)) then
call flag_not_found(found)
if (present(default)) then
vec = default
if (present(default_ilen)) then
ilen = default_ilen
else
allocate(ilen(size(default)))
ilen = len(default)
end if
end if
call json%clear_exceptions()
end if
else
if ( present(found) ) found = .true.
end if
Libraries/Json/json_initialize_arguments.inc
View file @ 9d17440e
! The argument list for the various `initialize` subroutines.
!
! See also: json_initialize_dummy_arguments.inc
logical(LK),intent(in),optional :: verbose
!! mainly useful for debugging (default is false)
......@@ -13,7 +15,7 @@ integer(IK),intent(in),optional :: spaces_per_tab
logical(LK),intent(in),optional :: strict_type_checking
!! if true, no integer, double, or logical type
!! conversions are done for the `get` routines
!! (default is false)
!! (default is false).
logical(LK),intent(in),optional :: trailing_spaces_significant
!! for name and path comparisons, is trailing
!! space to be considered significant.
......@@ -30,20 +32,21 @@ logical(LK),intent(in),optional :: unescape_strings
!! string is returned from [[json_get_string]]
!! and similar routines. If true [default],
!! then the string is returned unescaped.
character(kind=CK,len=1),intent(in),optional :: comment_char
!! If present, this character is used
character(kind=CK,len=*),intent(in),optional :: comment_char
!! If present, these characters are used
!! to denote comments in the JSON file,
!! which will be ignored if present.
!! Example: `!` or `#`. Setting this
!! Example: `!`, `#`, or `/!#`. Setting this
!! to a blank string disables the
!! ignoring of comments. (Default is `!`).
!! ignoring of comments. (Default is `/!#`).
integer(IK),intent(in),optional :: path_mode
!! How the path strings are interpreted in the
!! `get_by_path` routines:
!! * 1 -- Default mode (see [[json_get_by_path_default]])
!! * 2 -- as RFC 6901 "JSON Pointer" paths
!!
!! * 1 : Default mode (see [[json_get_by_path_default]])
!! * 2 : as RFC 6901 "JSON Pointer" paths
!! (see [[json_get_by_path_rfc6901]])
!! * 3 -- JSONPath "bracket-notation"
!! * 3 : JSONPath "bracket-notation"
!! see [[json_get_by_path_jsonpath_bracket]])
character(kind=CK,len=1),intent(in),optional :: path_separator
!! The `path` separator to use
......@@ -71,10 +74,41 @@ logical(LK),intent(in),optional :: escape_solidus
!! * If True then the solidus "`/`" is always escaped
!! "`\/`" when serializing JSON
!! * If False [default], then it is not escaped.
!!
!! Note that this option does not affect parsing
!! (both escaped and unescaped are still valid in
!! all cases).
logical(LK),intent(in),optional :: stop_on_error
!! If an exception is raised, then immediately quit.
!! (Default is False).
integer(IK),intent(in),optional :: null_to_real_mode
!! if `strict_type_checking=false`:
!!
!! * 1 : an exception will be raised if
!! try to retrieve a `null` as a real.
!! * 2 : a `null` retrieved as a real
!! will return a NaN. [default]
!! * 3 : a `null` retrieved as a real
!! will return 0.0.
integer(IK),intent(in),optional :: non_normal_mode
!! How to serialize NaN, Infinity, and
!! -Infinity real values:
!!
!! * 1 : as strings (e.g., "NaN",
!! "Infinity", "-Infinity") [default]
!! * 2 : as JSON `null` values
logical(LK),intent(in),optional :: use_quiet_nan
!! * If true [default], `null_to_real_mode=2`
!! and [[string_to_real]] will use
!! `ieee_quiet_nan` for NaN values.
!! * If false,
!! `ieee_signaling_nan` will be used.
logical(LK),intent(in),optional :: strict_integer_type_checking
!! * If false, when parsing JSON, if an integer numeric value
!! cannot be converted to an integer (`integer(IK)`),
!! then an attempt is then make to convert it
!! to a real (`real(RK)`).
!! * If true, an exception will be raised if the integer
!! value cannot be read.
!!
!! (default is true)
\ No newline at end of file
Libraries/Json/json_initialize_dummy_arguments.inc 0 → 100644
View file @ 9d17440e
! The dummy argument list for the various `initialize` subroutines.
!
! See also: json_initialize_argument.inc
verbose,&
compact_reals,&
print_signs,&
real_format,&
spaces_per_tab,&
strict_type_checking,&
trailing_spaces_significant,&
case_sensitive_keys,&
no_whitespace,&
unescape_strings,&
comment_char,&
path_mode,&
path_separator,&
compress_vectors,&
allow_duplicate_keys,&
escape_solidus,&
stop_on_error,&
null_to_real_mode,&
non_normal_mode,&
use_quiet_nan, &
strict_integer_type_checking &
\ No newline at end of file
Libraries/Json/json_kinds.f90
View file @ 9d17440e
......@@ -59,6 +59,10 @@
! integer(kind=int32) [4 bytes]
#endif
! .
!
!@note In addition to the real kind specified by `RK`, interfaces for
! the real kinds with less precision are also provided in the library,
! but all are converted to `real(RK)` variables internally.
module json_kinds
......@@ -68,6 +72,15 @@
private
! used for the reals with less precision
! than the default precision:
#ifndef REAL32
public :: real32
#endif
#ifdef REAL128
public :: real64
#endif
#ifdef REAL32
integer,parameter,public :: RK = real32 !! Default real kind [4 bytes]
#elif REAL64
......@@ -92,7 +105,7 @@
!*********************************************************
!>
! Processor dependendant 'DEFAULT' character kind.
! Processor dependent 'DEFAULT' character kind.
! This is 1 byte for the Intel and Gfortran compilers.
integer,parameter,public :: CDK = selected_char_kind('DEFAULT')
!*********************************************************
......
Libraries/Json/json_module.f90
View file @ 9d17440e
......@@ -65,6 +65,7 @@
json_array, &
json_logical,&
json_integer,&
json_real, &
json_double, &
json_string
use json_value_module
......
Libraries/Json/json_parameters.f90
View file @ 9d17440e
......@@ -29,13 +29,16 @@
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_array = 3 !! Array JSON data type
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_logical = 4 !! Logical JSON data type
integer(IK),parameter :: json_logical = 4 !! Logical JSON data type (`logical(LK)`)
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_integer = 5 !! Integer JSON data type
integer(IK),parameter :: json_integer = 5 !! Integer JSON data type (`integer(IK)`)
!! (see [[json_file_variable_info]] and [[json_info]]).
integer(IK),parameter :: json_real = 6 !! Real number JSON data type (`real(RK)`)
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_double = 6 !! Double JSON data type
integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(kind=CK)`)
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_string = 7 !! String JSON data type
integer(IK),parameter :: json_double = json_real !! Equivalent to `json_real` for
!! backward compatibility.
!special JSON characters
character(kind=CK,len=*),parameter :: space = CK_' ' !! space character
......@@ -45,9 +48,11 @@
character(kind=CK,len=*),parameter :: end_array = CK_']' !! end of a JSON array
character(kind=CK,len=*),parameter :: delimiter = CK_',' !! delimiter for JSON
character(kind=CK,len=*),parameter :: colon_char = CK_':' !! colon character for JSON
character(kind=CK,len=*),parameter :: start_array_alt = CK_'(' !! alternate start of JSON array for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: end_array_alt = CK_')' !! alternate end of JSON array for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: root = CK_'$' !! root for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: start_array_alt = CK_'(' !! alternate start of JSON array for
!! [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: end_array_alt = CK_')' !! alternate end of JSON array for
!! [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: root = achar(36, kind=CK) !! (`$`) root for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: this = CK_'@' !! 'this' for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: dot = CK_'.' !! path separator for [[json_get_by_path_default]]
character(kind=CK,len=*),parameter :: tilde = CK_'~' !! RFC 6901 escape character
......@@ -62,9 +67,17 @@
character(kind=CK,len=*),parameter :: slash = achar(47, kind=CK) !! JSON special character
character(kind=CK,len=*),parameter :: backslash = achar(92, kind=CK) !! JSON special character
!> default real number format statement (for writing real values to strings and files).
! Note that this can be overridden by calling [[json_initialize]].
#ifdef REAL32
character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E17.8E3)'
#elif REAL128
character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E46.35E5)'
#else
character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E27.17E4)'
!! default real number format statement (for writing real values to strings and files).
!! Note that this can be overridden by calling [[json_initialize]].
#endif
character(kind=CK,len=*),parameter :: star = CK_'*' !! for invalid numbers and
!! list-directed real output
......@@ -111,17 +124,22 @@
!! 6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra
character(kind=CDK,len=*),parameter :: int_fmt = '(ss,I0)' !! minimum width format for integers
integer(IK),parameter :: max_integer_str_len = 256 !! maximum string length of an integer.
integer(IK),parameter :: max_integer_str_len = 256_IK !! maximum string length of an integer.
!! This is totally arbitrary (any way
!! to get the compiler to tell us this?)
integer(IK),parameter :: chunk_size = 100_IK !! for allocatable strings: allocate chunks of this size
integer(IK),parameter :: chunk_size = 256_IK !! for allocatable strings: allocate chunks of this size
integer(IK),parameter :: unit2str = -1_IK !! unit number to cause stuff to be
!! output to strings rather than files.
!! See 9.5.6.12 in the F2003/08 standard
character(kind=CK,len=*),parameter :: blank_chunk = repeat(space, chunk_size) !! a blank string
integer(IK),parameter :: seq_chunk_size = 256_IK !! chunk size for reading sequential files
integer(IK),parameter :: stream_chunk_size = 256_IK !! chunk size for reading stream files
integer(IK),parameter :: print_str_chunk_size = 1000_IK !! chunk size for writing JSON to a string
integer(IK),parameter :: pushed_char_size = 10_IK !! size for `pushed_char`
!! array in [[json_core(type)]]
......
Libraries/Json/json_string_utilities.f90
View file @ 9d17440e
......@@ -11,6 +11,7 @@
module json_string_utilities
use,intrinsic :: ieee_arithmetic
use json_kinds
use json_parameters
......@@ -120,21 +121,22 @@
integer(IK),intent(out) :: ival !! the integer value
logical(LK),intent(out) :: status_ok !! true if there were no errors
!character(kind=CDK,len=:),allocatable :: digits
character(len=:),allocatable :: digits
character(kind=CDK,len=:),allocatable :: digits
integer(IK) :: ndigits_digits,ndigits,ierr
! Compute how many digits we need to read
ndigits = 2*len_trim(str)
if (ndigits/=0) then
ndigits_digits = floor(log10(real(ndigits)))+1
!allocate(character(kind=CK,len=ndigits_digits) :: digits)
allocate(character(len=ndigits_digits) :: digits)
allocate(character(kind=CDK,len=ndigits_digits) :: digits)
write(digits,'(I0)') ndigits !gfortran will have a runtime error with * edit descriptor here
! gfortran bug: '*' edit descriptor for ISO_10646 strings does bad stuff.
read(str,'(I'//trim(digits)//')',iostat=ierr) ival !string to integer
! error check:
status_ok = (ierr==0)
else
status_ok = .false.
end if
if (.not. status_ok) ival = 0_IK
end subroutine string_to_integer
......@@ -149,8 +151,9 @@
!### Modified
! * Izaak Beekman : 02/24/2015 : added the compact option.
! * Jacob Williams : 10/27/2015 : added the star option.
! * Jacob Williams : 07/07/2019 : added null and ieee options.
subroutine real_to_string(rval,real_fmt,compact_real,str)
subroutine real_to_string(rval,real_fmt,compact_real,non_normals_to_null,str)
implicit none
......@@ -158,9 +161,16 @@
character(kind=CDK,len=*),intent(in) :: real_fmt !! format for real numbers
logical(LK),intent(in) :: compact_real !! compact the string so that it is
!! displayed with fewer characters
logical(LK),intent(in) :: non_normals_to_null !! If True, NaN, Infinity, or -Infinity are returned as `null`.
!! If False, the string value will be returned in quotes
!! (e.g., "NaN", "Infinity", or "-Infinity" )
character(kind=CK,len=*),intent(out) :: str !! `rval` converted to a string.
integer(IK) :: istat
integer(IK) :: istat !! write `iostat` flag
if (ieee_is_finite(rval) .and. .not. ieee_is_nan(rval)) then
! normal real numbers
if (real_fmt==star) then
write(str,fmt=*,iostat=istat) rval
......@@ -173,7 +183,27 @@
! so that the same value is displayed with fewer characters.
if (compact_real) call compact_real_string(str)
else
str = repeat(star,len(str))
str = repeat(star,len(str)) ! error
end if
else
! special cases for NaN, Infinity, and -Infinity
if (non_normals_to_null) then
! return it as a JSON null value
str = null_str
else
! Let the compiler do the real to string conversion
! like before, but put the result in quotes so it
! gets printed as a string
write(str,fmt=*,iostat=istat) rval
if (istat==0) then
str = quotation_mark//trim(adjustl(str))//quotation_mark
else
str = repeat(star,len(str)) ! error
end if
end if
end if
end subroutine real_to_string
......@@ -191,11 +221,13 @@
! (e.g., when `str='1E-5'`).
! * Jacob Williams : 2/6/2017 : moved core logic to this routine.
subroutine string_to_real(str,rval,status_ok)
subroutine string_to_real(str,use_quiet_nan,rval,status_ok)
implicit none
character(kind=CK,len=*),intent(in) :: str !! the string to convert to a real
logical(LK),intent(in) :: use_quiet_nan !! if true, return NaN's as `ieee_quiet_nan`.
!! otherwise, use `ieee_signaling_nan`.
real(RK),intent(out) :: rval !! `str` converted to a real value
logical(LK),intent(out) :: status_ok !! true if there were no errors
......@@ -203,7 +235,20 @@
read(str,fmt=*,iostat=ierr) rval
status_ok = (ierr==0)
if (.not. status_ok) rval = 0.0_RK
if (.not. status_ok) then
rval = 0.0_RK
else
if (ieee_support_nan(rval)) then
if (ieee_is_nan(rval)) then
! make sure to return the correct NaN
if (use_quiet_nan) then
rval = ieee_value(rval,ieee_quiet_nan)
else
rval = ieee_value(rval,ieee_signaling_nan)
end if
end if
end if
end if
end subroutine string_to_real
!*****************************************************************************************
......@@ -344,7 +389,7 @@
c = str_in(i:i) !get next character in the input string
!if the string is not big enough, then add another chunk:
if (ipos+3>len(str_out)) str_out = str_out // repeat(space, chunk_size)
if (ipos+3>len(str_out)) str_out = str_out // blank_chunk
select case(c)
case(backslash)
......@@ -435,68 +480,74 @@
! * `\t` - horizontal tab
! * `\uXXXX` - 4 hexadecimal digits
subroutine unescape_string(str_in, str_out, error_message)
subroutine unescape_string(str, error_message)
implicit none
character(kind=CK,len=*),intent(in) :: str_in !! string as stored in a [[json_value]]
character(kind=CK,len=:),allocatable,intent(out) :: str_out !! decoded string
character(kind=CK,len=:),allocatable,intent(out) :: error_message !! will be allocated if there was an error
character(kind=CK,len=:),allocatable,intent(inout) :: str !! in: string as stored
!! in a [[json_value]].
!! out: decoded string.
character(kind=CK,len=:),allocatable,intent(out) :: error_message !! will be allocated if
!! there was an error
integer :: i !! counter
integer :: n !! length of str_in
integer :: m !! length of str_out
integer :: n !! length of `str`
integer :: m !! length of `str_tmp`
character(kind=CK,len=1) :: c !! for scanning each character in string
character(kind=CK,len=:),allocatable :: str_tmp !! temp decoded string (if the input
!! string contains an escape character
!! and needs to be decoded).
#if defined __GFORTRAN__
character(kind=CK,len=:),allocatable :: tmp !! for GFortran bug workaround
#endif
if (scan(str_in,backslash)>0) then
if (scan(str,backslash)>0) then
!there is at least one escape character, so process this string:<