Parse a Fortran namelist into a json_value structure.
The file may contains multiple namelists, and multiple instances of the same namelist (this case is handled by creating an array).
The structure of the JSON file will be:
{
"namelist1":{ "var1":val1, "var2":val2, ... },
"namelist2":{ "var1":val1, "var2":val2, ... },
"namelist_array":[{ "var1":val1, "var2":val2, ... },
{ "var1":val1, "var2":val2, ... }]
}
Note
Currently it only works for a subset of valid namelists, specifically, where each variable/value assignment is on a separate line with the form 'var = val'. It also works for derived types and arrays, but each element of an array must be on a separate line.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | filename |
the namelist file to parse |
||
| type(json_value), | pointer | :: | p_namelist |
the resulting JSON structure |
||
| logical, | intent(out) | :: | status_ok |
true if there were no errors |
subroutine parse_namelist(filename,p_namelist,status_ok) implicit none character(len=*),intent(in) :: filename !! the namelist file to parse type(json_value),pointer :: p_namelist !! the resulting JSON structure logical,intent(out) :: status_ok !! true if there were no errors type(json_value),pointer :: p type(json_value),pointer :: p_array character(len=:),allocatable :: line character(len=:),allocatable :: namelist_name character(len=:),allocatable :: path character(len=:),allocatable :: val type(json_core) :: json !! for manipulation the JSON pointers integer :: iunit !! file unit number integer :: istat !! file `iostat` flag integer :: status !! status code during parsing integer :: i !! index of `=` in a line integer :: iline !! line number counter integer :: var_type !! type of a JSON variable integer :: n_children !! number of elements in an array of namelists character(len=256) :: istr !! for integer to string conversion logical :: found !! to check if namelist with same name already processed integer :: len_val !! length of value string logical :: eof !! end of file flag when reading namelist file ! namelist characters: character(len=1),parameter :: nml_start_char = '&' character(len=1),parameter :: nml_end_char = '/' character(len=1),parameter :: comment_char = '!' character(len=1),parameter :: equals_char = '=' character(len=1),parameter :: sep = '%' character(len=1),parameter :: comma = ',' ! use fortran style path separators: call json%initialize(path_separator='%') ! create root object: call json%create_object(p_namelist,'') ! open the namelist file: open(newunit=iunit,file=trim(filename),status='OLD',iostat=istat) if (istat==0) then status = 0 ! looking for namelist iline = 0 ! line counter eof = .false. do if (eof) exit ! finished ! read a line from the file iline = iline + 1 call read_line_from_file(iunit,line,eof) line = trim(adjustl(line)) if (line(1:1)==comment_char .or. line == '') cycle ! skip it select case (status) case(0) ! looking for a namelist if (line(1:1)==nml_start_char) then ! a new namelist has been found status = 1 ! parsing a namelist namelist_name = lowercase_string(line(2:)) ! does it exist already? nullify(p) call json%get(p_namelist,namelist_name,p,found) if (found) then ! we need to turn it into an array if ! it isn't already one call json%info(p,var_type=var_type,n_children=n_children) if (var_type == json_array) then ! add the array index to the name: write(istr,'(I256)') n_children + 1 namelist_name = namelist_name//'('//trim(adjustl(istr))//')' elseif (var_type == json_object) then ! replace this with an array where the ! current object is the first element call json%create_array(p_array,namelist_name) call json%replace(p,p_array,destroy=.false.) call json%add(p_array,p) namelist_name = namelist_name//'(2)' else call line_parse_error(iline,line,'invalid type') end if end if end if case(1) ! in the process of parsing a namelist if (line(1:1)==nml_end_char) then ! finished with this namelist status = 0 ! looking for namelist else ! continue parsing this namelist ! we are assuming that: ! * each line contains an equal sign: `var = val` ! * it maybe ends in a comma: `var = val,` ! * val can be enclosed in quotes: `var = "val",` i = index(line,equals_char) if (i<=1) then call line_parse_error(iline,line,'invalid line') else ! full path, including the namelist name ! [also convert to lower case] path = lowercase_string(namelist_name//sep//line(1:i-1)) ! the value after the equal sign: val = trim(adjustl(line(i+1:))) ! remove the comma after the value if necessary: len_val = len(val) if (val(len_val:len_val)==comma) then val = val(1:len_val-1) end if ! remove quotes around strings if necessary: ! [either type of quotes is allowed] len_val = len(val) if ((val(1:1)=='"' .and. val(len_val:len_val)=='"') .or. & (val(1:1)=="'" .and. val(len_val:len_val)=="'")) then if (len_val>2) then val = val(2:len_val-1) else val = '' end if ! since we know it is a string: call json%create_string(p,val,'') call json%add_by_path(p_namelist,path,p) else ! infer the variable type and ! add it to the JSON structure: call add_variable(json,p_namelist,path,val) end if end if end if case default call line_parse_error(iline,line,'invalid status flag') end select end do status_ok = .true. close(unit=iunit,iostat=istat) ! close the namelist file else status_ok = .false. end if contains subroutine line_parse_error(iline,line,error_msg) !! throw an error and stop the program. implicit none integer,intent(in) :: iline character(len=*),intent(in) :: line character(len=*),intent(in) :: error_msg write(*,*) '' write(*,*) error_msg write(*,*) '' write(*,*) ' line number: ',iline write(*,*) ' line: '//line write(*,*) '' error stop 'fatal error' end subroutine line_parse_error end subroutine parse_namelist