readgif Subroutine

subroutine readgif(filename, num_image, image, iostat, color_map, verbose)
! read the num_image'th gif image from filename into arrays image and color_map
character(len=*), intent(in) :: filename                ! input file
integer, intent(in)          :: num_image               ! number of image required
integer, intent(out), allocatable :: image(:,:)         ! Image data returned
integer, intent(out)         :: iostat                  ! I/O error number, =0 if ok
real   , allocatable, intent(out) :: color_map(:,:)     ! RGB for each level, range 0.0 to 1.0
logical, intent(in), optional :: verbose                ! .true.for verbose output
! -----     local variables     ------------------------------------
character(len=16) :: buf             ! input buffer
character (len=1):: c                ! shorter input buffer
integer :: image_count               ! number of images processed so far
logical :: my_verbose
! -----     executable statements     ------------------------------
    zero_data_block = .false.
    gif89= gif89_type( -1, -1, -1, 0 )
    my_verbose = .false.
    if ( present(verbose) ) my_verbose = verbose
    call open_gif (filename, iostat, my_verbose, color_map )
    if (iostat /= 0) RETURN
    image_count = 0
    do ! forever
      call read_buf(c, iostat )
      if (iostat /= 0) then
        call io_error ( "reading file", iostat, filename )
        RETURN
      end if
      if ( c == ";" ) then ! gif image terminator
        if ( image_count < num_image ) then
          write (*,*) "only", image_count, "image(s) found in file"
          iostat = -1
        end if
        close ( unit=lun )
        RETURN
      end if
      if ( c == "!" ) then
   ! gif extension
        call do_extension (filename, iostat, my_verbose )
        if (iostat /= 0) RETURN
        CYCLE
      end if
      if ( c /= "," ) then
   ! not a valid start character
        write (*,*) "ignoring bogus character ", ichar(c)
        CYCLE
      end if
      image_count = image_count + 1
      if (image_count>num_image) RETURN
      call read_buf(buf(1:9), iostat )
      if (iostat /= 0) then
        call io_error("cannot read width/height", iostat, filename)
        RETURN
      end if
!
! If local colour map exists: read it
!
      gif_screen%use_local_colormap = btest(ichar(buf(9:9)),use_local_colormap)
      if ( gif_screen%use_local_colormap ) then
        gif_screen%color_map_size = 2**(modulo(ichar(buf(9:9)),8)+1)
        if(my_verbose) write(*,*)'readgif error in local colour map, size=', &
                        gif_screen%color_map_size
        if(allocated(color_map))deallocate(color_map)
        allocate(color_map(3,gif_screen%color_map_size))
        call read_colormap(color_map, iostat )
        if (iostat /= 0) then
          call io_error ( " error reading local color map", iostat, filename )
          RETURN
        end if
        call read_image(bcint2b(buf(5:6)), bcint2b(buf(7:8)), &
                         btest(ichar(buf(9:9)),interlace), image_count /= num_image, &
                         my_verbose, filename,  iostat, image)
        if (iostat /= 0) RETURN
      else
        call read_image(bcint2b(buf(5:6)), bcint2b(buf(7:8)), &
                         btest(ichar(buf(9:9)),interlace), image_count /= num_image, &
                         my_verbose, filename,  iostat, image )
        if (iostat /= 0) RETURN
      end if
    end do
    close(unit=lun)
    print *,'closed unit', lun, ' in readgif'
  end subroutine readgif