parse_fragments_generic Module Subroutine

module subroutine parse_fragments_generic(unit, nfrag, fragments, error)

Generic parser for %fragments section (works for both config and molecule)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: unit
integer, intent(inout) :: nfrag
type(input_fragment_t), intent(inout), allocatable :: fragments(:)
type(error_t), intent(out) :: error

Calls

proc~~parse_fragments_generic~~CallsGraph proc~parse_fragments_generic parse_fragments_generic proc~error_add_context error_t%error_add_context proc~parse_fragments_generic->proc~error_add_context proc~error_has_error error_t%error_has_error proc~parse_fragments_generic->proc~error_has_error proc~error_set error_t%error_set proc~parse_fragments_generic->proc~error_set proc~parse_fragment parse_fragment proc~parse_fragments_generic->proc~parse_fragment proc~skip_to_end skip_to_end proc~parse_fragments_generic->proc~skip_to_end proc~strip_comment strip_comment proc~parse_fragments_generic->proc~strip_comment proc~parse_fragment->proc~error_add_context proc~parse_fragment->proc~error_has_error proc~parse_fragment->proc~error_set proc~parse_fragment->proc~strip_comment proc~parse_indices_line parse_indices_line proc~parse_fragment->proc~parse_indices_line proc~skip_to_end->proc~error_set proc~skip_to_end->proc~strip_comment proc~parse_indices_line->proc~error_set

Called by

proc~~parse_fragments_generic~~CalledByGraph proc~parse_fragments_generic parse_fragments_generic interface~parse_fragments_generic parse_fragments_generic interface~parse_fragments_generic->proc~parse_fragments_generic proc~parse_fragments_section parse_fragments_section proc~parse_fragments_section->interface~parse_fragments_generic proc~parse_molecule_fragments parse_molecule_fragments proc~parse_molecule_fragments->interface~parse_fragments_generic interface~parse_fragments_section parse_fragments_section interface~parse_fragments_section->proc~parse_fragments_section proc~parse_single_molecule parse_single_molecule proc~parse_single_molecule->proc~parse_molecule_fragments proc~parse_molecules_section parse_molecules_section proc~parse_molecules_section->proc~parse_single_molecule proc~read_mqc_file read_mqc_file proc~read_mqc_file->interface~parse_fragments_section interface~parse_molecules_section parse_molecules_section interface~parse_molecules_section->proc~parse_molecules_section program~main main program~main->proc~read_mqc_file

Variables

Type Visibility Attributes Name Initial
integer, private :: eq_pos
integer, private :: ifrag
integer, private :: io_stat
character(len=MAX_LINE_LEN), private :: key
character(len=MAX_LINE_LEN), private :: line
character(len=256), private :: msg
integer, private :: nfrag_local
character(len=MAX_LINE_LEN), private :: value

Source Code

   module subroutine parse_fragments_generic(unit, nfrag, fragments, error)
      !! Generic parser for %fragments section (works for both config and molecule)
      integer, intent(in) :: unit
      integer, intent(inout) :: nfrag
      type(input_fragment_t), allocatable, intent(inout) :: fragments(:)
      type(error_t), intent(out) :: error

      character(len=MAX_LINE_LEN) :: line, key, value
      character(len=256) :: msg
      integer :: io_stat, eq_pos, nfrag_local, ifrag
      nfrag_local = 0

      ! First pass: read nfrag
      do
         read (unit, '(A)', iostat=io_stat) line
         if (io_stat /= 0) then
            call error%set(ERROR_IO, "Unexpected end of file in %fragments section")
            return
         end if

         line = adjustl(line)
         if (len_trim(line) == 0) cycle
         if (line(1:1) == '#' .or. line(1:1) == '!') cycle

         if (trim(strip_comment(line)) == 'end') exit

         eq_pos = index(line, '=')
         if (eq_pos > 0) then
            key = adjustl(line(1:eq_pos - 1))
            value = adjustl(line(eq_pos + 1:))

            if (trim(key) == 'nfrag') then
               read (value, *, iostat=io_stat) nfrag_local
               if (io_stat /= 0) then
                  call error%set(ERROR_PARSE, "Invalid nfrag value")
                  return
               end if
               exit
            end if
         end if
      end do

      if (nfrag_local == 0) then
         ! No fragments, just skip to end
         call skip_to_end(unit, error)
         return
      end if

      nfrag = nfrag_local
      allocate (fragments(nfrag))

      ! Parse individual fragments
      ifrag = 0
      do
         read (unit, '(A)', iostat=io_stat) line
         if (io_stat /= 0) exit

         line = adjustl(line)
         if (len_trim(line) == 0) cycle
         if (line(1:1) == '#' .or. line(1:1) == '!') cycle

         if (trim(strip_comment(line)) == 'end') exit

         if (trim(line) == '%fragment') then
            ifrag = ifrag + 1
            if (ifrag > nfrag) then
               call error%set(ERROR_PARSE, "More fragments than declared nfrag")
               return
            end if
            call parse_fragment(unit, fragments(ifrag), error)
            if (error%has_error()) then
               call error%add_context("mqc_config_parser:parse_fragments_generic")
               return
            end if
         end if
      end do

      if (ifrag /= nfrag) then
         write (msg, '(A,I0,A,I0)') "Expected ", nfrag, " fragments, found ", ifrag
         call error%set(ERROR_PARSE, trim(msg))
         return
      end if

   end subroutine parse_fragments_generic