writegif Subroutine

subroutine writegif (FileName, Pixel, ColorMap, Transparent)
!
! Codes pixel-map with palette into GIF format. Optional transparent color
!
character(len=*), intent(in)            :: FileName ! file to create or replace
integer, intent(in), dimension(:,:)     :: Pixel    ! Pixel values 0 to ncol
integer, intent(in), dimension(:,0:)    :: ColorMap ! RGB 0:255 for colours 0:ncol
integer, intent(in), optional           :: Transparent ! Optional

  character(len=256) :: s
  integer            :: InfoByte, nx, ny, Cblen, HasMap, maxincol,  &
                        maxgifcol, Background, i, F_unit

  call open_for_write (FileName, F_unit)
  nx = ubound(Pixel, 1)
  ny = ubound(Pixel, 2)
  maxincol = ubound(ColorMap,2)
!!  print *,'image size', nx, ny, ' colours', maxincol
  do i=1,8                           ! find the bitsize, blen, for pixels
    blen = i
    maxgifcol = 2**blen - 1          ! Number of colors has to be power of 2
    if (maxgifcol >= maxincol) then
      exit                           ! now blen and maxgifcol are correct
    end if                           ! only op to 256 colors can be
  end do
   write(F_unit) "GIF89a"
!  Create information for screen descriptor
  Background = 0
  if (present(Transparent)) then
    Background = Transparent
  end if
  HasMap = 1
  Cblen = blen
  InfoByte = HasMap * 128 + (Cblen-1) * 16 + blen-1
!  Write the screen descriptor
  write(F_unit) char2(nx), char2(ny), CHAR(InfoByte), CHAR(Background), CHAR(0)
  do i=0,maxgifcol                                 ! write global colormap
    write(F_unit) CHAR(colormap(1,min(i,maxincol))), &
                  CHAR(colormap(2,min(i,maxincol))), &
                  CHAR(colormap(3,min(i,maxincol)))
  end do
  if (present(Transparent)) then
    write(unit=*,fmt=*) "Transparent color: ", Transparent
    s = "!" // char(249) // char(4) // char(1) // char(0) // char(0)  &
            // char(Transparent) // char(0)
    write(F_unit) s(1:8)                            ! GIF transparent extension
  end if
   write(F_unit) ","                                ! Announce image
!    Now create and write image descriptor
  HasMap = 0
  InfoByte = HasMap * 128 + blen-1                 ! add 64, if interlaced
!    x_margin, y_margin (not used), image dimensions
  write(F_unit) char2(0), char2(0), char2(nx), char2(ny), CHAR(InfoByte)
  call giflzw (F_unit, Pixel)                       ! now the raster data
  write(F_unit) CHAR(0), ';'                    ! Terminating 0-block ; for GIF
  close(unit=F_unit)
  return
end subroutine writegif