read_formatted Subroutine

private subroutine read_formatted(string, unit, iotype, v_list, iostat, iomsg)

Read a character sequence from a connected formatted unit into the string.

Arguments

Type IntentOptional Attributes Name
type(string_type), intent(inout) :: string
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg

Calls

proc~~read_formatted~~CallsGraph proc~read_formatted read_formatted none~read_line read_line proc~read_formatted->none~read_line proc~unused_dummy_argument unused_dummy_argument proc~read_formatted->proc~unused_dummy_argument

Called by

proc~~read_formatted~~CalledByGraph proc~read_formatted read_formatted interface~read (formatted) read (formatted) interface~read (formatted)->proc~read_formatted

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: line

Subroutines

subroutine read_line(unit, line, iostat, iomsg)

Internal routine to read a whole record from a formatted unit

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: unit
character(len=:), intent(out), allocatable :: line
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg

Source Code

subroutine read_formatted(string, unit, iotype, v_list, iostat, iomsg)
   type(string_type), intent(inout) :: string
   integer, intent(in) :: unit
   character(len=*), intent(in) :: iotype
   integer, intent(in) :: v_list(:)
   integer, intent(out) :: iostat
   character(len=*), intent(inout) :: iomsg
   character(len=:), allocatable :: line

   call unused_dummy_argument(v_list)

   select case (iotype)
   case ("LISTDIRECTED")
      call read_line(unit, line, iostat, iomsg)
   case ("NAMELIST")
      iostat = PIC_IOSTAT_NAMELIST_INPUT
      iomsg = "pic_string_type: namelist input is not supported for string_type"
      return
   case default    ! DT*
      iostat = PIC_IOSTAT_DT_INPUT
      iomsg = "pic_string_type: dt edit descriptors are not supported for string_type input"
      return
   end select

   string%raw = line

contains

   !> Internal routine to read a whole record from a formatted unit
   subroutine read_line(unit, line, iostat, iomsg)
      integer, intent(in) :: unit
      character(len=:), allocatable, intent(out) :: line
      integer, intent(out) :: iostat
      character(len=*), intent(inout) :: iomsg
      integer, parameter :: buffer_size = 512
      character(len=buffer_size) :: buffer
      integer :: filled
      ! The record is transferred one character at a time into buffer, which is
      ! flushed into line whenever it fills up, so line is reallocated once per
      ! buffer_size characters rather than once per character.
      !
      ! Filling the whole buffer with a single read and asking size= how much of
      ! it is record data is not portable here. This is a child data transfer
      ! statement, so size= counts the characters transferred by the whole
      ! parent transfer rather than by this statement alone, and at least one
      ! processor does not reset that count between successive parent statements
      ! on the same unit, which makes it impossible to recover a per read count
      ! from it. Using trim on the buffer instead is not an option either: a
      ! non-advancing read that hits the end of the record blank pads the rest of
      ! the buffer, and trim cannot tell that padding apart from trailing blanks
      ! that genuinely belong to the record. A single character item needs no
      ! such bookkeeping, because it either transfers its one character or
      ! reports the end of the record.
      !
      ! The loop ends on any non-zero iostat rather than on the end of
      ! record condition specifically, so it also stops on an end of file
      ! and on whatever value a processor chooses for either, and it cannot
      ! keep going on a value it does not recognise. is_iostat_eor below
      ! then decides which of those the caller is told about.
      line = ""
      filled = 0
      do
         read (unit, "(a)", iostat=iostat, iomsg=iomsg, advance="no") &
            buffer(filled + 1:filled + 1)
         if (iostat /= 0) exit
         filled = filled + 1
         if (filled == buffer_size) then
            line = line//buffer
            filled = 0
         end if
      end do
      if (filled > 0) line = line//buffer(:filled)

      if (is_iostat_eor(iostat)) then
         iostat = 0
      end if
   end subroutine read_line

end subroutine read_formatted