!# This source file is distributed with code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_analyze_statement

  use mod_types, only : std_string, long_string

  implicit none
  private

  interface get_val
     module procedure array_integer_key, array_SPR_key, &
          array_DPR_key, array_logical_key, array_string_key, &
          scalar_integer_key, scalar_SPR_key, scalar_DPR_key, &
          scalar_logical_key, scalar_string_key
  end interface get_val

  character(len=std_string), save :: file_name
  integer, save :: line_number, unit_log = -1

  public :: analyze_statement, get_val, file_name, line_number, &
       error_message, warning_message, unit_log

contains

!#======================================================================

  subroutine analyze_statement(statement, read_proc, &
       end_statement, return_statement)

    implicit none
    character(len=*), intent(in) :: statement
    logical, intent(out) :: end_statement, return_statement
    external :: read_proc
    interface
       subroutine read_proc(key, rhs, indices_string, unknown_statement, &
            statement_type)
         use mod_strings, only : same_case_equal
         implicit none
         character(len=*), intent(in) :: key, rhs, statement_type
         character(len=*), intent(inout) :: indices_string
         logical, intent(out) :: unknown_statement
       end subroutine read_proc
    end interface
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call find_key_val(statement, &
         end_statement, return_statement, read_proc)

  end subroutine analyze_statement

!#======================================================================

  subroutine find_key_val(statement, &
       end_statement, return_statement, read_proc)

    use mod_strings, only : same_case_equal
    use mod_types

    implicit none
    character(len=*), intent(in) :: statement
    logical, intent(out) :: end_statement, return_statement
    external :: read_proc
    interface
       subroutine read_proc(key, rhs, indices_string, unknown_statement, &
            statement_type)
         use mod_strings, only : same_case_equal
         implicit none
         character(len=*), intent(in) :: key, rhs, statement_type
         character(len=*), intent(inout) :: indices_string
         logical, intent(out) :: unknown_statement
       end subroutine read_proc
    end interface
