import_pnm Subroutine

private impure subroutine import_pnm(this, file_name, file_format, encoding)

Reads a PNM image from a file.

Type Bound

format_pnm

Arguments

Type IntentOptional Attributes Name
class(format_pnm), intent(inout) :: this
character(len=*), intent(in) :: file_name
character(len=3), intent(in) :: file_format
character(len=*), intent(in) :: encoding

Calls

proc~~import_pnm~~CallsGraph proc~import_pnm format_pnm%import_pnm proc~allocate_pixels format_pnm%allocate_pixels proc~import_pnm->proc~allocate_pixels proc~check_pixel_range format_pnm%check_pixel_range proc~import_pnm->proc~check_pixel_range proc~read_header read_header proc~import_pnm->proc~read_header proc~set_file_format format_pnm%set_file_format proc~import_pnm->proc~set_file_format proc~set_format format_pnm%set_format proc~import_pnm->proc~set_format

Called by

proc~~import_pnm~~CalledByGraph proc~import_pnm format_pnm%import_pnm program~demo_ppm demo_ppm program~demo_ppm->proc~import_pnm program~test10 test10 program~test10->proc~import_pnm program~test11 test11 program~test11->proc~import_pnm program~test12 test12 program~test12->proc~import_pnm program~test13 test13 program~test13->proc~import_pnm program~test14 test14 program~test14->proc~import_pnm program~test7 test7 program~test7->proc~import_pnm program~test8 test8 program~test8->proc~import_pnm program~test9 test9 program~test9->proc~import_pnm

Source Code

   impure subroutine import_pnm(this, file_name, file_format, encoding)
      class(format_pnm), intent(inout)       :: this
      character(*),      intent(in)          :: file_name, encoding
      character(3),      intent(in)          :: file_format
      integer                                :: nunit, iostat
      character, dimension(:), allocatable   :: buffer_ch
      integer(ik), dimension(:), allocatable :: buffer_int
      logical                                :: file_exists
      integer                                :: pos

      inquire(file=file_name//'.'//file_format, exist=file_exists)
      if (file_exists) then

         call this%set_file_format(file_format)
         call this%set_format(encoding)

         select case (this%encoding)
          case ('binary','raw')

            select case (file_format)
             case ('pbm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, form='formatted', access='stream', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               close(nunit)
               allocate(buffer_ch(this%height*this%width))
               buffer_ch = achar(0_ik)

               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='unformatted', action='read', status='old', position='append')
               if (iostat /= 0) error stop 'Error opening the file.'
               read(nunit, iostat=iostat, pos=pos) buffer_ch
               if (iostat /= 0) error stop 'Error reading the file.'
               call this%allocate_pixels()
               this%pixels = iachar(transpose(reshape(buffer_ch, [this%width, this%height])), kind=ik)
               close(nunit)
             case ('pgm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, form='formatted', access='stream', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               close(nunit)
               allocate(buffer_ch(this%height*this%width))
               buffer_ch = achar(0_ik)

               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='unformatted', action='read', status='old', position='append')
               if (iostat /= 0) error stop 'Error opening the file.'
               read(nunit, iostat=iostat, pos=pos) buffer_ch
               if (iostat /= 0) error stop 'Error reading the file.'
               call this%allocate_pixels()
               this%pixels = iachar(transpose(reshape(buffer_ch, [this%width, this%height])), kind=ik)
               close(nunit)
             case ('ppm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, form='formatted', access='stream', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               close(nunit)
               allocate(buffer_ch(this%height*3*this%width))
               buffer_ch = achar(0_ik)

               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='unformatted', action='read', status='old', position='append')
               if (iostat /= 0) error stop 'Error opening the file.'
               read(nunit,iostat=iostat, pos=pos) buffer_ch
               call this%allocate_pixels()
               this%pixels = iachar(transpose(reshape(buffer_ch, [this%width*3, this%height])), kind=ik)
               close(nunit)
            end select

          case ('ascii','plain')

            select case (file_format)
             case ('pbm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='formatted', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               allocate(buffer_int(this%height*this%width))
               buffer_int = 0_ik
               read(nunit, *) buffer_int
               call this%allocate_pixels()
               this%pixels = transpose(reshape(buffer_int, [this%width, this%height]))
               close(nunit)
               call this%check_pixel_range(this%pixels)
             case ('pgm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='formatted', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               allocate(buffer_int(this%height*this%width))
               buffer_int = 0_ik
               read(nunit, *) buffer_int
               call this%allocate_pixels()
               this%pixels = transpose(reshape(buffer_int, [this%width, this%height]))
               call this%check_pixel_range(this%pixels)
               close(nunit)
             case ('ppm')
               open (newunit = nunit, file = file_name//'.'//file_format,&
               iostat=iostat, access='stream', form='formatted', action='read', status='old')
               if (iostat /= 0) error stop 'Error opening the file.'
               call read_header(this, nunit, pos)
               allocate(buffer_int(this%height*3*this%width))
               buffer_int = 0_ik
               read(nunit, *) buffer_int
               call this%allocate_pixels()
               this%pixels = transpose(reshape(buffer_int, [this%width*3, this%height]))
               call this%check_pixel_range(this%pixels)
               close(nunit)
            end select

         end select

      else
         error stop 'Error: File does not exist.'
      end if
   end subroutine import_pnm