Reads a PNM image from a file.
Type | Intent | Optional | 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 |
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