!#......................................................................
    character(len=len(statement)) :: key, rhs, indices_string, &
         statement_type
    logical :: unknown_statement
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call find_key(statement, key, rhs, indices_string, &
         statement_type)

    if (same_case_equal(key, "end")) then
       end_statement = .true.
       return

    else if (same_case_equal(key, "return")) then
       return_statement = .true.
       return

    else if (same_case_equal(key, "stop")) then
       stop

    else
       call read_proc(key, rhs, indices_string, unknown_statement, &
            statement_type)
       if (unknown_statement) then
          call error_message("Statement or key `" // trim(key) // "` unknown.")
       endif
    endif

  end subroutine find_key_val

!#======================================================================

  subroutine find_key(statement, key, rhs, indices_string, statement_type)

!    use mod_strings, only  : down_case

    implicit none
    character(len=*), intent(in) :: statement
    character(len=*), intent(out) :: key, rhs, indices_string !# rhs = "right-hand side".
    character(len=*), intent(out) :: statement_type
!#......................................................................
    integer :: pos, pos1, pos2
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos1 = index(statement, "=")
    pos2 = index(statement, " ")
    if (pos1 == 0) then !# No `=`.
       pos = pos2
       statement_type = "command"       
    else !# Some `=` found.
       if (pos2 < pos1) then
          if (index(adjustl(statement(pos2+1:)), "=") == 1) then !# `=` is the \
!# first non-blank character after the space: separator is `=`.
             pos = pos1
             statement_type = "assignment"
          else !# Separator is a space character. (Excludes the case where a \
!# string contains `=`.
             pos = pos2
             statement_type = "command"
          endif
       else !# Separator is `=`.
          pos = pos1
          statement_type = "assignment"
       endif
    endif

    if (pos /= 0) then
!       key = down_case(statement(:pos-1))
       key = statement(:pos-1)
       rhs = adjustl(statement(pos+1:))
    else
!       key = down_case(statement)
       key = statement
       rhs = ""
    endif

    pos = index(key, "(")
    if (pos /= 0) then
       indices_string = adjustl(key(pos:))
       key = trim(key(:pos-1))
    else
       indices_string = ""
    endif

  end subroutine find_key

!#======================================================================

  subroutine read_indices(string, index_present, index_number, index_val, &
       scalar_key)

    use mod_convert_type, only : to_string

    implicit none
    character(len=*), intent(inout) :: string
    logical, dimension(:), intent(out) :: index_present
    integer, intent(out) :: index_number
    integer, dimension(size(index_present)), intent(out) :: index_val
    logical, intent(out) :: scalar_key
!#......................................................................
    integer :: pos, first, last, stride, i
    character(len=len(string)) :: substring
    integer :: max_last
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    max_last = size(index_present)
    index_present(:) = .false.
    index_number = 0

    string = adjustl(string(2:)) !# Remove "(".
    pos = index(string, ")")
    if (pos == 0) then
       call error_message("No "")"" found.")
    else
       if (string(pos+1:) /= "") then
          call error_message("Something found between "")"" and ""="".")
       endif
       string = adjustl(string(:pos-1)) !# Remove ")".
    endif

    if (string(1:1) == "[") then
       scalar_key = .false.
       string = adjustl(string(2:)) !# Remove "[".
       pos = index(string, "]")
       if (pos == 0) then
          call error_message("No ""]"" found.")
       else
          if (string(pos+1:) /= "") then
             call error_message("Something found after ""]"".")
          endif
          string = string(:pos-1) !# Remove "]".
          do
             pos = index(string, ",")
             if (pos == 0) then
                substring = string
             else
                substring = string(:pos-1)
             endif
             if (substring == "") then
                call error_message("Nothing found after "","".")
             endif

             call read_indices2(substring, max_last, first, last, stride)
             do i = first, last, stride
                if (index_present(i)) then
                   call error_message("Index " // to_string(i) // " should appear only once.")
                endif
                index_present(i) = .true.
                index_number = index_number + 1
                index_val(index_number) = i
             enddo

             if (pos == 0) exit
             string = string(pos+1:)
          enddo
       endif
    else !# No "[".
       call read_indices2(string, max_last, first, last, stride, scalar_key)
       index_present(first:last:stride) = .true.
       do i = first, last, stride
          index_number = index_number + 1
          index_val(index_number) = i
       enddo
    endif

  end subroutine read_indices

!#======================================================================

  subroutine read_indices2(string, max_last, first, last, stride, scalar_key)

    implicit none
    character(len=*), intent(inout) :: string
    integer, intent(in) :: max_last
    integer, intent(out) :: first, last, stride
    logical, intent(out), optional :: scalar_key
!#......................................................................
    integer :: pos, effective_last, ios
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Read first index: {
    pos = index(string, ":")
    if (pos == 0) then !# Single index.
       if (present(scalar_key)) scalar_key = .true.
!# string = "first".
       read(string, *, iostat=ios) first
       if (ios /= 0) call error_message("Indices must be integers.")
       last = first
       stride = 1
    else !# Index loop.
       if (present(scalar_key)) scalar_key = .false.
       if (string(:pos-1) == "") then
!# string = ": [last : stride]".
          first = 1
       else
!# string = "first : [last : stride]".
          read(string(:pos-1), *, iostat=ios) first
          if (ios /= 0) call error_message("Indices must be integers.")
       endif
!# }.

!# Read last index: {
       string = adjustl(string(pos+1:))
       pos = index(string, ":")
       if (pos == 0) then !# Stride not provided.
          if (string == "") then !# Last index not provided.
!# string = "[first] : ".
             call error_message("The last index must be provided for index loops.")
!# Not used currently: {
             last = max_last
             stride = 1
!# }.
          else !# Last index provided.
!# string = "[first] : last".
             read(string, *, iostat=ios) last
             if (ios /= 0) call error_message("Indices must be integers.")
             stride = 1
          endif
       else !# Stride provided.
          if (string(:pos-1) == "") then !# Last index not provided.
!# string = "[first] : : [stride]".
             call error_message("The last index must be provided for index loops.")
             last = max_last
          else !# Last index provided.
!# string = "[first] : last : [stride]".
             read(string(:pos-1), *, iostat=ios) last
             if (ios /= 0) call error_message("Indices must be integers.")
          endif
!# }.

!# Read stride: {
          string = adjustl(string(pos+1:))
          if (string == "") then
             stride = 1
          else
             read(string, *, iostat=ios) stride
             if (ios /= 0) call error_message("Indices must be integers.")
             if (stride == 0) then
                call error_message("Strides must not be null.")
             endif
          endif
       endif
    endif
!# }.

    effective_last = first + stride * ((last-first)/stride)
    if (first < 1 .or. first > max_last .or. effective_last < 1 &
         .or. effective_last > max_last) then
       call error_message("Wrong bounds for indices.")
    endif

  end subroutine read_indices2

!#======================================================================

  subroutine scalar_integer_val(string, val)

    implicit none
    character(len=*), intent(in) :: string
    integer, intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp, other_input
    integer :: pos, ios
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    pos = index(string_tmp, " ")
    if (pos /= 0) then
       other_input = string_tmp(pos+1:)
       if (other_input /= "") call error_message("Something trailing on the line after the value.")
       string_tmp = string_tmp(:pos-1)
    endif

!# The "/" separator and the repetition of values with "*" (although allowed in
!# list-directed formatting) are here forbidden.
    if (index(string_tmp, "/") /= 0) &
         call error_message("""/"" must not be used to separate values. &
         & Use "","" instead.")
    if (index(string_tmp, "*") /= 0) &
         call error_message("""*"" cannot be used to repeat values.")

    read(string_tmp, *, iostat=ios) val
    if (ios /= 0) call error_message("Not an integer number.")

  end subroutine scalar_integer_val

!#======================================================================

  subroutine array_integer_val(string, val)

    implicit none
    character(len=*), intent(in) :: string
    integer, dimension(:), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp
    integer :: scalar
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == "[") then
       call array_integer_val2(string_tmp, val(:))
    else
       call scalar_integer_val(string_tmp, scalar)
       val(:) = scalar
    endif

  end subroutine array_integer_val

!#======================================================================

  subroutine array_integer_val2(string, val)

    implicit none
    character(len=*), intent(in) :: string
    integer, dimension(:), intent(out) :: val
!#......................................................................
    integer :: i, pos
    character(len=len(string)) :: string_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos = index(string, "[")
    string_tmp = string(pos+1:)
    do i = 1, size(val)
       pos = scan(string_tmp, ",]")
       if (pos == 0) then
          call error_message("Neither "","" nor ""]"" have been found.")
       else if (i == size(val) .and. string_tmp(pos:pos) /= "]") then
          call error_message("Too many values.")
       else if (i < size(val) .and. string_tmp(pos:pos) /= ",") then
          call error_message("Too few values.")
       endif
       call scalar_integer_val(string_tmp(:pos-1), val(i))
       string_tmp = adjustl(string_tmp(pos+1:))
    enddo

  end subroutine array_integer_val2

!#======================================================================

  subroutine scalar_SPR_val(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(SPR), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp, other_input
    integer :: pos, ios
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    pos = index(string_tmp, " ")
    if (pos /= 0) then
       other_input = string_tmp(pos+1:)
       if (other_input /= "") call error_message("Something trailing on the line after the value.")
       string_tmp = string_tmp(:pos-1)
    endif

!# The "/" separator and the repetition of values with "*" (although allowed in
!# list-directed formatting) are here forbidden.
    if (index(string_tmp, "/") /= 0) &
         call error_message("""/"" must not be used to separate values. &
         & Use "","" instead.")
    if (index(string_tmp, "*") /= 0) &
         call error_message("""*"" must not be used to repeat values.")

    read(string_tmp, *, iostat=ios) val
    if (ios /= 0) call error_message("Not a real number.")

  end subroutine scalar_SPR_val

!#======================================================================

  subroutine array_SPR_val(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(SPR), dimension(:), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp
    real(SPR) :: scalar
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == "[") then
       call array_SPR_val2(string_tmp, val(:))
    else
       call scalar_SPR_val(string_tmp, scalar)
       val(:) = scalar
    endif

  end subroutine array_SPR_val

!#======================================================================

  subroutine array_SPR_val2(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(SPR), dimension(:), intent(out) :: val
!#......................................................................
    integer :: i, pos
    character(len=len(string)) :: string_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos = index(string, "[")
    string_tmp = string(pos+1:)
    do i = 1, size(val)
       pos = scan(string_tmp, ",]")
       if (pos == 0) then
          call error_message("Neither "","" nor ""]"" have been found.")
       else if (i == size(val) .and. string_tmp(pos:pos) /= "]") then
          call error_message("Too many values.")
       else if (i < size(val) .and. string_tmp(pos:pos) /= ",") then
          call error_message("Too few values.")
       endif
       call scalar_SPR_val(string_tmp(:pos-1), val(i))
       string_tmp = adjustl(string_tmp(pos+1:))
    enddo

  end subroutine array_SPR_val2

!#======================================================================

  subroutine scalar_DPR_val(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(DPR), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp, other_input
    integer :: pos, ios
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    pos = index(string_tmp, " ")
    if (pos /= 0) then
       other_input = string_tmp(pos+1:)
       if (other_input /= "") call error_message("Something trailing on the line after the value.")
       string_tmp = string_tmp(:pos-1)
    endif

!# The "/" separator and the repetition of values with "*" (although allowed in
!# list-directed formatting) are here forbidden.
    if (index(string_tmp, "/") /= 0) &
         call error_message("""/"" must not be used to separate values. &
         & Use "","" instead.")
    if (index(string_tmp, "*") /= 0) &
         call error_message("""*"" must not be used to repeat values.")

    read(string_tmp, *, iostat=ios) val
    if (ios /= 0) call error_message("Not a real number.")

  end subroutine scalar_DPR_val

!#======================================================================

  subroutine array_DPR_val(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(DPR), dimension(:), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp
    real(DPR) :: scalar
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == "[") then
       call array_DPR_val2(string_tmp, val(:))
    else
       call scalar_DPR_val(string_tmp, scalar)
       val(:) = scalar
    endif

  end subroutine array_DPR_val

!#======================================================================

  subroutine array_DPR_val2(string, val)

    use mod_types

    implicit none
    character(len=*), intent(in) :: string
    real(DPR), dimension(:), intent(out) :: val
!#......................................................................
    integer :: i, pos
    character(len=len(string)) :: string_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos = index(string, "[")
    string_tmp = string(pos+1:)
    do i = 1, size(val)
       pos = scan(string_tmp, ",]")
       if (pos == 0) then
          call error_message("Neither "","" nor ""]"" have been found.")
       else if (i == size(val) .and. string_tmp(pos:pos) /= "]") then
          call error_message("Too many values.")
       else if (i < size(val) .and. string_tmp(pos:pos) /= ",") then
          call error_message("Too few values.")
       endif
       call scalar_DPR_val(string_tmp(:pos-1), val(i))
       string_tmp = adjustl(string_tmp(pos+1:))
    enddo

  end subroutine array_DPR_val2

!#======================================================================

  subroutine scalar_logical_val(string, val)

    use mod_strings, only : down_case, unquote_string

    implicit none
    character(len=*), intent(in) :: string
    logical, intent(out) :: val
!#......................................................................
    character(len=long_string) :: string_tmp
    character(len=len(string)) :: other_input
    integer :: pos
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    pos = index(string_tmp, " ")
    if (pos /= 0) then
       other_input = string_tmp(pos+1:)
       if (other_input /= "") call error_message("Something trailing on the line after the value.")
       string_tmp = string_tmp(:pos-1)
    endif

!# The "/" separator and the repetition of values with "*" (although allowed in
!# list-directed formatting) are here forbidden.
    if (index(string_tmp, "/") /= 0) &
         call error_message("""/"" must not be used to separate values. &
         & Use "","" instead.")
    if (index(string_tmp, "*") /= 0) &
         call error_message("""*"" must not be used to repeat values.")

    string_tmp = unquote_string(down_case(string_tmp)) !# Strip possible quotes around boolean.
    if (any(string_tmp == (/".true.", "true  ", "t     ", "yes   ", "y     "/))) then
       val = .true.
    else if (any(string_tmp == (/".false.", "false  ", "f      ", "no     ", "n      "/))) then
       val = .false.
    else
       call error_message("Not a boolean.")
    endif

  end subroutine scalar_logical_val

!#======================================================================

  subroutine array_logical_val(string, val)

    implicit none
    character(len=*), intent(in) :: string
    logical, dimension(:), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp
    logical :: scalar
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == "[") then
       call array_logical_val2(string_tmp, val(:))
    else
       call scalar_logical_val(string_tmp, scalar)
       val(:) = scalar
    endif

  end subroutine array_logical_val

!#======================================================================

  subroutine array_logical_val2(string, val)

    implicit none
    character(len=*), intent(in) :: string
    logical, dimension(:), intent(out) :: val
!#......................................................................
    integer :: i, pos
    character(len=len(string)) :: string_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos = index(string, "[")
    string_tmp = string(pos+1:)
    do i = 1, size(val)
       pos = scan(string_tmp, ",]")
       if (pos == 0) then
          call error_message("Neither "","" nor ""]"" have been found.")
       else if (i == size(val) .and. string_tmp(pos:pos) /= "]") then
          call error_message("Too many values.")
       else if (i < size(val) .and. string_tmp(pos:pos) /= ",") then
          call error_message("Too few values.")
       endif
       call scalar_logical_val(string_tmp(:pos-1), val(i))
       string_tmp = adjustl(string_tmp(pos+1:))
    enddo

  end subroutine array_logical_val2

!#======================================================================

  subroutine scalar_string_val(string, val, pos)

    use mod_strings, only : find_closing_quote

    implicit none
    character(len=*), intent(in) :: string
    character(len=*), intent(out) :: val
    integer, intent(out), optional :: pos
!#......................................................................
    integer :: pos_beg, pos_end
    character(len=len(string)) :: string_tmp, other_input
    character(len=1) :: quote_character
    logical :: quote_found
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == '"') then
       quote_character = '"'
       pos_beg = index(string, '"')
    else if (string_tmp(1:1) == "'") then
       quote_character = "'"
       pos_beg = index(string, "'")
    else
       quote_character = ""
       pos_beg = verify(string, " ") !# Position of the first non-blank character \
!# (horizontal tabulations already converted to spaces).
    endif

    if (quote_character /= "") then
       pos_end = pos_beg+1
       call find_closing_quote(string, pos_end, quote_character, quote_found)
       if (quote_found) then
          read(string(pos_beg:pos_end), *) val
       else
          if (quote_character == "'") then
             call error_message("The string should end with ""'"".")
          else
             call error_message("The string should end with '""'.")
          endif
       endif
    else
       pos_end = scan(string, " ,]")
       if (pos_end /= 0) then
          val = string(pos_beg:pos_end-1)
       else
          val = string(pos_beg:)
       end if
    endif

    if (present(pos)) then !# `scalar_string_val` called from within \
!# `array_string_val` via `array_string_val2`.
!# Test `other_input` in `array_string_val2` once `]` has been found.
       pos = pos_end+1
    else !# `scalar_string_val` called for a single value.
       other_input = string_tmp(pos_end+1:)
       if (other_input /= "") call error_message("Something trailing on the line after the value.")
    endif

  end subroutine scalar_string_val

!#======================================================================

  subroutine array_string_val(string, val)

    implicit none
    character(len=*), intent(in) :: string
    character(len=*), dimension(:), intent(out) :: val
!#......................................................................
    character(len=len(string)) :: string_tmp, scalar
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    string_tmp = adjustl(string)
    if (string_tmp(1:1) == "[") then
       call array_string_val2(string_tmp, val(:))
    else
       call scalar_string_val(string_tmp, scalar)
       val(:) = scalar
    endif

  end subroutine array_string_val

!#======================================================================

  subroutine array_string_val2(string, val)

    implicit none
    character(len=*), intent(in) :: string
    character(len=*), dimension(:), intent(out) :: val
!#......................................................................
    integer :: i, pos
    character(len=len(string)) :: string_tmp, other_input
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    pos = index(string, "[")
    string_tmp = string(pos+1:)
    do i = 1, size(val)
       call scalar_string_val(string_tmp, val(i), pos)
       if (i == size(val)) then !# Last value; should be followed by "]".
          string_tmp = adjustl(string_tmp(pos:))
          if (string_tmp(1:1) /= "]") call error_message("""]"" not found.")
          other_input = string_tmp(2:)
          if (other_input /= "") &
               call error_message("Something trailing on the line after the last value.")
       else !# Not the last value; should be followed by ",".
          string_tmp = adjustl(string_tmp(pos:))
          if (string_tmp(1:1) == "/") then
!# The "/" separator (although allowed in list-directed formatting) is here forbidden.
!# ??? What about "*"?
             call error_message("""/"" must not be used to separate values. &
                  & Use "","" instead.")
          else if (string_tmp(1:1) /= ",") then
             call error_message(""","" not found.")
          else
             string_tmp = string_tmp(2:)
          endif
       endif
    enddo

  end subroutine array_string_val2

!#======================================================================

  subroutine array_integer_key(array, rhs, indices_string, index_present)

    implicit none
    integer, dimension(:), intent(out) :: array
    character(len=*), intent(in) :: rhs
    character(len=*), intent(inout) :: indices_string
    logical, dimension(size(array)), intent(out) :: index_present
!#......................................................................
    logical :: scalar_key
    integer :: index_number, i
    integer, dimension(size(array)) :: index_val
    integer, dimension(size(array)) :: array_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (indices_string /= "") then
       call read_indices(indices_string, index_present, index_number, &
            index_val, scalar_key)
    else
       scalar_key = .false.
       index_present(1) = .true.
       index_present(2:) = .false.
       index_number = 1
       index_val(1) = 1
    endif

    if (scalar_key) then
       call scalar_integer_val(rhs, array(index_val(1)))
    else
       call array_integer_val(rhs, array_tmp(1:index_number))
       do i = 1, index_number
          array(index_val(i)) = array_tmp(i)
       enddo
    endif

  end subroutine array_integer_key

!#======================================================================

  subroutine array_SPR_key(array, rhs, indices_string, index_present)

    use mod_types

    implicit none
    real(SPR), dimension(:), intent(out) :: array
    character(len=*), intent(in) :: rhs
    character(len=*), intent(inout) :: indices_string
    logical, dimension(size(array)), intent(out) :: index_present
!#......................................................................
    logical :: scalar_key
    integer :: index_number, i
    integer, dimension(size(array)) :: index_val
    real(SPR), dimension(size(array)) :: array_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (indices_string /= "") then
       call read_indices(indices_string, index_present, index_number, &
            index_val, scalar_key)
    else
       scalar_key = .false.
       index_present(1) = .true.
       index_present(2:) = .false.
       index_number = 1
       index_val(1) = 1
    endif

    if (scalar_key) then
       call scalar_SPR_val(rhs, array(index_val(1)))
    else
       call array_SPR_val(rhs, array_tmp(1:index_number))
       do i = 1, index_number
          array(index_val(i)) = array_tmp(i)
       enddo
    endif

  end subroutine array_SPR_key

!#======================================================================

  subroutine array_DPR_key(array, rhs, indices_string, index_present)

    use mod_types

    implicit none
    real(DPR), dimension(:), intent(out) :: array
    character(len=*), intent(in) :: rhs
    character(len=*), intent(inout) :: indices_string
    logical, dimension(size(array)), intent(out) :: index_present
!#......................................................................
    logical :: scalar_key
    integer :: index_number, i
    integer, dimension(size(array)) :: index_val
    real(DPR), dimension(size(array)) :: array_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (indices_string /= "") then
       call read_indices(indices_string, index_present, index_number, &
            index_val, scalar_key)
    else
       scalar_key = .false.
       index_present(1) = .true.
       index_present(2:) = .false.
       index_number = 1
       index_val(1) = 1
    endif

    if (scalar_key) then
       call scalar_DPR_val(rhs, array(index_val(1)))
    else
       call array_DPR_val(rhs, array_tmp(1:index_number))
       do i = 1, index_number
          array(index_val(i)) = array_tmp(i)
       enddo
    endif

  end subroutine array_DPR_key

!#======================================================================

  subroutine array_logical_key(array, rhs, indices_string, index_present)

    implicit none
    logical, dimension(:), intent(out) :: array
    character(len=*), intent(in) :: rhs
    character(len=*), intent(inout) :: indices_string
    logical, dimension(size(array)), intent(out) :: index_present
!#......................................................................
    logical :: scalar_key
    integer :: index_number, i
    integer, dimension(size(array)) :: index_val
    logical, dimension(size(array)) :: array_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (indices_string /= "") then
       call read_indices(indices_string, index_present, index_number, &
            index_val, scalar_key)
    else
       scalar_key = .false.
       index_present(1) = .true.
       index_present(2:) = .false.
       index_number = 1
       index_val(1) = 1
    endif

    if (scalar_key) then
       call scalar_logical_val(rhs, array(index_val(1)))
    else
       call array_logical_val(rhs, array_tmp(1:index_number))
       do i = 1, index_number
          array(index_val(i)) = array_tmp(i)
       enddo
    endif

  end subroutine array_logical_key

!#======================================================================

  subroutine array_string_key(array, rhs, indices_string, index_present)

    implicit none
    character(len=*), dimension(:), intent(out) :: array
    character(len=*), intent(in) :: rhs
    character(len=*), intent(inout) :: indices_string
    logical, dimension(size(array)), intent(out) :: index_present
!#......................................................................
    logical :: scalar_key
    integer :: index_number, i
    integer, dimension(size(array)) :: index_val
    character(len=len(array)), dimension(size(array)) :: array_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (indices_string /= "") then
       call read_indices(indices_string, index_present, index_number, &
            index_val, scalar_key)
    else
       scalar_key = .false.
       index_present(1) = .true.
       index_present(2:) = .false.
       index_number = 1
       index_val(1) = 1
    endif

    if (scalar_key) then
       call scalar_string_val(rhs, array(index_val(1)))
    else
       call array_string_val(rhs, array_tmp(1:index_number))
       do i = 1, index_number
          array(index_val(i)) = array_tmp(i)
       enddo
    endif

  end subroutine array_string_key

!#======================================================================

  subroutine scalar_integer_key(scalar, rhs)

    implicit none
    integer, intent(out) :: scalar
    character(len=*), intent(in) :: rhs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call scalar_integer_val(rhs, scalar)

  end subroutine scalar_integer_key

!#======================================================================

  subroutine scalar_SPR_key(scalar, rhs)

    use mod_types

    implicit none
    real(SPR), intent(out) :: scalar
    character(len=*), intent(in) :: rhs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call scalar_SPR_val(rhs, scalar)

  end subroutine scalar_SPR_key

!#======================================================================

  subroutine scalar_DPR_key(scalar, rhs)

    use mod_types

    implicit none
    real(DPR), intent(out) :: scalar
    character(len=*), intent(in) :: rhs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call scalar_DPR_val(rhs, scalar)

  end subroutine scalar_DPR_key

!#======================================================================

  subroutine scalar_logical_key(scalar, rhs)

    implicit none
    logical, intent(out) :: scalar
    character(len=*), intent(in) :: rhs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call scalar_logical_val(rhs, scalar)

  end subroutine scalar_logical_key

!#======================================================================

  subroutine scalar_string_key(scalar, rhs)

    implicit none
    character(len=*), intent(out) :: scalar
    character(len=*), intent(in) :: rhs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    call scalar_string_val(rhs, scalar)

  end subroutine scalar_string_key

!#======================================================================

  subroutine error_message(message)

    implicit none
    character(len=*), intent(in) :: message
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (unit_log > 0) write(unit_log, "(a,i0,2(a/),a)") "Error: file """ // &
         trim(file_name) // """, line ", line_number, ": ", &
         trim(adjustl(message)), "Stopped."
    write(*, "(a,i0,2(a/),a)") "Error: file """ // trim(file_name) // """, line ", &
         line_number, ": ", trim(adjustl(message)), "Stopped."
    stop

  end subroutine error_message

!#======================================================================

  subroutine warning_message(message)

    implicit none
    character(len=*), intent(in) :: message
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (unit_log > 0) write(unit_log, "(a,i0,a/a)") &
         "Warning: file """ // trim(file_name) // &
         """, line ", line_number, ": ", trim(adjustl(message))
    write(*, "(a,i0,a/a)") "Warning: file """ // trim(file_name) // &
         """, line ", line_number, ": ", trim(adjustl(message))

  end subroutine warning_message

end module mod_analyze_statement
